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

import Language.Drasil hiding (isIn)
import Language.Drasil.Chunk.Code (CodeVarChunk, CodeIdea(codeChunk, codeName), 
  quantvar, codevars, codevars', DefiningCodeExpr(..))
import Language.Drasil.Chunk.CodeDefinition (CodeDefinition, auxExprs)
import Language.Drasil.Choices (Structure(..), InputModule(..), 
  ConstantStructure(..), ConstantRepr(..))
import Language.Drasil.Code.CodeQuantityDicts (inFileName, inParams, consts)
import Language.Drasil.Code.Imperative.DrasilState (GenState, DrasilState(..), 
  inMod)
import Language.Drasil.CodeSpec (CodeSpec(..), 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
/= :: ParamType -> ParamType -> Bool
$c/= :: ParamType -> ParamType -> Bool
== :: ParamType -> ParamType -> Bool
$c== :: 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
  let cname :: [Char]
cname = "InputParameters"
      getCParams :: Bool -> [CodeVarChunk]
getCParams False = []
      getCParams 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 <- [Char] -> ParamType -> [CodeVarChunk] -> GenState [CodeVarChunk]
forall c.
(Quantity c, MayHaveUnit c) =>
[Char] -> ParamType -> [c] -> GenState [CodeVarChunk]
getParams [Char]
cname ParamType
In ([CodeVarChunk] -> GenState [CodeVarChunk])
-> [CodeVarChunk] -> GenState [CodeVarChunk]
forall a b. (a -> b) -> a -> b
$ Bool -> [CodeVarChunk]
getCParams ([Char]
cname [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> [[Char]]
defList DrasilState
g)
  [CodeVarChunk] -> GenState [CodeVarChunk]
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 (([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
cname Maybe [Char] -> Maybe [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/=) (Maybe [Char] -> Bool)
-> (CodeVarChunk -> Maybe [Char]) -> CodeVarChunk -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Map [Char] [Char] -> Maybe [Char])
-> Map [Char] [Char] -> [Char] -> Maybe [Char]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Char] -> Map [Char] [Char] -> Maybe [Char]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (DrasilState -> Map [Char] [Char]
clsMap DrasilState
g) ([Char] -> Maybe [Char])
-> (CodeVarChunk -> [Char]) -> CodeVarChunk -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeVarChunk -> [Char]
forall c. CodeIdea c => c -> [Char]
codeName) [CodeVarChunk]
ps

-- | The inputs to the function for reading inputs are the input file name, and
-- the 'inParams' object if inputs are bundled and input components are separated.
-- The latter is needed because we want to populate the object through state 
-- transitions, not by returning it.
getInputFormatIns :: GenState [CodeVarChunk]
getInputFormatIns :: GenState [CodeVarChunk]
getInputFormatIns = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let getIns :: Structure -> InputModule -> [CodeVarChunk]
      getIns :: Structure -> InputModule -> [CodeVarChunk]
getIns Bundled Separated = [QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar QuantityDict
inParams]
      getIns _ _ = []
  [Char] -> ParamType -> [CodeVarChunk] -> GenState [CodeVarChunk]
forall c.
(Quantity c, MayHaveUnit c) =>
[Char] -> ParamType -> [c] -> GenState [CodeVarChunk]
getParams "get_input" ParamType
In ([CodeVarChunk] -> GenState [CodeVarChunk])
-> [CodeVarChunk] -> GenState [CodeVarChunk]
forall a b. (a -> b) -> a -> b
$ QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar QuantityDict
inFileName CodeVarChunk -> [CodeVarChunk] -> [CodeVarChunk]
forall a. a -> [a] -> [a]
: Structure -> InputModule -> [CodeVarChunk]
getIns (DrasilState -> Structure
inStruct DrasilState
g) (DrasilState -> InputModule
inMod DrasilState
g)

-- | 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
  [Char] -> ParamType -> [CodeVarChunk] -> GenState [CodeVarChunk]
forall c.
(Quantity c, MayHaveUnit c) =>
[Char] -> ParamType -> [c] -> GenState [CodeVarChunk]
getParams "get_input" ParamType
Out ([CodeVarChunk] -> GenState [CodeVarChunk])
-> [CodeVarChunk] -> GenState [CodeVarChunk]
forall a b. (a -> b) -> a -> b
$ CodeSpec -> [CodeVarChunk]
extInputs (CodeSpec -> [CodeVarChunk]) -> CodeSpec -> [CodeVarChunk]
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g

-- | 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 -> [Derived]
derivedInputs CodeSpec
s
      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 -> ChunkDB
sysinfodb CodeSpec
s) (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
codeExpr)) [Derived]
dvals
  [Char] -> ParamType -> [CodeVarChunk] -> GenState [CodeVarChunk]
forall c.
(Quantity c, MayHaveUnit c) =>
[Char] -> ParamType -> [c] -> GenState [CodeVarChunk]
getParams "derived_values" 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
  [Char] -> ParamType -> [CodeChunk] -> GenState [CodeVarChunk]
forall c.
(Quantity c, MayHaveUnit c) =>
[Char] -> ParamType -> [c] -> GenState [CodeVarChunk]
getParams "derived_values" 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
$ CodeSpec -> [Derived]
derivedInputs (CodeSpec -> [Derived]) -> CodeSpec -> [Derived]
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g

-- | 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 cm :: ConstraintCEMap
cm = CodeSpec -> ConstraintCEMap
cMap (CodeSpec -> ConstraintCEMap) -> CodeSpec -> ConstraintCEMap
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g
      db :: ChunkDB
db = CodeSpec -> ChunkDB
sysinfodb (CodeSpec -> ChunkDB) -> CodeSpec -> ChunkDB
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g
      varsList :: [CodeVarChunk]
varsList = (CodeVarChunk -> Bool) -> [CodeVarChunk] -> [CodeVarChunk]
forall a. (a -> Bool) -> [a] -> [a]
filter (\i :: 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 => Lens' c UID
uid) ConstraintCEMap
cm) (CodeSpec -> [CodeVarChunk]
inputs (CodeSpec -> [CodeVarChunk]) -> CodeSpec -> [CodeVarChunk]
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g)
      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))
  [Char] -> ParamType -> [CodeVarChunk] -> GenState [CodeVarChunk]
