module Language.Drasil.Code.Imperative.Parameters(getInConstructorParams,
  getInputFormatIns, getInputFormatOuts, getDerivedIns, getDerivedOuts,
  getConstraintParams, getCalcParams, getOutputParams
) where

import Language.Drasil hiding (isIn, Var)
import Language.Drasil.Chunk.CodeDefinition (CodeDefinition, auxExprs)
import Language.Drasil.Chunk.CodeBase
import Language.Drasil.Choices (Structure(..), ConstantStructure(..), 
  ConstantRepr(..), InternalConcept(..))
import Language.Drasil.Code.CodeQuantityDicts (inFileName, inParams, consts)
import Language.Drasil.Code.Imperative.DrasilState (GenState, DrasilState(..), 
  genICName)
import Language.Drasil.CodeSpec (HasOldCodeSpec(..), constraintvars, getConstraints)
import Language.Drasil.Mod (Name)

import Data.List (nub, (\\), delete)
import Data.Map (member, notMember)
import qualified Data.Map as Map (lookup)
import Control.Monad.State (get)
import Control.Lens ((^.))

-- | Parameters may be inputs or outputs.
data ParamType = In | Out deriving ParamType -> ParamType -> Bool
(ParamType -> ParamType -> Bool)
-> (ParamType -> ParamType -> Bool) -> Eq ParamType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParamType -> ParamType -> Bool
== :: ParamType -> ParamType -> Bool
$c/= :: ParamType -> ParamType -> Bool
/= :: ParamType -> ParamType -> Bool
Eq

-- | Useful to see if a parameter is for 'In'put or output.
isIn :: ParamType -> Bool
isIn :: ParamType -> Bool
isIn = (ParamType
In ParamType -> ParamType -> Bool
forall a. Eq a => a -> a -> Bool
==)

-- | Since the input constructor calls the three input-related methods, the
-- parameters to the constructor are the parameters to the three methods,
-- except excluding any of variables that are state variables in the class,
-- since they are already in scope.
-- If InputParameters is not in the definition list, then the default
-- constructor is used, which takes no parameters.
getInConstructorParams :: GenState [CodeVarChunk]
getInConstructorParams :: GenState [CodeVarChunk]
getInConstructorParams = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  [CodeVarChunk]
ifPs <- GenState [CodeVarChunk]
getInputFormatIns
  [CodeVarChunk]
dvPs <- GenState [CodeVarChunk]
getDerivedIns
  [CodeVarChunk]
icPs <- GenState [CodeVarChunk]
getConstraintParams
  String
ipName <- InternalConcept -> GenState String
genICName InternalConcept
InputParameters
  let getCParams :: Bool -> [CodeVarChunk]
getCParams Bool
False = []
      getCParams Bool
True = [CodeVarChunk]
ifPs [CodeVarChunk] -> [CodeVarChunk] -> [CodeVarChunk]
forall a. [a] -> [a] -> [a]
++ [CodeVarChunk]
dvPs [CodeVarChunk] -> [CodeVarChunk] -> [CodeVarChunk]
forall a. [a] -> [a] -> [a]
++ [CodeVarChunk]
icPs
  [CodeVarChunk]
ps <- String -> ParamType -> [CodeVarChunk] -> GenState [CodeVarChunk]
forall c.
(Quantity c, MayHaveUnit c) =>
String -> ParamType -> [c] -> GenState [CodeVarChunk]
getParams String
ipName ParamType
In ([CodeVarChunk] -> GenState [CodeVarChunk])
-> [CodeVarChunk] -> GenState [CodeVarChunk]
forall a b. (a -> b) -> a -> b
$ Bool -> [CodeVarChunk]
getCParams (String
ipName String -> Set String -> Bool
forall a. Eq a => a -> Set a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> Set String
defSet DrasilState
g)
  [CodeVarChunk] -> GenState [CodeVarChunk]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([CodeVarChunk] -> GenState [CodeVarChunk])
