module Language.Drasil.Code.Imperative.Parameters(getInConstructorParams,
getInputFormatIns, getInputFormatOuts, getDerivedIns, getDerivedOuts,
getConstraintParams, getCalcParams, getOutputParams, resolveOutputDefType
) where
import Control.Lens ((^.))
import Control.Monad.State (get)
import Data.List (nub, (\\), delete)
import Data.Map (member, notMember)
import qualified Data.Map as Map (fromList, lookup)
import Language.Drasil hiding (isIn)
import Drasil.Database (HasUID(..), UID)
import Drasil.System (systemdb)
import Drasil.Code.CodeVar (CodeIdea(..), DefiningCodeExpr(..), CodeVarChunk,
quantvar)
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, HasChoices(..))
import Language.Drasil.CodeSpec (HasCodeSpec(..), constraintvars, getConstraints)
import Language.Drasil.Mod (Name)
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
isIn :: ParamType -> Bool
isIn :: ParamType -> Bool
isIn = (ParamType
In ParamType -> ParamType -> Bool
forall a. Eq a => a -> a -> Bool
==)
getInConstructorParams :: GenState [CodeVarChunk]
getInConstructorParams :: GenState [CodeVarChunk]
getInConstructorParams = do
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
ifPs <- getInputFormatIns
dvPs <- getDerivedIns
icPs <- getConstraintParams
ipName <- genICName InputParameters
let 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
ps <- getParams ipName In $ getCParams (ipName `elem` defSet g)
return $ filter ((Just ipName /=) . flip Map.lookup (clsMap g) . codeName) ps
getInputFormatIns :: GenState [CodeVarChunk]
getInputFormatIns :: GenState [CodeVarChunk]
getInputFormatIns = do
giName <- InternalConcept -> GenState String
genICName InternalConcept
GetInput
getParams giName In [quantvar inFileName]
getInputFormatOuts :: GenState [CodeVarChunk]
getInputFormatOuts :: GenState [CodeVarChunk]
getInputFormatOuts = do
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
giName <- genICName GetInput
getParams giName Out $ g ^. extInputs
getDerivedIns :: GenState [CodeVarChunk]
getDerivedIns :: GenState [CodeVarChunk]
getDerivedIns = do
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
let s = DrasilState
g
dvals = DrasilState
s DrasilState
-> Getting [CodeDefinition] DrasilState [CodeDefinition]
-> [CodeDefinition]
forall s a. s -> Getting a s a -> a
^. Getting [CodeDefinition] DrasilState [CodeDefinition]
forall c. HasCodeSpec c => Lens' c [CodeDefinition]
Lens' DrasilState [CodeDefinition]
derivedInputs
reqdVals = (CodeDefinition -> [CodeVarChunk])
-> [CodeDefinition] -> [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 (DrasilState
s DrasilState -> Getting ChunkDB DrasilState ChunkDB -> ChunkDB
forall s a. s -> Getting a s a -> a
^. Getting ChunkDB DrasilState ChunkDB
forall c. HasSystemMeta c => Lens' c ChunkDB
Lens' DrasilState ChunkDB
systemdb) (CodeExpr -> [CodeVarChunk])
-> (CodeDefinition -> CodeExpr) -> CodeDefinition -> [CodeVarChunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CodeDefinition
-> Getting CodeExpr CodeDefinition CodeExpr -> CodeExpr
forall s a. s -> Getting a s a -> a
^. Getting CodeExpr CodeDefinition CodeExpr
forall c. DefiningCodeExpr c => Lens' c CodeExpr
Lens' CodeDefinition CodeExpr
codeExpr)) [CodeDefinition]
dvals
dvName <- genICName DerivedValuesFn
getParams dvName In reqdVals
getDerivedOuts :: GenState [CodeVarChunk]
getDerivedOuts :: GenState [CodeVarChunk]
getDerivedOuts = do
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
dvName <- genICName DerivedValuesFn
getParams dvName Out $ map codeChunk $ g ^. derivedInputs
getConstraintParams :: GenState [CodeVarChunk]
getConstraintParams :: GenState [CodeVarChunk]
getConstraintParams = do
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
let s = DrasilState
g
cm = DrasilState
s DrasilState
-> Getting ConstraintCEMap DrasilState ConstraintCEMap
-> ConstraintCEMap
forall s a. s -> Getting a s a -> a
^. Getting ConstraintCEMap DrasilState ConstraintCEMap
forall c. HasCodeSpec c => Lens' c ConstraintCEMap
Lens' DrasilState ConstraintCEMap
cMap
db = DrasilState
s DrasilState -> Getting ChunkDB DrasilState ChunkDB -> ChunkDB
forall s a. s -> Getting a s a -> a
^. Getting ChunkDB DrasilState ChunkDB
forall c. HasSystemMeta c => Lens' c ChunkDB
Lens' DrasilState ChunkDB
systemdb
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) (DrasilState
s DrasilState
-> Getting [CodeVarChunk] DrasilState [CodeVarChunk]
-> [CodeVarChunk]
forall s a. s -> Getting a s a -> a
^. Getting [CodeVarChunk] DrasilState [CodeVarChunk]
forall c. HasCodeSpec c => Lens' c [CodeVarChunk]
Lens' DrasilState [CodeVarChunk]
inputs)
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]
++
(ConstraintCE -> [CodeVarChunk])
-> [ConstraintCE] -> [CodeVarChunk]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ConstraintCE -> ChunkDB -> [CodeVarChunk]
`constraintvars` ChunkDB
db) (ConstraintCEMap -> [CodeVarChunk] -> [ConstraintCE]
forall c. HasUID c => ConstraintCEMap -> [c] -> [ConstraintCE]
getConstraints ConstraintCEMap
cm [CodeVarChunk]
varsList)
icName <- genICName InputConstraintsFn
getParams icName In reqdVals
getCalcParams :: CodeDefinition -> GenState [CodeVarChunk]
getCalcParams :: CodeDefinition -> GenState [CodeVarChunk]
getCalcParams CodeDefinition
c = do
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
getParams (codeName c) In $ delete (quantvar c) $ concatMap (`codevars'`
(g ^. systemdb)) (c ^. codeExpr : c ^. auxExprs)
getOutputParams :: GenState [CodeVarChunk]
getOutputParams :: GenState [CodeVarChunk]
getOutputParams = do
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
woName <- genICName WriteOutput
getParams woName In $ map (resolveOutputDefType g) (g ^. outputs)
resolveOutputDefType :: DrasilState -> CodeVarChunk -> CodeVarChunk
resolveOutputDefType :: DrasilState -> CodeVarChunk -> CodeVarChunk
resolveOutputDefType DrasilState
g CodeVarChunk
out =
CodeVarChunk
-> (CodeDefinition -> CodeVarChunk)
-> Maybe CodeDefinition
-> CodeVarChunk
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CodeVarChunk
out CodeDefinition -> CodeVarChunk
forall c.
(Quantity c, MayHaveUnit c, Concept c) =>
c -> CodeVarChunk
quantvar (Maybe CodeDefinition -> CodeVarChunk)
-> Maybe CodeDefinition -> CodeVarChunk
forall a b. (a -> b) -> a -> b
$
UID -> Map UID CodeDefinition -> Maybe CodeDefinition
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (CodeVarChunk
out 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) ([(UID, CodeDefinition)] -> Map UID CodeDefinition
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(UID, CodeDefinition)]
defsByUID)
where
defsByUID :: [(UID, CodeDefinition)]
defsByUID :: [(UID, CodeDefinition)]
defsByUID = (CodeDefinition -> (UID, CodeDefinition))
-> [CodeDefinition] -> [(UID, CodeDefinition)]
forall a b. (a -> b) -> [a] -> [b]
map (\CodeDefinition
d -> (CodeDefinition
d CodeDefinition -> Getting UID CodeDefinition UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID CodeDefinition UID
forall c. HasUID c => Getter c UID
Getter CodeDefinition UID
uid, CodeDefinition
d)) (DrasilState
g DrasilState
-> Getting [CodeDefinition] DrasilState [CodeDefinition]
-> [CodeDefinition]
forall s a. s -> Getting a s a -> a
^. Getting [CodeDefinition] DrasilState [CodeDefinition]
forall c. HasCodeSpec c => Lens' c [CodeDefinition]
Lens' DrasilState [CodeDefinition]
execOrder)
getParams :: (Quantity c, MayHaveUnit c, Concept c) => Name -> ParamType -> [c] ->
GenState [CodeVarChunk]
getParams :: forall c.
(Quantity c, MayHaveUnit c, Concept c) =>
String -> ParamType -> [c] -> GenState [CodeVarChunk]
getParams String
n ParamType
pt [c]
cs' = do
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
let s = DrasilState
g
cs = (c -> CodeVarChunk) -> [c] -> [CodeVarChunk]
forall a b. (a -> b) -> [a] -> [b]
map c -> CodeVarChunk
forall c.
(Quantity c, MayHaveUnit c, Concept c) =>
c -> CodeVarChunk
quantvar [c]
cs'
ins = DrasilState
s DrasilState
-> Getting [CodeVarChunk] DrasilState [CodeVarChunk]
-> [CodeVarChunk]
forall s a. s -> Getting a s a -> a
^. Getting [CodeVarChunk] DrasilState [CodeVarChunk]
forall c. HasCodeSpec c => Lens' c [CodeVarChunk]
Lens' DrasilState [CodeVarChunk]
inputs
cnsnts = (CodeDefinition -> CodeVarChunk)
-> [CodeDefinition] -> [CodeVarChunk]
forall a b. (a -> b) -> [a] -> [b]
map CodeDefinition -> CodeVarChunk
forall c.
(Quantity c, MayHaveUnit c, Concept c) =>
c -> CodeVarChunk
quantvar ([CodeDefinition] -> [CodeVarChunk])
-> [CodeDefinition] -> [CodeVarChunk]
forall a b. (a -> b) -> a -> b
$ DrasilState
s DrasilState
-> Getting [CodeDefinition] DrasilState [CodeDefinition]
-> [CodeDefinition]
forall s a. s -> Getting a s a -> a
^. Getting [CodeDefinition] DrasilState [CodeDefinition]
forall c. HasCodeSpec c => Lens' c [CodeDefinition]
Lens' DrasilState [CodeDefinition]
constDefns
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 -> 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 -> 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
g DrasilState
-> Getting (Map UID CodeConcept) DrasilState (Map UID CodeConcept)
-> Map UID CodeConcept
forall s a. s -> Getting a s a -> a
^. Getting (Map UID CodeConcept) DrasilState (Map UID CodeConcept)
forall a. HasChoices a => Lens' a (Map UID CodeConcept)
Lens' DrasilState (Map UID CodeConcept)
concMatches)) (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))
inVs <- getInputVars n pt (g ^. inStruct) Var inpVars
conVs <- getConstVars n pt (g ^. conStruct) (g ^. conRepr) conVars
return $ nub $ inVs ++ conVs ++ csSubIns
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
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
cname <- genICName InputParameters
return [quantvar inParams | Map.lookup n (clsMap g) /= Just cname && isIn 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 []
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 [DefinedQuantityDict -> CodeVarChunk
forall c.
(Quantity c, MayHaveUnit c, Concept c) =>
c -> CodeVarChunk
quantvar DefinedQuantityDict
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
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
getInputVars n pt (g ^. inStruct) cr 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 []