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(..), 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
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 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 <- 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 :: String
cname = String
"InputParameters"
      getCParams :: Bool -> [CodeVarChunk]
getCParams Bool
False = []
      getCParams Bool
True = [CodeVarChunk]
ifPs forall a. [a] -> [a] -> [a]
++ [CodeVarChunk]
dvPs forall a. [a] -> [a] -> [a]
++ [CodeVarChunk]
icPs
  [CodeVarChunk]
ps <- forall c.
(Quantity c, MayHaveUnit c) =>
String -> ParamType -> [c] -> GenState [CodeVarChunk]
getParams String
cname ParamType
In forall a b. (a -> b) -> a -> b
$ Bool -> [CodeVarChunk]
getCParams (String
cname forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> [String]
defList DrasilState
g)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. a -> Maybe a
Just String
cname forall a. Eq a => a -> a -> Bool
/=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (DrasilState -> ClassDefinitionMap
clsMap DrasilState
g) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. CodeIdea c => c -> String
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 <- forall s (m :: * -> *). MonadState s m => m s
get
  let getIns :: Structure -> InputModule -> [CodeVarChunk]
      getIns :: Structure -> InputModule -> [CodeVarChunk]
getIns Structure
Bundled InputModule
Separated = [forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar QuantityDict
inParams]
      getIns Structure
_ InputModule
_ = []
  forall c.
(Quantity c, MayHaveUnit c) =>
String -> ParamType -> [c] -> GenState [CodeVarChunk]
getParams String
"get_input" ParamType
In forall a b. (a -> b) -> a -> b
$ forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar QuantityDict
inFileName 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 <- forall s (m :: * -> *). MonadState s m => m s
get
  forall c.
(Quantity c, MayHaveUnit c) =>
String -> ParamType -> [c] -> GenState [CodeVarChunk]
getParams String
"get_input" ParamType
Out forall a b. (a -> b) -> a -> b
$ CodeSpec -> [CodeVarChunk]
extInputs 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 <- 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 = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b c. (a -> b -> c) -> b -> a -> c
flip CodeExpr -> ChunkDB -> [CodeVarChunk]
codevars (CodeSpec -> ChunkDB
sysinfodb CodeSpec
s) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s a. s -> Getting a s a -> a
^. forall c. DefiningCodeExpr c => Lens' c CodeExpr
codeExpr)) [Derived]
dvals
  forall c.
(Quantity c, MayHaveUnit c) =>
String -> ParamType -> [c] -> GenState [CodeVarChunk]
getParams String
"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 <- forall s (m :: * -> *). MonadState s m => m s
get
  forall c.
(Quantity c, MayHaveUnit c) =>
String -> ParamType -> [c] -> GenState [CodeVarChunk]
getParams String
"derived_values" ParamType
Out forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall c. CodeIdea c => c -> CodeChunk
codeChunk forall a b. (a -> b) -> a -> b
$ CodeSpec -> [Derived]
derivedInputs 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 <- forall s (m :: * -> *). MonadState s m => m s
get
  let cm :: ConstraintCEMap
cm = CodeSpec -> ConstraintCEMap
cMap forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g
      db :: ChunkDB
db = CodeSpec -> ChunkDB
sysinfodb forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g
      varsList :: [CodeVarChunk]
varsList = forall a. (a -> Bool) -> [a] -> [a]
filter (\CodeVarChunk
i -> forall k a. Ord k => k -> Map k a -> Bool
member (CodeVarChunk
i forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid) ConstraintCEMap
cm) (CodeSpec -> [CodeVarChunk]
inputs forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g)
      reqdVals :: [CodeVarChunk]
reqdVals = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ [CodeVarChunk]
varsList forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ConstraintCE -> ChunkDB -> [CodeChunk]
`constraintvars` ChunkDB
db)
        (forall c. HasUID c => ConstraintCEMap -> [c] -> [ConstraintCE]
getConstraints ConstraintCEMap
cm [CodeVarChunk]
varsList))
  forall c.