-> [CodeVarChunk] -> GenState [CodeVarChunk]
forall a b. (a -> b) -> a -> b
$ (CodeVarChunk -> Bool) -> [CodeVarChunk] -> [CodeVarChunk]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> Maybe String
forall a. a -> Maybe a
Just String
ipName Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
/=) (Maybe String -> Bool)
-> (CodeVarChunk -> Maybe String) -> CodeVarChunk -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Map String String -> Maybe String)
-> Map String String -> String -> Maybe String
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (DrasilState -> Map String String
clsMap DrasilState
g) (String -> Maybe String)
-> (CodeVarChunk -> String) -> CodeVarChunk -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeVarChunk -> String
forall c. CodeIdea c => c -> String
codeName) [CodeVarChunk]
ps

-- | The inputs to the function for reading inputs are the input file name.
getInputFormatIns :: GenState [CodeVarChunk]
getInputFormatIns :: GenState [CodeVarChunk]
getInputFormatIns = do
  String
giName <- InternalConcept -> GenState String
genICName InternalConcept
GetInput
  String -> ParamType -> [CodeVarChunk] -> GenState [CodeVarChunk]
forall c.
(Quantity c, MayHaveUnit c) =>
String -> ParamType -> [c] -> GenState [CodeVarChunk]
getParams String
giName ParamType
In [QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar QuantityDict
inFileName]

-- | The outputs from the function for reading inputs are the inputs.
getInputFormatOuts :: GenState [CodeVarChunk]
getInputFormatOuts :: GenState [CodeVarChunk]
getInputFormatOuts = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  String
giName <- InternalConcept -> GenState String
genICName InternalConcept
GetInput
  String -> ParamType -> [CodeVarChunk] -> GenState [CodeVarChunk]
forall c.
(Quantity c, MayHaveUnit c) =>
String -> ParamType -> [c] -> GenState [CodeVarChunk]
getParams String
giName ParamType
Out ([CodeVarChunk] -> GenState [CodeVarChunk])
-> [CodeVarChunk] -> GenState [CodeVarChunk]
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g CodeSpec
-> Getting [CodeVarChunk] CodeSpec [CodeVarChunk] -> [CodeVarChunk]
forall s a. s -> Getting a s a -> a
^. Getting [CodeVarChunk] CodeSpec [CodeVarChunk]
forall c. HasOldCodeSpec c => Lens' c [CodeVarChunk]
Lens' CodeSpec [CodeVarChunk]
extInputsO

-- | The inputs to the function for calculating derived inputs are any variables
-- used in the equations for the derived inputs.
getDerivedIns :: GenState [CodeVarChunk]
getDerivedIns :: GenState [CodeVarChunk]
getDerivedIns = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let s :: CodeSpec
s = DrasilState -> CodeSpec
codeSpec DrasilState
g
      dvals :: [Derived]
dvals = CodeSpec
s CodeSpec -> Getting [Derived] CodeSpec [Derived] -> [Derived]
forall s a. s -> Getting a s a -> a
^. Getting [Derived] CodeSpec [Derived]
forall c. HasOldCodeSpec c => Lens' c [Derived]
Lens' CodeSpec [Derived]
derivedInputsO
      reqdVals :: [CodeVarChunk]
reqdVals = (Derived -> [CodeVarChunk]) -> [Derived] -> [CodeVarChunk]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((CodeExpr -> ChunkDB -> [CodeVarChunk])
-> ChunkDB -> CodeExpr -> [CodeVarChunk]
forall a b c. (a -> b -> c) -> b -> a -> c
flip CodeExpr -> ChunkDB -> [CodeVarChunk]
codevars (CodeSpec
s CodeSpec -> Getting ChunkDB CodeSpec ChunkDB -> ChunkDB
forall s a. s -> Getting a s a -> a
^. Getting ChunkDB CodeSpec ChunkDB
forall c. HasOldCodeSpec c => Lens' c ChunkDB
Lens' CodeSpec ChunkDB
sysinfodbO) (CodeExpr -> [CodeVarChunk])
-> (Derived -> CodeExpr) -> Derived -> [CodeVarChunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Derived -> Getting CodeExpr Derived CodeExpr -> CodeExpr
forall s a. s -> Getting a s a -> a
^. Getting CodeExpr Derived CodeExpr
forall c. DefiningCodeExpr c => Lens' c CodeExpr
Lens' Derived CodeExpr
codeExpr)) [Derived]
dvals
  String