forall c.
(Quantity c, MayHaveUnit c) =>
[Char] -> ParamType -> [c] -> GenState [CodeVarChunk]
getParams "input_constraints" 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 c :: Derived
c = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  [Char] -> ParamType -> [CodeVarChunk] -> GenState [CodeVarChunk]
forall c.
(Quantity c, MayHaveUnit c) =>
[Char] -> ParamType -> [c] -> GenState [CodeVarChunk]
getParams (Derived -> [Char]
forall c. CodeIdea c => c -> [Char]
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'` 
    (CodeSpec -> ChunkDB
sysinfodb (CodeSpec -> ChunkDB) -> CodeSpec -> ChunkDB
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g)) (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
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
  [Char] -> ParamType -> [CodeVarChunk] -> GenState [CodeVarChunk]
forall c.
(Quantity c, MayHaveUnit c) =>
[Char] -> ParamType -> [c] -> GenState [CodeVarChunk]
getParams "write_output" ParamType
In ([CodeVarChunk] -> GenState [CodeVarChunk])
-> [CodeVarChunk] -> GenState [CodeVarChunk]
forall a b. (a -> b) -> a -> b
$ CodeSpec -> [CodeVarChunk]
outputs (CodeSpec -> [CodeVarChunk]) -> CodeSpec -> [CodeVarChunk]
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g

-- | 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 :: [Char] -> ParamType -> [c] -> GenState [CodeVarChunk]
getParams n :: [Char]
n pt :: ParamType
pt cs' :: [c]
cs' = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let 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 -> [CodeVarChunk]
inputs (CodeSpec -> [CodeVarChunk]) -> CodeSpec -> [CodeVarChunk]
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g
      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 -> [Derived]
constants (CodeSpec -> [Derived]) -> CodeSpec -> [Derived]
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g
      inpVars :: [CodeVarChunk]
inpVars = (CodeVarChunk -> Bool) -> [CodeVarChunk] -> [CodeVarChunk]
forall a. (a -> Bool) -> [a] -> [a]
filter (CodeVarChunk -> [CodeVarChunk] -> 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 (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 => Lens' c 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 <- [Char]
-> ParamType
-> Structure
-> ConstantRepr
-> [CodeVarChunk]
-> GenState [CodeVarChunk]
getInputVars [Char]
n ParamType
pt (DrasilState -> Structure
inStruct DrasilState
g) ConstantRepr
Var [CodeVarChunk]
inpVars
  [CodeVarChunk]
conVs <- [Char]
-> ParamType
-> ConstantStructure
-> ConstantRepr
-> [CodeVarChunk]
-> GenState [CodeVarChunk]
getConstVars [Char]
n ParamType
pt (DrasilState -> ConstantStructure
conStruct DrasilState
g) (DrasilState -> ConstantRepr
conRepr DrasilState
g) [CodeVarChunk]
conVars
  [CodeVarChunk] -> GenState [CodeVarChunk]
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 :: [Char]
-> ParamType
-> Structure
-> ConstantRepr
-> [CodeVarChunk]
-> GenState [CodeVarChunk]
getInputVars _ _ _ _ [] = [CodeVarChunk] -> GenState [CodeVarChunk]
forall (m :: * -> *) a. Monad m => a -> m a
return []
getInputVars _ _ Unbundled _ cs :: [CodeVarChunk]
cs = [CodeVarChunk] -> GenState [CodeVarChunk]
forall (m :: * -> *) a. Monad m => a -> m a
return [CodeVarChunk]
cs
getInputVars n :: [Char]
n pt :: ParamType
pt Bundled Var _ = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let cname :: [Char]
cname = "InputParameters"
  [CodeVarChunk] -> GenState [CodeVarChunk]
forall (m :: * -> *) a. Monad m => a -> m a
return [QuantityDict -> CodeVarChunk
forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar QuantityDict
inParams | [Char] -> Map [Char] [Char] -> Maybe [Char]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Char]
n (DrasilState -> Map [Char] [Char]
clsMap DrasilState
g) Maybe [Char] -> Maybe [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
cname Bool -> Bool -> Bool
&& ParamType -> Bool
isIn ParamType
pt]
getInputVars _ _ Bundled Const _ = [CodeVarChunk] -> GenState [CodeVarChunk]
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 :: [Char]
-> ParamType
-> ConstantStructure
-> ConstantRepr
-> [CodeVarChunk]
-> GenState [CodeVarChunk]
getConstVars _ _ _ _ [] = [CodeVarChunk] -> GenState [CodeVarChunk]
forall (m :: * -> *) a. Monad m => a -> m a
return []
getConstVars _ _ (Store Unbundled) _ cs :: [CodeVarChunk]
cs = [CodeVarChunk] -> GenState [CodeVarChunk]
forall (m :: * -> *) a. Monad m => a -> m a
return [CodeVarChunk]
cs
getConstVars _ pt :: ParamType
pt (Store Bundled) Var _ = [CodeVarChunk] -> GenState [CodeVarChunk]
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 _ _ (Store Bundled) Const _ = [CodeVarChunk] -> GenState [CodeVarChunk]
forall (m :: * -> *) a. Monad m => a -> m a
return []
getConstVars n :: [Char]
n pt :: ParamType
pt WithInputs cr :: ConstantRepr
cr cs :: [CodeVarChunk]
cs = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  [Char]
-> ParamType
-> Structure
-> ConstantRepr
-> [CodeVarChunk]
-> GenState [CodeVarChunk]
getInputVars [Char]
n ParamType
pt (DrasilState -> Structure
inStruct DrasilState
g) ConstantRepr
cr [CodeVarChunk]
cs
getConstVars _ _ Inline _ _ = [CodeVarChunk] -> GenState [CodeVarChunk]
forall (m :: * -> *) a. Monad m => a -> m a
return []