(Quantity c, MayHaveUnit c) =>
String -> ParamType -> [c] -> GenState [CodeVarChunk]
getParams String
"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 Derived
c = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  forall c.
(Quantity c, MayHaveUnit c) =>
String -> ParamType -> [c] -> GenState [CodeVarChunk]
getParams (forall c. CodeIdea c => c -> String
codeName Derived
c) ParamType
In forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> [a] -> [a]
delete (forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar Derived
c) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (CodeExpr -> ChunkDB -> [CodeVarChunk]
`codevars'`
    (CodeSpec -> ChunkDB
sysinfodb forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g)) (Derived
c forall s a. s -> Getting a s a -> a
^. forall c. DefiningCodeExpr c => Lens' c CodeExpr
codeExpr forall a. a -> [a] -> [a]
: Derived
c forall s a. s -> Getting a s a -> a
^. 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 <- forall s (m :: * -> *). MonadState s m => m s
get
  forall c.
(Quantity c, MayHaveUnit c) =>
String -> ParamType -> [c] -> GenState [CodeVarChunk]
getParams String
"write_output" ParamType
In forall a b. (a -> b) -> a -> b
$ CodeSpec -> [CodeVarChunk]
outputs 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 :: forall c.
(Quantity c, MayHaveUnit c) =>
String -> ParamType -> [c] -> GenState [CodeVarChunk]
getParams String
n ParamType
pt [c]
cs' = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  let cs :: [CodeVarChunk]
cs = forall a b. (a -> b) -> [a] -> [b]
map forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar [c]
cs'
      ins :: [CodeVarChunk]
ins = CodeSpec -> [CodeVarChunk]
inputs forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g
      cnsnts :: [CodeVarChunk]
cnsnts = forall a b. (a -> b) -> [a] -> [b]
map forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar forall a b. (a -> b) -> a -> b
$ CodeSpec -> [Derived]
constants forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g
      inpVars :: [CodeVarChunk]
inpVars = forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CodeVarChunk]
ins) [CodeVarChunk]
cs
      conVars :: [CodeVarChunk]
conVars = forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CodeVarChunk]
cnsnts) [CodeVarChunk]
cs
      csSubIns :: [CodeVarChunk]
csSubIns = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall k a. Ord k => k -> Map k a -> Bool
`notMember` DrasilState -> MatchedConceptMap
concMatches DrasilState
g) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid))
        ([CodeVarChunk]
cs forall a. Eq a => [a] -> [a] -> [a]
\\ ([CodeVarChunk]
ins 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
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ [CodeVarChunk]
inVs forall a. [a] -> [a] -> [a]
++ [CodeVarChunk]
conVs 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
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
getInputVars String
_ ParamType
_ Structure
Unbundled ConstantRepr
_ [CodeVarChunk]
cs = forall (m :: * -> *) a. Monad m => a -> m a
return [CodeVarChunk]
cs
getInputVars String
n ParamType
pt Structure
Bundled ConstantRepr
Var [CodeVarChunk]
_ = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  let cname :: String
cname = String
"InputParameters"
  forall (m :: * -> *) a. Monad m => a -> m a
return [forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar QuantityDict
inParams | forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
n (DrasilState -> ClassDefinitionMap
clsMap DrasilState
g) forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just String
cname Bool -> Bool -> Bool
&& ParamType -> Bool
isIn ParamType
pt]
getInputVars String
_ ParamType
_ Structure
Bundled ConstantRepr
Const [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 :: String
-> ParamType
-> ConstantStructure
-> ConstantRepr
-> [CodeVarChunk]
-> GenState [CodeVarChunk]
getConstVars String
_ ParamType
_ ConstantStructure
_ ConstantRepr
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
getConstVars String
_ ParamType
_ (Store Structure
Unbundled) ConstantRepr
_ [CodeVarChunk]
cs = forall (m :: * -> *) a. Monad m => a -> m a
return [CodeVarChunk]
cs
getConstVars String
_ ParamType
pt (Store Structure
Bundled) ConstantRepr
Var [CodeVarChunk]
_ = forall (m :: * -> *) a. Monad m => a -> m a
return [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]
_ = forall (m :: * -> *) a. Monad m => a -> m a
return []
getConstVars String
n ParamType
pt ConstantStructure
WithInputs ConstantRepr
cr [CodeVarChunk]
cs = do
  DrasilState
g <- 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]
_ = forall (m :: * -> *) a. Monad m => a -> m a
return []