dvName <- InternalConcept -> GenState String
genICName InternalConcept
DerivedValuesFn
  String -> ParamType -> [CodeVarChunk] -> GenState [CodeVarChunk]
forall c.
(Quantity c, MayHaveUnit c) =>
String -> ParamType -> [c] -> GenState [CodeVarChunk]
getParams String
dvName ParamType
In [CodeVarChunk]
reqdVals

-- | The outputs from the function for calculating derived inputs are the derived inputs.
getDerivedOuts :: GenState [CodeVarChunk]
getDerivedOuts :: GenState [CodeVarChunk]
getDerivedOuts = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  String
dvName <- InternalConcept -> GenState String
genICName InternalConcept
DerivedValuesFn
  String -> ParamType -> [CodeChunk] -> GenState [CodeVarChunk]
forall c.
(Quantity c, MayHaveUnit c) =>
String -> ParamType -> [c] -> GenState [CodeVarChunk]
getParams String
dvName ParamType
Out ([CodeChunk] -> GenState [CodeVarChunk])
-> [CodeChunk] -> GenState [CodeVarChunk]
forall a b. (a -> b) -> a -> b
$ (Derived -> CodeChunk) -> [Derived] -> [CodeChunk]
forall a b. (a -> b) -> [a] -> [b]
map Derived -> CodeChunk
forall c. CodeIdea c => c -> CodeChunk
codeChunk ([Derived] -> [CodeChunk]) -> [Derived] -> [CodeChunk]
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g CodeSpec -> Getting [Derived] CodeSpec [Derived] -> [Derived]
forall s a. s -> Getting a s a -> a
^. Getting [Derived] CodeSpec [Derived]
forall c. HasOldCodeSpec c => Lens' c [Derived]
Lens' CodeSpec [Derived]
derivedInputsO

-- | The parameters to the function for checking constraints on the inputs are
-- any inputs with constraints, and any variables used in the expressions of
-- the constraints.
getConstraintParams :: GenState [CodeVarChunk]
getConstraintParams :: GenState [CodeVarChunk]
getConstraintParams = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let s :: CodeSpec
s = DrasilState -> CodeSpec
codeSpec DrasilState
g
      cm :: ConstraintCEMap
cm = CodeSpec
s CodeSpec
-> Getting ConstraintCEMap CodeSpec ConstraintCEMap
-> ConstraintCEMap
forall s a. s -> Getting a s a -> a
^. Getting ConstraintCEMap CodeSpec ConstraintCEMap
forall c. HasOldCodeSpec c => Lens' c ConstraintCEMap
Lens' CodeSpec ConstraintCEMap
cMapO
      db :: ChunkDB
db = CodeSpec
s CodeSpec -> Getting ChunkDB CodeSpec ChunkDB -> ChunkDB
forall s a. s -> Getting a s a -> a
^. Getting ChunkDB CodeSpec ChunkDB
forall c. HasOldCodeSpec c => Lens' c ChunkDB
Lens' CodeSpec ChunkDB
sysinfodbO
      varsList :: [CodeVarChunk]
varsList = (CodeVarChunk -> Bool) -> [CodeVarChunk] -> [CodeVarChunk]
forall a. (a -> Bool) -> [a] -> [a]
filter (\CodeVarChunk
i -> UID -> ConstraintCEMap -> Bool
forall k a. Ord k => k -> Map k a -> Bool
member (CodeVarChunk
i CodeVarChunk -> Getting UID CodeVarChunk UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID CodeVarChunk UID
forall c. HasUID c => Getter c UID
Getter CodeVarChunk UID
uid) ConstraintCEMap
cm) (CodeSpec
s CodeSpec
-> Getting [CodeVarChunk] CodeSpec [CodeVarChunk] -> [CodeVarChunk]
forall s a. s -> Getting a s a -> a
^. Getting [CodeVarChunk] CodeSpec [CodeVarChunk]
forall c. HasOldCodeSpec c => Lens' c [CodeVarChunk]
Lens' CodeSpec [CodeVarChunk]
inputsO)
      reqdVals :: [CodeVarChunk]
reqdVals = [CodeVarChunk] -> [CodeVarChunk]
forall a. Eq a => [a] -> [a]
nub ([CodeVarChunk] -> [CodeVarChunk])
-> [CodeVarChunk] -> [CodeVarChunk]
forall a b. (a -> b) -> a -> b
$ [CodeVarChunk]
varsList [CodeVarChunk] -> [CodeVarChunk] -> [CodeVarChunk]
forall a. [a] -> [a] -> [a]
++ (CodeChunk -> CodeVarChunk) -> [CodeChunk] -> [CodeVarChunk]
forall a b. (a -> b) -> [a] -> [b]
map CodeChunk -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar ((ConstraintCE -> [CodeChunk]) -> [ConstraintCE] -> [CodeChunk]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ConstraintCE -> ChunkDB -> [CodeChunk]
`constraintvars` ChunkDB
db)
        (ConstraintCEMap -> [CodeVarChunk] -> [ConstraintCE]
forall c. HasUID c => ConstraintCEMap -> [c] -> [ConstraintCE]
getConstraints ConstraintCEMap
cm [CodeVarChunk]
varsList))
  String
icName <- InternalConcept -> GenState String
genICName InternalConcept
InputConstraintsFn
  String -> ParamType -> [CodeVarChunk] -> GenState [CodeVarChunk]
forall c.
(Quantity c, MayHaveUnit c) =>
String -> ParamType -> [c] -> GenState [CodeVarChunk]
getParams String
icName ParamType
In [CodeVarChunk]
reqdVals

-- | The parameters to a calculation function are any variables used in the
-- expression representing the calculation.
getCalcParams :: CodeDefinition -> GenState [CodeVarChunk]
getCalcParams :: Derived -> GenState [CodeVarChunk]
getCalcParams Derived
c = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  String -> ParamType -> [CodeVarChunk] -> GenState [CodeVarChunk]
forall c.
(Quantity c, MayHaveUnit c) =>
String -> ParamType -> [c] -> GenState [CodeVarChunk]
getParams (Derived -> String
forall c. CodeIdea c => c -> String
codeName Derived
c) ParamType
In ([CodeVarChunk] -> GenState [CodeVarChunk])
-> [CodeVarChunk] -> GenState [CodeVarChunk]
forall a b. (a -> b) -> a -> b
$ CodeVarChunk -> [CodeVarChunk] -> [CodeVarChunk]
forall a. Eq a => a -> [a] -> [a]
delete (Derived -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar Derived
c) ([CodeVarChunk] -> [CodeVarChunk])
-> [CodeVarChunk] -> [CodeVarChunk]
forall a b. (a -> b) -> a -> b
$ (CodeExpr -> [CodeVarChunk]) -> [CodeExpr] -> [CodeVarChunk]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (CodeExpr -> ChunkDB -> [CodeVarChunk]
`codevars'`
    (DrasilState -> CodeSpec
codeSpec DrasilState
g CodeSpec -> Getting ChunkDB CodeSpec ChunkDB -> ChunkDB
forall s a. s -> Getting a s a -> a
^. Getting ChunkDB CodeSpec ChunkDB
forall c. HasOldCodeSpec c => Lens' c ChunkDB
Lens' CodeSpec ChunkDB
sysinfodbO)) (Derived
c Derived -> Getting CodeExpr Derived CodeExpr -> CodeExpr
forall s a. s -> Getting a s a -> a
^. Getting CodeExpr Derived CodeExpr
forall c. DefiningCodeExpr c => Lens' c CodeExpr
Lens' Derived CodeExpr
codeExpr CodeExpr -> [CodeExpr] -> [CodeExpr]
forall a. a -> [a] -> [a]
: Derived
c Derived -> Getting [CodeExpr] Derived [CodeExpr] -> [CodeExpr]
forall s a. s -> Getting a s a -> a
^. Getting [CodeExpr] Derived [CodeExpr]
Lens' Derived [CodeExpr]
auxExprs)

-- | The parameters to the function for printing outputs are the outputs.
getOutputParams :: GenState [CodeVarChunk]
getOutputParams :: GenState [CodeVarChunk]
getOutputParams = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  String
woName <- InternalConcept -> GenState String
genICName InternalConcept
WriteOutput
  String -> ParamType -> [CodeVarChunk] -> GenState [CodeVarChunk]
forall c.
(Quantity c, MayHaveUnit c) =>
String -> ParamType -> [c] -> GenState [CodeVarChunk]
getParams String
woName ParamType
In ([CodeVarChunk] -> GenState [CodeVarChunk])
-> [CodeVarChunk] -> GenState [CodeVarChunk]
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g CodeSpec
-> Getting [CodeVarChunk] CodeSpec [CodeVarChunk] -> [CodeVarChunk]
forall s a. s -> Getting a s a -> a
^. Getting [CodeVarChunk] CodeSpec [CodeVarChunk]
forall c. HasOldCodeSpec c => Lens' c [CodeVarChunk]
Lens' CodeSpec [CodeVarChunk]
outputsO

-- | Passes parameters that are inputs to 'getInputVars' for further processing.
-- Passes parameters that are constants to 'getConstVars' for further processing.
-- Other parameters are put into the returned parameter list as long as they
-- are not matched to a code concept.
getParams :: (Quantity c, MayHaveUnit c) => Name -> ParamType -> [c] ->
  GenState [CodeVarChunk]
getParams :: forall c.
(Quantity c, MayHaveUnit c) =>
String -> ParamType -> [c] -> GenState [CodeVarChunk]
getParams String
n ParamType
pt [c]
cs' = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let s :: CodeSpec
s = DrasilState -> CodeSpec
codeSpec DrasilState
g
      cs :: [CodeVarChunk]
cs = (c -> CodeVarChunk) -> [c] -> [CodeVarChunk]
forall a b. (a -> b) -> [a] -> [b]
map c -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar [c]
cs'
      ins :: [CodeVarChunk]
ins = CodeSpec
s CodeSpec
-> Getting [CodeVarChunk] CodeSpec [CodeVarChunk] -> [CodeVarChunk]
forall s a. s -> Getting a s a -> a
^. Getting [CodeVarChunk] CodeSpec [CodeVarChunk]
forall c. HasOldCodeSpec c => Lens' c [CodeVarChunk]
Lens' CodeSpec [CodeVarChunk]
inputsO
      cnsnts :: [CodeVarChunk]
cnsnts = (Derived -> CodeVarChunk) -> [Derived] -> [CodeVarChunk]
forall a b. (a -> b) -> [a] -> [b]
map Derived -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar ([Derived] -> [CodeVarChunk]) -> [Derived] -> [CodeVarChunk]
forall a b. (a -> b) -> a -> b
$ CodeSpec
s CodeSpec -> Getting [Derived] CodeSpec [Derived] -> [Derived]
forall s a. s -> Getting a s a -> a
^. Getting [Derived] CodeSpec [Derived]
forall c. HasOldCodeSpec c => Lens' c [Derived]
Lens' CodeSpec [Derived]
constantsO
      inpVars :: [CodeVarChunk]
inpVars = (CodeVarChunk -> Bool) -> [CodeVarChunk] -> [CodeVarChunk]
forall a. (a -> Bool) -> [a] -> [a]
filter (CodeVarChunk -> [CodeVarChunk] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CodeVarChunk]
ins) [CodeVarChunk]
cs
      conVars :: [CodeVarChunk]
conVars = (CodeVarChunk -> Bool) -> [CodeVarChunk] -> [CodeVarChunk]
forall a. (a -> Bool) -> [a] -> [a]
filter (CodeVarChunk -> [CodeVarChunk] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CodeVarChunk]
cnsnts) [CodeVarChunk]
cs
      csSubIns :: [CodeVarChunk]
csSubIns = (CodeVarChunk -> Bool) -> [CodeVarChunk] -> [CodeVarChunk]
forall a. (a -> Bool) -> [a] -> [a]
filter ((UID -> Map UID CodeConcept -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`notMember` DrasilState -> Map UID CodeConcept
concMatches DrasilState
g) (UID -> Bool) -> (CodeVarChunk -> UID) -> CodeVarChunk -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CodeVarChunk -> Getting UID CodeVarChunk UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID CodeVarChunk UID
forall c. HasUID c => Getter c UID
Getter CodeVarChunk UID
uid))
        ([CodeVarChunk]
cs [CodeVarChunk] -> [CodeVarChunk] -> [CodeVarChunk]
forall a. Eq a => [a] -> [a] -> [a]
\\ ([CodeVarChunk]
ins [CodeVarChunk] -> [CodeVarChunk] -> [CodeVarChunk]
forall a. [a] -> [a] -> [a]
++ [CodeVarChunk]
cnsnts))
  [CodeVarChunk]
inVs <- String
-> ParamType
-> Structure
-> ConstantRepr
-> [CodeVarChunk]
-> GenState [CodeVarChunk]
getInputVars String
n ParamType
pt (DrasilState -> Structure
inStruct DrasilState
g) ConstantRepr
Var [CodeVarChunk]
inpVars
  [CodeVarChunk]
conVs <- String
-> ParamType
-> ConstantStructure
-> ConstantRepr
-> [CodeVarChunk]
-> GenState [CodeVarChunk]
getConstVars String
n ParamType
pt (DrasilState -> ConstantStructure
conStruct DrasilState
g) (DrasilState -> ConstantRepr
conRepr DrasilState
g) [CodeVarChunk]
conVars
  [CodeVarChunk] -> GenState [CodeVarChunk]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ([CodeVarChunk] -> GenState [CodeVarChunk])
-> [CodeVarChunk] -> GenState [CodeVarChunk]
forall a b. (a -> b) -> a -> b
$ [CodeVarChunk] -> [CodeVarChunk]
forall a. Eq a => [a] -> [a]
nub ([CodeVarChunk] -> [CodeVarChunk])
-> [CodeVarChunk] -> [CodeVarChunk]
forall a b. (a -> b) -> a -> b
$ [CodeVarChunk]
inVs [CodeVarChunk] -> [CodeVarChunk] -> [CodeVarChunk]
forall a. [a] -> [a] -> [a]
++ [CodeVarChunk]
conVs [CodeVarChunk] -> [CodeVarChunk] -> [CodeVarChunk]
forall a. [a] -> [a] -> [a]
++ [CodeVarChunk]
csSubIns

-- | If the passed list of input variables is empty, then return empty list.
-- If the user has chosen 'Unbundled' inputs, then the input variables are
-- returned as-is.
-- If the user has chosen 'Bundled' inputs, and the parameters are inputs to the
-- function (as opposed to outputs), then the 'inParams' object is returned
-- instead of the individual input variables, unless the function being
-- parameterized is itself defined in the InputParameters class, in which case
-- the inputs are already in scope and thus no parameter is required.
-- If the 'ParamType' is 'Out', the 'inParams' object is not an output parameter
-- because it undergoes state transitions, so is not actually an output.
-- The final case only happens when getInputVars is called by 'getConstVars'
-- because the user has chosen 'WithInputs' as their constant structure. If they
-- have chosen 'Bundled' inputs and a constant const representation, then the
-- constant variables are static and can be accessed through the class, without
-- an object, so no parameters are required.
getInputVars :: Name -> ParamType -> Structure -> ConstantRepr ->
  [CodeVarChunk] -> GenState [CodeVarChunk]
getInputVars :: String
-> ParamType
-> Structure
-> ConstantRepr
-> [CodeVarChunk]
-> GenState [CodeVarChunk]
getInputVars String
_ ParamType
_ Structure
_ ConstantRepr
_ [] = [CodeVarChunk] -> GenState [CodeVarChunk]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return []
getInputVars String
_ ParamType
_ Structure
Unbundled ConstantRepr
_ [CodeVarChunk]
cs = [CodeVarChunk] -> GenState [CodeVarChunk]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [CodeVarChunk]
cs
getInputVars String
n ParamType
pt Structure
Bundled ConstantRepr
Var [CodeVarChunk]
_ = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  String
cname <- InternalConcept -> GenState String
genICName InternalConcept
InputParameters
  [CodeVarChunk] -> GenState [CodeVarChunk]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar QuantityDict
inParams | String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
n (DrasilState -> Map String String
clsMap DrasilState
g) Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
/= String -> Maybe String
forall a. a -> Maybe a
Just String
cname Bool -> Bool -> Bool
&& ParamType -> Bool
isIn ParamType
pt]
getInputVars String
_ ParamType
_ Structure
Bundled ConstantRepr
Const [CodeVarChunk]
_ = [CodeVarChunk] -> GenState [CodeVarChunk]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return []

-- | If the passed list of constant variables is empty, then return empty list.
-- If the user has chosen 'Unbundled' constants, then the constant variables are
-- returned as-is.
-- If the user has chosen 'Bundled' constants and 'Var' representation, and the
-- parameters are inputs to the function (as opposed to outputs), then the
-- 'consts' object is returned instead of the individual constant variables.
-- If the 'ParamType' is 'Out', the 'consts' object is not an output parameter
-- because it undergoes state transitions, so is not actually an output.
-- The final case only happens when 'getInputVars' is called by 'getConstVars'
-- because the user has chosen 'WithInputs' as their constant structure. If they
-- have chosen 'Bundled' inputs and a constant const representation, then the
-- constant variables are static and can be accessed through the class, without
-- an object, so no parameters are required.
getConstVars :: Name -> ParamType -> ConstantStructure -> ConstantRepr ->
  [CodeVarChunk] -> GenState [CodeVarChunk]
getConstVars :: String
-> ParamType
-> ConstantStructure
-> ConstantRepr
-> [CodeVarChunk]
-> GenState [CodeVarChunk]
getConstVars String
_ ParamType
_ ConstantStructure
_ ConstantRepr
_ [] = [CodeVarChunk] -> GenState [CodeVarChunk]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return []
getConstVars String
_ ParamType
_ (Store Structure
Unbundled) ConstantRepr
_ [CodeVarChunk]
cs = [CodeVarChunk] -> GenState [CodeVarChunk]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [CodeVarChunk]
cs
getConstVars String
_ ParamType
pt (Store Structure
Bundled) ConstantRepr
Var [CodeVarChunk]
_ = [CodeVarChunk] -> GenState [CodeVarChunk]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar QuantityDict
consts | ParamType -> Bool
isIn ParamType
pt]
getConstVars String
_ ParamType
_ (Store Structure
Bundled) ConstantRepr
Const [CodeVarChunk]
_ = [CodeVarChunk] -> GenState [CodeVarChunk]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return []
getConstVars String
n ParamType
pt ConstantStructure
WithInputs ConstantRepr
cr [CodeVarChunk]
cs = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  String
-> ParamType
-> Structure
-> ConstantRepr
-> [CodeVarChunk]
-> GenState [CodeVarChunk]
getInputVars String
n ParamType
pt (DrasilState -> Structure
inStruct DrasilState
g) ConstantRepr
cr [CodeVarChunk]
cs
getConstVars String
_ ParamType
_ ConstantStructure
Inline ConstantRepr
_ [CodeVarChunk]
_ = [CodeVarChunk] -> GenState [CodeVarChunk]
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return []