module Language.Drasil.Code.Imperative.Modules (
  genMain, genMainFunc, chooseInModule, genInputClass, genInputDerived,
  genInputConstraints, genInputFormat, genConstMod, genConstClass, genCalcMod,
  genCalcFunc, genOutputMod, genOutputFormat, genSampleInput
) where

import Language.Drasil (Constraint(..), RealInterval(..),
  HasUID(uid), Stage(..))
import Database.Drasil (ChunkDB)
import Language.Drasil.CodeExpr.Development
import Language.Drasil.Code.Imperative.Comments (getComment)
import Language.Drasil.Code.Imperative.Descriptions (constClassDesc,
  constModDesc, derivedValuesDesc, dvFuncDesc, inConsFuncDesc, inFmtFuncDesc,
  inputClassDesc, inputConstraintsDesc, inputConstructorDesc, inputFormatDesc,
  inputParametersDesc, modDesc, outputFormatDesc, woFuncDesc, calcModDesc)
import Language.Drasil.Code.Imperative.FunctionCalls (getCalcCall,
  getAllInputCalls, getOutputCall)
import Language.Drasil.Code.Imperative.GenerateGOOL (ClassType(..), genModule,
  genModuleWithImports, primaryClass, auxClass)
import Language.Drasil.Code.Imperative.Helpers (liftS)
import Language.Drasil.Code.Imperative.Import (codeType, convExpr, convStmt,
  genConstructor, mkVal, mkVar, privateInOutMethod, privateMethod, publicFunc,
  publicInOutFunc, readData, renderC)
import Language.Drasil.Code.Imperative.Logging (maybeLog, varLogFile)
import Language.Drasil.Code.Imperative.Parameters (getConstraintParams,
  getDerivedIns, getDerivedOuts, getInConstructorParams, getInputFormatIns,
  getInputFormatOuts, getCalcParams, getOutputParams)
import Language.Drasil.Code.Imperative.DrasilState (GenState, DrasilState(..))
import Language.Drasil.Code.Imperative.GOOL.ClassInterface (AuxiliarySym(..))
import Language.Drasil.Chunk.Code (CodeIdea(codeName), CodeVarChunk, quantvar,
  DefiningCodeExpr(..))
import Language.Drasil.Chunk.CodeDefinition (CodeDefinition, DefinitionType(..),
  defType)
import Language.Drasil.Chunk.ConstraintMap (physLookup, sfwrLookup)
import Language.Drasil.Chunk.Parameter (pcAuto)
import Language.Drasil.Code.CodeQuantityDicts (inFileName, inParams, consts)
import Language.Drasil.Code.DataDesc (DataDesc, junkLine, singleton)
import Language.Drasil.Code.ExtLibImport (defs, imports, steps)
import Language.Drasil.Choices (Comments(..), ConstantStructure(..),
  ConstantRepr(..), ConstraintBehaviour(..), ImplementationType(..),
  InputModule(..), Logging(..), Structure(..), hasSampleInput)
import Language.Drasil.CodeSpec (CodeSpec(..))
import Language.Drasil.Expr.Development (Completeness(..))
import Language.Drasil.Printers (SingleLine(OneLine), codeExprDoc)

import GOOL.Drasil (SFile, MSBody, MSBlock, SVariable, SValue, MSStatement,
  SMethod, CSStateVar, SClass, OOProg, BodySym(..), bodyStatements, oneLiner,
  BlockSym(..), PermanenceSym(..), TypeSym(..), VariableSym(..), Literal(..),
  VariableValue(..), CommandLineArgs(..), BooleanExpression(..),
  StatementSym(..), AssignStatement(..), DeclStatement(..), objDecNewNoParams,
  extObjDecNewNoParams, IOStatement(..), ControlStatement(..), ifNoElse,
  ScopeSym(..), MethodSym(..), StateVarSym(..), pubDVar, convType, ScopeTag(..))

import Prelude hiding (print)
import Data.List (intersperse, partition)
import Data.Map ((!), elems, member)
import qualified Data.Map as Map (lookup, filter)
import Data.Maybe (maybeToList, catMaybes)
import Control.Monad (liftM2, zipWithM)
import Control.Monad.State (get, gets)
import Control.Lens ((^.))
import Text.PrettyPrint.HughesPJ (render)

type ConstraintCE = Constraint CodeExpr

---- MAIN ---

-- | Generates a controller module.
genMain :: (OOProg r) => GenState (SFile r)
genMain :: forall (r :: * -> *). OOProg r => GenState (SFile r)
genMain = forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
genModule Name
"Control" Name
"Controls the flow of the program"
  [forall (r :: * -> *). OOProg r => GenState (Maybe (SMethod r))
genMainFunc] []

-- | Generates a main function, to act as the controller for an SCS program.
-- The controller declares input and constant variables, then calls the
-- functions for reading input values, calculating derived inputs, checking
-- constraints, calculating outputs, and printing outputs.
-- Returns Nothing if the user chose to generate a library.
genMainFunc :: (OOProg r) => GenState (Maybe (SMethod r))
genMainFunc :: forall (r :: * -> *). OOProg r => GenState (Maybe (SMethod r))
genMainFunc = do
    DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
    let mainFunc :: ImplementationType
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
mainFunc ImplementationType
Library = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        mainFunc ImplementationType
Program = do
          VS (r (Variable r))
v_filename <- forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SVariable r)
mkVar forall a b. (a -> b) -> a -> b
$ forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar QuantityDict
inFileName
          [MS (r (Statement r))]
logInFile <- forall (r :: * -> *).
OOProg r =>
SVariable r -> GenState [MSStatement r]
maybeLog VS (r (Variable r))
v_filename
          Maybe (MS (r (Statement r)))
co <- forall (r :: * -> *). OOProg r => GenState (Maybe (MSStatement r))
initConsts
          Maybe (MS (r (Statement r)))
ip <- forall (r :: * -> *). OOProg r => GenState (Maybe (MSStatement r))
getInputDecl
          [MS (r (Statement r))]
ics <- forall (r :: * -> *). OOProg r => GenState [MSStatement r]
getAllInputCalls
          [Maybe (MS (r (Statement r)))]
varDef <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (r :: * -> *).
OOProg r =>
CodeDefinition -> GenState (Maybe (MSStatement r))
getCalcCall (CodeSpec -> [CodeDefinition]
execOrder forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g)
          Maybe (MS (r (Statement r)))
wo <- forall (r :: * -> *). OOProg r => GenState (Maybe (MSStatement r))
getOutputCall
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (if Comments
CommentFunc forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> [Comments]
commented DrasilState
g then forall (r :: * -> *). MethodSym r => MSBody r -> SMethod r
docMain else
            forall (r :: * -> *). MethodSym r => MSBody r -> SMethod r
mainFunction) forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *). BodySym r => [MSStatement r] -> MSBody r
bodyStatements forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *). OOProg r => [Logging] -> [MSStatement r]
initLogFileVar (DrasilState -> [Logging]
logKind DrasilState
g)
            forall a. [a] -> [a] -> [a]
++ forall (r :: * -> *).
DeclStatement r =>
SVariable r -> SValue r -> MSStatement r
varDecDef VS (r (Variable r))
v_filename (forall (r :: * -> *). CommandLineArgs r => Integer -> SValue r
arg Integer
0)
            forall a. a -> [a] -> [a]
: [MS (r (Statement r))]
logInFile
            -- Constants must be declared before inputs because some derived
            -- input definitions or input constraints may use the constants
            forall a. [a] -> [a] -> [a]
++ forall a. [Maybe a] -> [a]
catMaybes [Maybe (MS (r (Statement r)))
co, Maybe (MS (r (Statement r)))
ip] forall a. [a] -> [a] -> [a]
++ [MS (r (Statement r))]
ics forall a. [a] -> [a] -> [a]
++ forall a. [Maybe a] -> [a]
catMaybes ([Maybe (MS (r (Statement r)))]
varDef forall a. [a] -> [a] -> [a]
++ [Maybe (MS (r (Statement r)))
wo])
    forall {r :: * -> *}.
OOProg r =>
ImplementationType
-> StateT DrasilState Identity (Maybe (MS (r (Method r))))
mainFunc forall a b. (a -> b) -> a -> b
$ DrasilState -> ImplementationType
implType DrasilState
g

-- | If there are no inputs, the 'inParams' object still needs to be declared
-- if inputs are 'Bundled', constants are stored 'WithInputs', and constant
-- representation is 'Var'.
-- If there are inputs and they are not exported by any module, then they are
-- 'Unbundled' and are declared individually using 'varDec'.
-- If there are inputs and they are exported by a module, they are 'Bundled' in
-- the InputParameters class, so 'inParams' should be declared and constructed,
-- using 'objDecNew' if the inputs are exported by the current module, and
-- 'extObjDecNew' if they are exported by a different module.
getInputDecl :: (OOProg r) => GenState (Maybe (MSStatement r))
getInputDecl :: forall (r :: * -> *). OOProg r => GenState (Maybe (MSStatement r))
getInputDecl = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  VS (r (Variable r))
v_params <- forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SVariable r)
mkVar (forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar QuantityDict
inParams)
  [CodeVarChunk]
constrParams <- GenState [CodeVarChunk]
getInConstructorParams
  [VS (r (Value r))]
cps <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SValue r)
mkVal [CodeVarChunk]
constrParams
  let cname :: Name
cname = Name
"InputParameters"
      getDecl :: ([CodeVarChunk], [CodeVarChunk])
-> GenState (Maybe (MSStatement r))
getDecl ([],[]) = ([CodeVarChunk], [CodeVarChunk])
-> ConstantRepr
-> ConstantStructure
-> GenState (Maybe (MSStatement r))
constIns (forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. Ord k => k -> Map k a -> Bool
member (DrasilState -> ModExportMap
eMap DrasilState
g) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        forall c. CodeIdea c => c -> Name
codeName) (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 -> [CodeDefinition]
constants forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g)) (DrasilState -> ConstantRepr
conRepr DrasilState
g)
        (DrasilState -> ConstantStructure
conStruct DrasilState
g)
      getDecl ([],[CodeVarChunk]
ins) = do
        [VS (r (Variable r))]
vars <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SVariable r)
mkVar [CodeVarChunk]
ins
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *).
StatementSym r =>
[MSStatement r] -> MSStatement r
multi forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall (r :: * -> *).
DeclStatement r =>
SVariable r -> MSStatement r
varDec [VS (r (Variable r))]
vars
      getDecl (CodeVarChunk
i:[CodeVarChunk]
_,[]) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (if DrasilState -> Name
currentModule DrasilState
g forall a. Eq a => a -> a -> Bool
==
        DrasilState -> ModExportMap
eMap DrasilState
g forall k a. Ord k => Map k a -> k -> a
! forall c. CodeIdea c => c -> Name
codeName CodeVarChunk
i then forall (r :: * -> *).
DeclStatement r =>
SVariable r -> [SValue r] -> MSStatement r
objDecNew
        else forall (r :: * -> *).
DeclStatement r =>
Name -> SVariable r -> [SValue r] -> MSStatement r
extObjDecNew Name
cname) VS (r (Variable r))
v_params [VS (r (Value r))]
cps
      getDecl ([CodeVarChunk], [CodeVarChunk])
_ = forall a. HasCallStack => Name -> a
error (Name
"Inputs or constants are only partially contained in "
        forall a. [a] -> [a] -> [a]
++ Name
"a class")
      constIns :: ([CodeVarChunk], [CodeVarChunk])
-> ConstantRepr
-> ConstantStructure
-> GenState (Maybe (MSStatement r))
constIns ([],[]) ConstantRepr
_ ConstantStructure
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      -- If Const is chosen, don't declare an object because constants are static and accessed through class
      constIns ([CodeVarChunk], [CodeVarChunk])
cs ConstantRepr
Var ConstantStructure
WithInputs = ([CodeVarChunk], [CodeVarChunk])
-> GenState (Maybe (MSStatement r))
getDecl ([CodeVarChunk], [CodeVarChunk])
cs
      constIns ([CodeVarChunk], [CodeVarChunk])
_ ConstantRepr
_ ConstantStructure
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
  ([CodeVarChunk], [CodeVarChunk])
-> GenState (Maybe (MSStatement r))
getDecl (forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. Ord k => k -> Map k a -> Bool
member (DrasilState -> ModExportMap
eMap DrasilState
g) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. CodeIdea c => c -> Name
codeName)
    (CodeSpec -> [CodeVarChunk]
inputs forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g))

-- | If constants are 'Unbundled', declare them individually using 'varDecDef' if
-- representation is 'Var' and 'constDecDef' if representation is 'Const'.
-- If constants are 'Bundled' independently and representation is 'Var', declare
-- the consts object. If representation is 'Const', no object needs to be
-- declared because the constants will be accessed directly through the
-- Constants class.
-- If constants are 'Bundled' 'WithInputs', do 'Nothing'; declaration of the 'inParams'
-- object is handled by 'getInputDecl'.
-- If constants are 'Inlined', nothing needs to be declared.
initConsts :: (OOProg r) => GenState (Maybe (MSStatement r))
initConsts :: forall (r :: * -> *). OOProg r => GenState (Maybe (MSStatement r))
initConsts = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  VS (r (Variable r))
v_consts <- forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SVariable r)
mkVar (forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar QuantityDict
consts)
  let cname :: Name
cname = Name
"Constants"
      cs :: [CodeDefinition]
cs = CodeSpec -> [CodeDefinition]
constants forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g
      getDecl :: ConstantStructure -> Structure -> GenState (Maybe (MSStatement r))
getDecl (Store Structure
Unbundled) Structure
_ = GenState (Maybe (MSStatement r))
declVars
      getDecl (Store Structure
Bundled) Structure
_ = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall {c}.
CodeIdea c =>
[c] -> ConstantRepr -> Maybe (MSStatement r)
declObj [CodeDefinition]
cs forall b c a. (b -> c) -> (a -> b) -> a -> c
. DrasilState -> ConstantRepr
conRepr)
      getDecl ConstantStructure
WithInputs Structure
Unbundled = GenState (Maybe (MSStatement r))
declVars
      getDecl ConstantStructure
WithInputs Structure
Bundled = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      getDecl ConstantStructure
Inline Structure
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      declVars :: GenState (Maybe (MSStatement r))
declVars = do
        [VS (r (Variable r))]
vars <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SVariable r)
mkVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar) [CodeDefinition]
cs
        [VS (r (Value r))]
vals <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (r :: * -> *). OOProg r => CodeExpr -> GenState (SValue r)
convExpr 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)) [CodeDefinition]
cs
        [[MSStatement r]]
logs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (r :: * -> *).
OOProg r =>
SVariable r -> GenState [MSStatement r]
maybeLog [VS (r (Variable r))]
vars
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *).
StatementSym r =>
[MSStatement r] -> MSStatement r
multi forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall {r :: * -> *}.
DeclStatement r =>
ConstantRepr
-> VS (r (Variable r)) -> VS (r (Value r)) -> MS (r (Statement r))
defFunc forall a b. (a -> b) -> a -> b
$ DrasilState -> ConstantRepr
conRepr DrasilState
g) [VS (r (Variable r))]
vars [VS (r (Value r))]
vals forall a. [a] -> [a] -> [a]
++
          forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[MSStatement r]]
logs
      defFunc :: ConstantRepr
-> VS (r (Variable r)) -> VS (r (Value r)) -> MS (r (Statement r))
defFunc ConstantRepr
Var = forall (r :: * -> *).
DeclStatement r =>
SVariable r -> SValue r -> MSStatement r
varDecDef
      defFunc ConstantRepr
Const = forall (r :: * -> *).
DeclStatement r =>
SVariable r -> SValue r -> MSStatement r
constDecDef
      declObj :: [c] -> ConstantRepr -> Maybe (MSStatement r)
declObj [] ConstantRepr
_ = forall a. Maybe a
Nothing
      declObj (c
c:[c]
_) ConstantRepr
Var = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (if DrasilState -> Name
currentModule DrasilState
g forall a. Eq a => a -> a -> Bool
== DrasilState -> ModExportMap
eMap DrasilState
g forall k a. Ord k => Map k a -> k -> a
! forall c. CodeIdea c => c -> Name
codeName c
c
        then forall (r :: * -> *).
DeclStatement r =>
SVariable r -> MSStatement r
objDecNewNoParams else forall (r :: * -> *).
DeclStatement r =>
Name -> SVariable r -> MSStatement r
extObjDecNewNoParams Name
cname) VS (r (Variable r))
v_consts
      declObj [c]
_ ConstantRepr
Const = forall a. Maybe a
Nothing
  ConstantStructure -> Structure -> GenState (Maybe (MSStatement r))
getDecl (DrasilState -> ConstantStructure
conStruct DrasilState
g) (DrasilState -> Structure
inStruct DrasilState
g)

-- | Generates a statement to declare the variable representing the log file,
-- if the user chose to turn on logs for variable assignments.
initLogFileVar :: (OOProg r) => [Logging] -> [MSStatement r]
initLogFileVar :: forall (r :: * -> *). OOProg r => [Logging] -> [MSStatement r]
initLogFileVar [Logging]
l = [forall (r :: * -> *).
DeclStatement r =>
SVariable r -> MSStatement r
varDec forall (r :: * -> *). OOProg r => SVariable r
varLogFile | Logging
LogVar forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Logging]
l]

------- INPUT ----------

-- | Generates either a single module containing all input-related components, or
-- separate modules for each input-related component, depending on the user's
-- modularity choice.
chooseInModule :: (OOProg r) => InputModule -> GenState [SFile r]
chooseInModule :: forall (r :: * -> *). OOProg r => InputModule -> GenState [SFile r]
chooseInModule InputModule
Combined = forall (r :: * -> *). OOProg r => GenState [SFile r]
genInputModCombined
chooseInModule InputModule
Separated = forall (r :: * -> *). OOProg r => GenState [SFile r]
genInputModSeparated

-- | Generates separate modules for each input-related component.
genInputModSeparated :: (OOProg r) => GenState [SFile r]
genInputModSeparated :: forall (r :: * -> *). OOProg r => GenState [SFile r]
genInputModSeparated = do
  Name
ipDesc <- GenState [Name] -> GenState Name
modDesc GenState [Name]
inputParametersDesc
  Name
ifDesc <- GenState [Name] -> GenState Name
modDesc (forall a b. State a b -> State a [b]
liftS GenState Name
inputFormatDesc)
  Name
dvDesc <- GenState [Name] -> GenState Name
modDesc (forall a b. State a b -> State a [b]
liftS GenState Name
derivedValuesDesc)
  Name
icDesc <- GenState [Name] -> GenState Name
modDesc (forall a b. State a b -> State a [b]
liftS GenState Name
inputConstraintsDesc)
  forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
    [forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
genModule Name
"InputParameters" Name
ipDesc [] [forall (r :: * -> *).
OOProg r =>
ClassType -> GenState (Maybe (SClass r))
genInputClass ClassType
Primary],
    forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
genModule Name
"InputFormat" Name
ifDesc [forall (r :: * -> *).
OOProg r =>
ScopeTag -> GenState (Maybe (SMethod r))
genInputFormat ScopeTag
Pub] [],
    forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
genModule Name
"DerivedValues" Name
dvDesc [forall (r :: * -> *).
OOProg r =>
ScopeTag -> GenState (Maybe (SMethod r))
genInputDerived ScopeTag
Pub] [],
    forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
genModule Name
"InputConstraints" Name
icDesc [forall (r :: * -> *).
OOProg r =>
ScopeTag -> GenState (Maybe (SMethod r))
genInputConstraints ScopeTag
Pub] []]

-- | Generates a single module containing all input-related components.
genInputModCombined :: (OOProg r) => GenState [SFile r]
genInputModCombined :: forall (r :: * -> *). OOProg r => GenState [SFile r]
genInputModCombined = do
  Name
ipDesc <- GenState [Name] -> GenState Name
modDesc GenState [Name]
inputParametersDesc
  let cname :: Name
cname = Name
"InputParameters"
      genMod :: (OOProg r) => Maybe (SClass r) ->
        GenState (SFile r)
      genMod :: forall (r :: * -> *).
OOProg r =>
Maybe (SClass r) -> GenState (SFile r)
genMod Maybe (SClass r)
Nothing = forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
genModule Name
cname Name
ipDesc [forall (r :: * -> *).
OOProg r =>
ScopeTag -> GenState (Maybe (SMethod r))
genInputFormat ScopeTag
Pub,
        forall (r :: * -> *).
OOProg r =>
ScopeTag -> GenState (Maybe (SMethod r))
genInputDerived ScopeTag
Pub, forall (r :: * -> *).
OOProg r =>
ScopeTag -> GenState (Maybe (SMethod r))
genInputConstraints ScopeTag
Pub] []
      genMod Maybe (SClass r)
_ = forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
genModule Name
cname Name
ipDesc [] [forall (r :: * -> *).
OOProg r =>
ClassType -> GenState (Maybe (SClass r))
genInputClass ClassType
Primary]
  Maybe (CS (r (Class r)))
ic <- forall (r :: * -> *).
OOProg r =>
ClassType -> GenState (Maybe (SClass r))
genInputClass ClassType
Primary
  forall a b. State a b -> State a [b]
liftS forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *).
OOProg r =>
Maybe (SClass r) -> GenState (SFile r)
genMod Maybe (CS (r (Class r)))
ic

-- | Returns a function for generating a state variable for a constant.
-- Either generates a declare-define statement for a regular state variable
-- (if user chose 'Var'),
-- or a declare-define statement for a constant variable (if user chose 'Const').
constVarFunc :: (OOProg r) => ConstantRepr ->
  (SVariable r -> SValue r -> CSStateVar r)
constVarFunc :: forall (r :: * -> *).
OOProg r =>
ConstantRepr -> SVariable r -> SValue r -> CSStateVar r
constVarFunc ConstantRepr
Var = forall (r :: * -> *).
StateVarSym r =>
r (Scope r)
-> r (Permanence r) -> SVariable r -> SValue r -> CSStateVar r
stateVarDef forall (r :: * -> *). ScopeSym r => r (Scope r)
public forall (r :: * -> *). PermanenceSym r => r (Permanence r)
dynamic
constVarFunc ConstantRepr
Const = forall (r :: * -> *).
StateVarSym r =>
r (Scope r) -> SVariable r -> SValue r -> CSStateVar r
constVar forall (r :: * -> *). ScopeSym r => r (Scope r)
public

-- | Returns 'Nothing' if no inputs or constants are mapped to InputParameters in
-- the class definition map.
-- If any inputs or constants are defined in InputParameters, this generates
-- the InputParameters class containing the inputs and constants as state
-- variables. If the InputParameters constructor is also exported, then the
-- generated class also contains the input-related functions as private methods.
genInputClass :: (OOProg r) => ClassType ->
  GenState (Maybe (SClass r))
genInputClass :: forall (r :: * -> *).
OOProg r =>
ClassType -> GenState (Maybe (SClass r))
genInputClass ClassType
scp = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  let ins :: [CodeVarChunk]
ins = CodeSpec -> [CodeVarChunk]
inputs forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g
      cs :: [CodeDefinition]
cs = CodeSpec -> [CodeDefinition]
constants forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g
      filt :: (CodeIdea c) => [c] -> [c]
      filt :: forall c. CodeIdea c => [c] -> [c]
filt = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. a -> Maybe a
Just Name
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 -> ModExportMap
clsMap DrasilState
g) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. CodeIdea c => c -> Name
codeName)
      methods :: (OOProg r) => GenState [SMethod r]
      methods :: forall (r :: * -> *). OOProg r => GenState [SMethod r]
methods = if Name
cname forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> [Name]
defList DrasilState
g
        then forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Maybe a -> [a]
maybeToList) [forall (r :: * -> *). OOProg r => GenState (Maybe (SMethod r))
genInputConstructor,
        forall (r :: * -> *).
OOProg r =>
ScopeTag -> GenState (Maybe (SMethod r))
genInputFormat ScopeTag
Priv, forall (r :: * -> *).
OOProg r =>
ScopeTag -> GenState (Maybe (SMethod r))
genInputDerived ScopeTag
Priv, forall (r :: * -> *).
OOProg r =>
ScopeTag -> GenState (Maybe (SMethod r))
genInputConstraints ScopeTag
Priv]
        else forall (m :: * -> *) a. Monad m => a -> m a
return []
      genClass :: (OOProg r) => [CodeVarChunk] -> [CodeDefinition] ->
        GenState (Maybe (SClass r))
      genClass :: forall (r :: * -> *).
OOProg r =>
[CodeVarChunk] -> [CodeDefinition] -> GenState (Maybe (SClass r))
genClass [] [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      genClass [CodeVarChunk]
inps [CodeDefinition]
csts = do
        [VS (r (Value r))]
vals <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (r :: * -> *). OOProg r => CodeExpr -> GenState (SValue r)
convExpr 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)) [CodeDefinition]
csts
        [CS (r (StateVar r))]
inputVars <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\CodeVarChunk
x -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (r :: * -> *). StateVarSym r => SVariable r -> CSStateVar r
pubDVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *).
VariableSym r =>
Name -> VSType r -> SVariable r
var (forall c. CodeIdea c => c -> Name
codeName CodeVarChunk
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *). TypeSym r => CodeType -> VSType r
convType)
          (forall c. HasSpace c => c -> GenState CodeType
codeType CodeVarChunk
x)) [CodeVarChunk]
inps
        [CS (r (StateVar r))]
constVars <- forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\CodeDefinition
c VS (r (Value r))
vl -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\CodeType
t -> forall (r :: * -> *).
OOProg r =>
ConstantRepr -> SVariable r -> SValue r -> CSStateVar r
constVarFunc (DrasilState -> ConstantRepr
conRepr DrasilState
g)
          (forall (r :: * -> *).
VariableSym r =>
Name -> VSType r -> SVariable r
var (forall c. CodeIdea c => c -> Name
codeName CodeDefinition
c) (forall (r :: * -> *). TypeSym r => CodeType -> VSType r
convType CodeType
t)) VS (r (Value r))
vl) (forall c. HasSpace c => c -> GenState CodeType
codeType CodeDefinition
c))
          [CodeDefinition]
csts [VS (r (Value r))]
vals
        let getFunc :: ClassType
-> Name
-> Maybe Name
-> Name
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState (SClass r)
getFunc ClassType
Primary = forall (r :: * -> *).
OOProg r =>
Name
-> Maybe Name
-> Name
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState (SClass r)
primaryClass
            getFunc ClassType
Auxiliary = forall (r :: * -> *).
OOProg r =>
Name
-> Maybe Name
-> Name
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState (SClass r)
auxClass
            f :: Name
-> Maybe Name
-> Name
-> [CS (r (StateVar r))]
-> GenState [MS (r (Method r))]
-> GenState (SClass r)
f = forall {r :: * -> *}.
OOProg r =>
ClassType
-> Name
-> Maybe Name
-> Name
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState (SClass r)
getFunc ClassType
scp
        Name
icDesc <- GenState Name
inputClassDesc
        SClass r
c <- Name
-> Maybe Name
-> Name
-> [CS (r (StateVar r))]
-> GenState [MS (r (Method r))]
-> GenState (SClass r)
f Name
cname forall a. Maybe a
Nothing Name
icDesc ([CS (r (StateVar r))]
inputVars forall a. [a] -> [a] -> [a]
++ [CS (r (StateVar r))]
constVars) forall (r :: * -> *). OOProg r => GenState [SMethod r]
methods
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just SClass r
c
  forall (r :: * -> *).
OOProg r =>
[CodeVarChunk] -> [CodeDefinition] -> GenState (Maybe (SClass r))
genClass (forall c. CodeIdea c => [c] -> [c]
filt [CodeVarChunk]
ins) (forall c. CodeIdea c => [c] -> [c]
filt [CodeDefinition]
cs)
  where cname :: Name
cname = Name
"InputParameters"

-- | Generates a constructor for the input class, where the constructor calls the
-- input-related functions. Returns 'Nothing' if no input-related functions are
-- generated.
genInputConstructor :: (OOProg r) => GenState (Maybe (SMethod r))
genInputConstructor :: forall (r :: * -> *). OOProg r => GenState (Maybe (SMethod r))
genInputConstructor = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  let dl :: [Name]
dl = DrasilState -> [Name]
defList DrasilState
g
      genCtor :: Bool -> StateT DrasilState Identity (Maybe (MS (r (Method r))))
genCtor Bool
False = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      genCtor Bool
True = do
        Name
cdesc <- GenState Name
inputConstructorDesc
        [CodeVarChunk]
cparams <- GenState [CodeVarChunk]
getInConstructorParams
        [MS (r (Statement r))]
ics <- forall (r :: * -> *). OOProg r => GenState [MSStatement r]
getAllInputCalls
        MS (r (Method r))
ctor <- forall (r :: * -> *).
OOProg r =>
Name
-> Name -> [ParameterChunk] -> [MSBlock r] -> GenState (SMethod r)
genConstructor Name
"InputParameters" Name
cdesc (forall a b. (a -> b) -> [a] -> [b]
map forall c. CodeIdea c => c -> ParameterChunk
pcAuto [CodeVarChunk]
cparams)
          [forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block [MS (r (Statement r))]
ics]
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just MS (r (Method r))
ctor
  forall {r :: * -> *}.
OOProg r =>
Bool -> StateT DrasilState Identity (Maybe (MS (r (Method r))))
genCtor forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
dl) [Name
"get_input", Name
"derived_values",
    Name
"input_constraints"]

-- | Generates a function for calculating derived inputs.
genInputDerived :: (OOProg r) => ScopeTag ->
  GenState (Maybe (SMethod r))
genInputDerived :: forall (r :: * -> *).
OOProg r =>
ScopeTag -> GenState (Maybe (SMethod r))
genInputDerived ScopeTag
s = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  let dvals :: [CodeDefinition]
dvals = CodeSpec -> [CodeDefinition]
derivedInputs forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g
      getFunc :: ScopeTag
-> Name
-> Name
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MSBlock r]
-> GenState (SMethod r)
getFunc ScopeTag
Pub = forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MSBlock r]
-> GenState (SMethod r)
publicInOutFunc
      getFunc ScopeTag
Priv = forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MSBlock r]
-> GenState (SMethod r)
privateInOutMethod
      genDerived :: (OOProg r) => Bool -> GenState
        (Maybe (SMethod r))
      genDerived :: forall {r :: * -> *}.
OOProg r =>
Bool -> StateT DrasilState Identity (Maybe (MS (r (Method r))))
genDerived Bool
False = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      genDerived Bool
_ = do
        [CodeVarChunk]
ins <- GenState [CodeVarChunk]
getDerivedIns
        [CodeVarChunk]
outs <- GenState [CodeVarChunk]
getDerivedOuts
        [MS (r (Block r))]
bod <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\CodeDefinition
x -> forall (r :: * -> *).
OOProg r =>
CalcType -> CodeDefinition -> CodeExpr -> GenState (MSBlock r)
genCalcBlock CalcType
CalcAssign CodeDefinition
x (CodeDefinition
x forall s a. s -> Getting a s a -> a
^. forall c. DefiningCodeExpr c => Lens' c CodeExpr
codeExpr)) [CodeDefinition]
dvals
        Name
desc <- GenState Name
dvFuncDesc
        SMethod r
mthd <- forall {r :: * -> *}.
OOProg r =>
ScopeTag
-> Name
-> Name
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MSBlock r]
-> GenState (SMethod r)
getFunc ScopeTag
s Name
"derived_values" Name
desc [CodeVarChunk]
ins [CodeVarChunk]
outs [MS (r (Block r))]
bod
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just SMethod r
mthd
  forall {r :: * -> *}.
OOProg r =>
Bool -> StateT DrasilState Identity (Maybe (MS (r (Method r))))
genDerived forall a b. (a -> b) -> a -> b
$ Name
"derived_values" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> [Name]
defList DrasilState
g

-- | Generates function that checks constraints on the input.
genInputConstraints :: (OOProg r) => ScopeTag ->
  GenState (Maybe (SMethod r))
genInputConstraints :: forall (r :: * -> *).
OOProg r =>
ScopeTag -> GenState (Maybe (SMethod r))
genInputConstraints ScopeTag
s = 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
      getFunc :: ScopeTag
-> Name
-> VSType r
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MSBlock r]
-> GenState (SMethod r)
getFunc ScopeTag
Pub = forall (r :: * -> *).
OOProg r =>
Name
-> VSType r
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MSBlock r]
-> GenState (SMethod r)
publicFunc
      getFunc ScopeTag
Priv = forall (r :: * -> *).
OOProg r =>
Name
-> VSType r
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MSBlock r]
-> GenState (SMethod r)
privateMethod
      genConstraints :: (OOProg r) => Bool -> GenState
        (Maybe (SMethod r))
      genConstraints :: forall {r :: * -> *}.
OOProg r =>
Bool -> StateT DrasilState Identity (Maybe (MS (r (Method r))))
genConstraints Bool
False = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      genConstraints Bool
_ = do
        [CodeVarChunk]
parms <- GenState [CodeVarChunk]
getConstraintParams
        let 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)
            sfwrCs :: [(CodeVarChunk, [ConstraintCE])]
sfwrCs   = forall a b. (a -> b) -> [a] -> [b]
map (forall q. HasUID q => ConstraintCEMap -> q -> (q, [ConstraintCE])
sfwrLookup ConstraintCEMap
cm) [CodeVarChunk]
varsList
            physCs :: [(CodeVarChunk, [ConstraintCE])]
physCs   = forall a b. (a -> b) -> [a] -> [b]
map (forall q. HasUID q => ConstraintCEMap -> q -> (q, [ConstraintCE])
physLookup ConstraintCEMap
cm) [CodeVarChunk]
varsList
        [MS (r (Statement r))]
sf <- forall (r :: * -> *).
OOProg r =>
[(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
sfwrCBody [(CodeVarChunk, [ConstraintCE])]
sfwrCs
        [MS (r (Statement r))]
ph <- forall (r :: * -> *).
OOProg r =>
[(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
physCBody [(CodeVarChunk, [ConstraintCE])]
physCs
        Name
desc <- GenState Name
inConsFuncDesc
        SMethod r
mthd <- forall {r :: * -> *}.
OOProg r =>
ScopeTag
-> Name
-> VSType r
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MSBlock r]
-> GenState (SMethod r)
getFunc ScopeTag
s Name
"input_constraints" forall (r :: * -> *). TypeSym r => VSType r
void Name
desc (forall a b. (a -> b) -> [a] -> [b]
map forall c. CodeIdea c => c -> ParameterChunk
pcAuto [CodeVarChunk]
parms)
          forall a. Maybe a
Nothing [forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block [MS (r (Statement r))]
sf, forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block [MS (r (Statement r))]
ph]
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just SMethod r
mthd
  forall {r :: * -> *}.
OOProg r =>
Bool -> StateT DrasilState Identity (Maybe (MS (r (Method r))))
genConstraints forall a b. (a -> b) -> a -> b
$ Name
"input_constraints" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> [Name]
defList DrasilState
g

-- | Generates input constraints code block for checking software constraints.
sfwrCBody :: (OOProg r) => [(CodeVarChunk, [ConstraintCE])] ->
  GenState [MSStatement r]
sfwrCBody :: forall (r :: * -> *).
OOProg r =>
[(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
sfwrCBody [(CodeVarChunk, [ConstraintCE])]
cs = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  let cb :: ConstraintBehaviour
cb = DrasilState -> ConstraintBehaviour
onSfwrC DrasilState
g
  forall (r :: * -> *).
OOProg r =>
ConstraintBehaviour
-> [(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
chooseConstr ConstraintBehaviour
cb [(CodeVarChunk, [ConstraintCE])]
cs

-- | Generates input constraints code block for checking physical constraints.
physCBody :: (OOProg r) => [(CodeVarChunk, [ConstraintCE])] ->
  GenState [MSStatement r]
physCBody :: forall (r :: * -> *).
OOProg r =>
[(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
physCBody [(CodeVarChunk, [ConstraintCE])]
cs = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  let cb :: ConstraintBehaviour
cb = DrasilState -> ConstraintBehaviour
onPhysC DrasilState
g
  forall (r :: * -> *).
OOProg r =>
ConstraintBehaviour
-> [(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
chooseConstr ConstraintBehaviour
cb [(CodeVarChunk, [ConstraintCE])]
cs

-- | Generates conditional statements for checking constraints, where the
-- bodies depend on user's choice of constraint violation behaviour.
chooseConstr :: (OOProg r) => ConstraintBehaviour ->
  [(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
chooseConstr :: forall (r :: * -> *).
OOProg r =>
ConstraintBehaviour
-> [(CodeVarChunk, [ConstraintCE])] -> GenState [MSStatement r]
chooseConstr ConstraintBehaviour
cb [(CodeVarChunk, [ConstraintCE])]
cs = do
  [[VS (r (Value r))]]
conds <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(CodeVarChunk
q,[ConstraintCE]
cns) -> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (r :: * -> *). OOProg r => CodeExpr -> GenState (SValue r)
convExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. (HasUID c, HasSymbol c) => c -> ConstraintCE -> CodeExpr
renderC CodeVarChunk
q) [ConstraintCE]
cns) [(CodeVarChunk, [ConstraintCE])]
cs
  [[MS (r (Body r))]]
bods <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall {r :: * -> *}.
OOProg r =>
ConstraintBehaviour
-> (CodeVarChunk, [ConstraintCE]) -> GenState [MS (r (Body r))]
chooseCB ConstraintBehaviour
cb) [(CodeVarChunk, [ConstraintCE])]
cs
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\VS (r (Value r))
cond MS (r (Body r))
bod -> forall (r :: * -> *).
ControlStatement r =>
[(SValue r, MSBody r)] -> MSStatement r
ifNoElse [(forall (r :: * -> *). BooleanExpression r => SValue r -> SValue r
(?!) VS (r (Value r))
cond, MS (r (Body r))
bod)]))
    [[VS (r (Value r))]]
conds [[MS (r (Body r))]]
bods
  where chooseCB :: ConstraintBehaviour
-> (CodeVarChunk, [ConstraintCE]) -> GenState [MS (r (Body r))]
chooseCB ConstraintBehaviour
Warning = forall (r :: * -> *).
OOProg r =>
(CodeVarChunk, [ConstraintCE]) -> GenState [MSBody r]
constrWarn
        chooseCB ConstraintBehaviour
Exception = forall (r :: * -> *).
OOProg r =>
(CodeVarChunk, [ConstraintCE]) -> GenState [MSBody r]
constrExc

-- | Generates body defining constraint violation behaviour if Warning chosen from 'chooseConstr'.
-- Prints a \"Warning\" message followed by a message that says
-- what value was \"suggested\".
constrWarn :: (OOProg r) => (CodeVarChunk, [ConstraintCE]) ->
  GenState [MSBody r]
constrWarn :: forall (r :: * -> *).
OOProg r =>
(CodeVarChunk, [ConstraintCE]) -> GenState [MSBody r]
constrWarn (CodeVarChunk, [ConstraintCE])
c = do
  let q :: CodeVarChunk
q = forall a b. (a, b) -> a
fst (CodeVarChunk, [ConstraintCE])
c
      cs :: [ConstraintCE]
cs = forall a b. (a, b) -> b
snd (CodeVarChunk, [ConstraintCE])
c
  [[MS (r (Statement r))]]
msgs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> Name -> ConstraintCE -> GenState [MSStatement r]
constraintViolatedMsg CodeVarChunk
q Name
"suggested") [ConstraintCE]
cs
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (r :: * -> *). BodySym r => [MSStatement r] -> MSBody r
bodyStatements forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (r :: * -> *). IOStatement r => Name -> MSStatement r
printStr Name
"Warning: " forall a. a -> [a] -> [a]
:)) [[MS (r (Statement r))]]
msgs

-- | Generates body defining constraint violation behaviour if Exception chosen from 'chooseConstr'.
-- Prints a message that says what value was \"expected\",
-- followed by throwing an exception.
constrExc :: (OOProg r) => (CodeVarChunk, [ConstraintCE]) ->
  GenState [MSBody r]
constrExc :: forall (r :: * -> *).
OOProg r =>
(CodeVarChunk, [ConstraintCE]) -> GenState [MSBody r]
constrExc (CodeVarChunk, [ConstraintCE])
c = do
  let q :: CodeVarChunk
q = forall a b. (a, b) -> a
fst (CodeVarChunk, [ConstraintCE])
c
      cs :: [ConstraintCE]
cs = forall a b. (a, b) -> b
snd (CodeVarChunk, [ConstraintCE])
c
  [[MS (r (Statement r))]]
msgs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> Name -> ConstraintCE -> GenState [MSStatement r]
constraintViolatedMsg CodeVarChunk
q Name
"expected") [ConstraintCE]
cs
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (r :: * -> *). BodySym r => [MSStatement r] -> MSBody r
bodyStatements forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++ [forall (r :: * -> *). ControlStatement r => Name -> MSStatement r
throw Name
"InputError"])) [[MS (r (Statement r))]]
msgs

-- | Generates statements that print a message for when a constraint is violated.
-- Message includes the name of the cosntraint quantity, its value, and a
-- description of the constraint that is violated.
constraintViolatedMsg :: (OOProg r) => CodeVarChunk -> String ->
  ConstraintCE -> GenState [MSStatement r]
constraintViolatedMsg :: forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> Name -> ConstraintCE -> GenState [MSStatement r]
constraintViolatedMsg CodeVarChunk
q Name
s ConstraintCE
c = do
  [MSStatement r]
pc <- forall (r :: * -> *).
OOProg r =>
ConstraintCE -> GenState [MSStatement r]
printConstraint ConstraintCE
c
  VS (r (Value r))
v <- forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SValue r)
mkVal (forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar CodeVarChunk
q)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [forall (r :: * -> *). IOStatement r => Name -> MSStatement r
printStr forall a b. (a -> b) -> a -> b
$ forall c. CodeIdea c => c -> Name
codeName CodeVarChunk
q forall a. [a] -> [a] -> [a]
++ Name
" has value ",
    forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
print VS (r (Value r))
v,
    forall (r :: * -> *). IOStatement r => Name -> MSStatement r
printStr forall a b. (a -> b) -> a -> b
$ Name
", but is " forall a. [a] -> [a] -> [a]
++ Name
s forall a. [a] -> [a] -> [a]
++ Name
" to be "] forall a. [a] -> [a] -> [a]
++ [MSStatement r]
pc

-- | Generates statements to print descriptions of constraints, using words and
-- the constrained values. Constrained values are followed by printing the
-- expression they originated from, using printExpr.
printConstraint :: (OOProg r) => ConstraintCE ->
  GenState [MSStatement r]
printConstraint :: forall (r :: * -> *).
OOProg r =>
ConstraintCE -> GenState [MSStatement r]
printConstraint ConstraintCE
c = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  let db :: ChunkDB
db = CodeSpec -> ChunkDB
sysinfodb forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g
      printConstraint' :: (OOProg r) => ConstraintCE -> GenState
        [MSStatement r]
      printConstraint' :: forall (r :: * -> *).
OOProg r =>
ConstraintCE -> GenState [MSStatement r]
printConstraint' (Range ConstraintReason
_ (Bounded (Inclusive
_, CodeExpr
e1) (Inclusive
_, CodeExpr
e2))) = do
        VS (r (Value r))
lb <- forall (r :: * -> *). OOProg r => CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e1
        VS (r (Value r))
ub <- forall (r :: * -> *). OOProg r => CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e2
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [forall (r :: * -> *). IOStatement r => Name -> MSStatement r
printStr Name
"between ", forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
print VS (r (Value r))
lb] forall a. [a] -> [a] -> [a]
++ forall (r :: * -> *).
OOProg r =>
CodeExpr -> ChunkDB -> [MSStatement r]
printExpr CodeExpr
e1 ChunkDB
db forall a. [a] -> [a] -> [a]
++
          [forall (r :: * -> *). IOStatement r => Name -> MSStatement r
printStr Name
" and ", forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
print VS (r (Value r))
ub] forall a. [a] -> [a] -> [a]
++ forall (r :: * -> *).
OOProg r =>
CodeExpr -> ChunkDB -> [MSStatement r]
printExpr CodeExpr
e2 ChunkDB
db forall a. [a] -> [a] -> [a]
++ [forall (r :: * -> *). IOStatement r => Name -> MSStatement r
printStrLn Name
"."]
      printConstraint' (Range ConstraintReason
_ (UpTo (Inclusive
_, CodeExpr
e))) = do
        VS (r (Value r))
ub <- forall (r :: * -> *). OOProg r => CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [forall (r :: * -> *). IOStatement r => Name -> MSStatement r
printStr Name
"below ", forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
print VS (r (Value r))
ub] forall a. [a] -> [a] -> [a]
++ forall (r :: * -> *).
OOProg r =>
CodeExpr -> ChunkDB -> [MSStatement r]
printExpr CodeExpr
e ChunkDB
db forall a. [a] -> [a] -> [a]
++
          [forall (r :: * -> *). IOStatement r => Name -> MSStatement r
printStrLn Name
"."]
      printConstraint' (Range ConstraintReason
_ (UpFrom (Inclusive
_, CodeExpr
e))) = do
        VS (r (Value r))
lb <- forall (r :: * -> *). OOProg r => CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [forall (r :: * -> *). IOStatement r => Name -> MSStatement r
printStr Name
"above ", forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
print VS (r (Value r))
lb] forall a. [a] -> [a] -> [a]
++ forall (r :: * -> *).
OOProg r =>
CodeExpr -> ChunkDB -> [MSStatement r]
printExpr CodeExpr
e ChunkDB
db forall a. [a] -> [a] -> [a]
++ [forall (r :: * -> *). IOStatement r => Name -> MSStatement r
printStrLn Name
"."]
  forall (r :: * -> *).
OOProg r =>
ConstraintCE -> GenState [MSStatement r]
printConstraint' ConstraintCE
c

-- | Don't print expressions that are just literals, because that would be
-- redundant (the values are already printed by printConstraint).
-- If expression is more than just a literal, print it in parentheses.
printExpr :: (OOProg r) => CodeExpr -> ChunkDB -> [MSStatement r]
printExpr :: forall (r :: * -> *).
OOProg r =>
CodeExpr -> ChunkDB -> [MSStatement r]
printExpr Lit{} ChunkDB
_  = []
printExpr CodeExpr
e     ChunkDB
db = [forall (r :: * -> *). IOStatement r => Name -> MSStatement r
printStr forall a b. (a -> b) -> a -> b
$ Name
" (" forall a. [a] -> [a] -> [a]
++ Doc -> Name
render (ChunkDB -> Stage -> SingleLine -> CodeExpr -> Doc
codeExprDoc ChunkDB
db Stage
Implementation SingleLine
OneLine CodeExpr
e) forall a. [a] -> [a] -> [a]
++ Name
")"]

-- | | Generates a function for reading inputs from a file.
genInputFormat :: (OOProg r) => ScopeTag ->
  GenState (Maybe (SMethod r))
genInputFormat :: forall (r :: * -> *).
OOProg r =>
ScopeTag -> GenState (Maybe (SMethod r))
genInputFormat ScopeTag
s = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  DataDesc
dd <- GenState DataDesc
genDataDesc
  let getFunc :: ScopeTag
-> Name
-> Name
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MSBlock r]
-> GenState (SMethod r)
getFunc ScopeTag
Pub = forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MSBlock r]
-> GenState (SMethod r)
publicInOutFunc
      getFunc ScopeTag
Priv = forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MSBlock r]
-> GenState (SMethod r)
privateInOutMethod
      genInFormat :: (OOProg r) => Bool -> GenState
        (Maybe (SMethod r))
      genInFormat :: forall {r :: * -> *}.
OOProg r =>
Bool -> StateT DrasilState Identity (Maybe (MS (r (Method r))))
genInFormat Bool
False = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      genInFormat Bool
_ = do
        [CodeVarChunk]
ins <- GenState [CodeVarChunk]
getInputFormatIns
        [CodeVarChunk]
outs <- GenState [CodeVarChunk]
getInputFormatOuts
        [MS (r (Block r))]
bod <- forall (r :: * -> *). OOProg r => DataDesc -> GenState [MSBlock r]
readData DataDesc
dd
        Name
desc <- GenState Name
inFmtFuncDesc
        SMethod r
mthd <- forall {r :: * -> *}.
OOProg r =>
ScopeTag
-> Name
-> Name
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [MSBlock r]
-> GenState (SMethod r)
getFunc ScopeTag
s Name
"get_input" Name
desc [CodeVarChunk]
ins [CodeVarChunk]
outs [MS (r (Block r))]
bod
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just SMethod r
mthd
  forall {r :: * -> *}.
OOProg r =>
Bool -> StateT DrasilState Identity (Maybe (MS (r (Method r))))
genInFormat forall a b. (a -> b) -> a -> b
$ Name
"get_input" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState -> [Name]
defList DrasilState
g

-- | Defines the 'DataDesc' for the format we require for input files. When we make
-- input format a design variability, this will read the user's design choices
-- instead of returning a fixed 'DataDesc'.
genDataDesc :: GenState DataDesc
genDataDesc :: GenState DataDesc
genDataDesc = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Data
junkLine forall a. a -> [a] -> [a]
:
    forall a. a -> [a] -> [a]
intersperse Data
junkLine (forall a b. (a -> b) -> [a] -> [b]
map CodeVarChunk -> Data
singleton (CodeSpec -> [CodeVarChunk]
extInputs forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g))

-- | Generates a sample input file compatible with the generated program,
-- if the user chose to.
genSampleInput :: (AuxiliarySym r) => GenState (Maybe (r (Auxiliary r)))
genSampleInput :: forall (r :: * -> *).
AuxiliarySym r =>
GenState (Maybe (r (Auxiliary r)))
genSampleInput = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  DataDesc
dd <- GenState DataDesc
genDataDesc
  if [AuxFile] -> Bool
hasSampleInput (DrasilState -> [AuxFile]
auxiliaries DrasilState
g) then (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just) forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *).
AuxiliarySym r =>
ChunkDB -> DataDesc -> [Expr] -> r (Auxiliary r)
sampleInput
    (CodeSpec -> ChunkDB
sysinfodb forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g) DataDesc
dd (DrasilState -> [Expr]
sampleData DrasilState
g) else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

----- CONSTANTS -----

-- | Generates a module containing the class where constants are stored.
genConstMod :: (OOProg r) => GenState [SFile r]
genConstMod :: forall (r :: * -> *). OOProg r => GenState [SFile r]
genConstMod = do
  Name
cDesc <- GenState [Name] -> GenState Name
modDesc forall a b. (a -> b) -> a -> b
$ forall a b. State a b -> State a [b]
liftS GenState Name
constModDesc
  forall a b. State a b -> State a [b]
liftS forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
genModule Name
"Constants" Name
cDesc [] [forall (r :: * -> *).
OOProg r =>
ClassType -> GenState (Maybe (SClass r))
genConstClass ClassType
Primary]

-- | Generates a class to store constants, if constants are mapped to the
-- Constants class in the class definition map, otherwise returns Nothing.
genConstClass :: (OOProg r) => ClassType ->
  GenState (Maybe (SClass r))
genConstClass :: forall (r :: * -> *).
OOProg r =>
ClassType -> GenState (Maybe (SClass r))
genConstClass ClassType
scp = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  let cs :: [CodeDefinition]
cs = CodeSpec -> [CodeDefinition]
constants forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g
      genClass :: (OOProg r) => [CodeDefinition] -> GenState
        (Maybe (SClass r))
      genClass :: forall (r :: * -> *).
OOProg r =>
[CodeDefinition] -> GenState (Maybe (SClass r))
genClass [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      genClass [CodeDefinition]
vs = do
        [VS (r (Value r))]
vals <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (r :: * -> *). OOProg r => CodeExpr -> GenState (SValue r)
convExpr 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)) [CodeDefinition]
vs
        [VS (r (Variable r))]
vars <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\CodeDefinition
x -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (r :: * -> *).
VariableSym r =>
Name -> VSType r -> SVariable r
var (forall c. CodeIdea c => c -> Name
codeName CodeDefinition
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *). TypeSym r => CodeType -> VSType r
convType) (forall c. HasSpace c => c -> GenState CodeType
codeType CodeDefinition
x)) [CodeDefinition]
vs
        let constVars :: [CS (r (StateVar r))]
constVars = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall (r :: * -> *).
OOProg r =>
ConstantRepr -> SVariable r -> SValue r -> CSStateVar r
constVarFunc (DrasilState -> ConstantRepr
conRepr DrasilState
g)) [VS (r (Variable r))]
vars [VS (r (Value r))]
vals
            getFunc :: ClassType
-> Name
-> Maybe Name
-> Name
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState (SClass r)
getFunc ClassType
Primary = forall (r :: * -> *).
OOProg r =>
Name
-> Maybe Name
-> Name
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState (SClass r)
primaryClass
            getFunc ClassType
Auxiliary = forall (r :: * -> *).
OOProg r =>
Name
-> Maybe Name
-> Name
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState (SClass r)
auxClass
            f :: Name
-> Maybe Name
-> Name
-> [CS (r (StateVar r))]
-> GenState [MS (r (Method r))]
-> GenState (SClass r)
f = forall {r :: * -> *}.
OOProg r =>
ClassType
-> Name
-> Maybe Name
-> Name
-> [CSStateVar r]
-> GenState [SMethod r]
-> GenState (SClass r)
getFunc ClassType
scp
        Name
cDesc <- GenState Name
constClassDesc
        SClass r
cls <- Name
-> Maybe Name
-> Name
-> [CS (r (StateVar r))]
-> GenState [MS (r (Method r))]
-> GenState (SClass r)
f Name
cname forall a. Maybe a
Nothing Name
cDesc [CS (r (StateVar r))]
constVars (forall (m :: * -> *) a. Monad m => a -> m a
return [])
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just SClass r
cls
  forall (r :: * -> *).
OOProg r =>
[CodeDefinition] -> GenState (Maybe (SClass r))
genClass forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. Ord k => k -> Map k a -> Bool
member (forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Name
cname forall a. Eq a => a -> a -> Bool
==) (DrasilState -> ModExportMap
clsMap DrasilState
g))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. CodeIdea c => c -> Name
codeName) [CodeDefinition]
cs
  where cname :: Name
cname = Name
"Constants"

------- CALC ----------

-- | Generates a module containing calculation functions.
genCalcMod :: (OOProg r) => GenState (SFile r)
genCalcMod :: forall (r :: * -> *). OOProg r => GenState (SFile r)
genCalcMod = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  let elmap :: ExtLibMap
elmap = DrasilState -> ExtLibMap
extLibMap DrasilState
g
  forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [Name]
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
genModuleWithImports Name
"Calculations" Name
calcModDesc (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall s a. s -> Getting a s a -> a
^. Lens' ExtLibState [Name]
imports) forall a b. (a -> b) -> a -> b
$
    forall k a. Map k a -> [a]
elems ExtLibMap
elmap) (forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *).
OOProg r =>
CodeDefinition -> GenState (SMethod r)
genCalcFunc) (CodeSpec -> [CodeDefinition]
execOrder forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g)) []

-- | Generates a calculation function corresponding to the 'CodeDefinition'.
-- For solving ODEs, the 'ExtLibState' containing the information needed to
-- generate code is found by looking it up in the external library map.
genCalcFunc :: (OOProg r) => CodeDefinition ->
  GenState (SMethod r)
genCalcFunc :: forall (r :: * -> *).
OOProg r =>
CodeDefinition -> GenState (SMethod r)
genCalcFunc CodeDefinition
cdef = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  [CodeVarChunk]
parms <- CodeDefinition -> GenState [CodeVarChunk]
getCalcParams CodeDefinition
cdef
  let nm :: Name
nm = forall c. CodeIdea c => c -> Name
codeName CodeDefinition
cdef
  CodeType
tp <- forall c. HasSpace c => c -> GenState CodeType
codeType CodeDefinition
cdef
  VS (r (Variable r))
v <- forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SVariable r)
mkVar (forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar CodeDefinition
cdef)
  [MS (r (Block r))]
blcks <- case CodeDefinition
cdef forall s a. s -> Getting a s a -> a
^. Lens' CodeDefinition DefinitionType
defType
            of DefinitionType
Definition -> forall a b. State a b -> State a [b]
liftS forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *).
OOProg r =>
CalcType -> CodeDefinition -> CodeExpr -> GenState (MSBlock r)
genCalcBlock CalcType
CalcReturn CodeDefinition
cdef
                 (CodeDefinition
cdef forall s a. s -> Getting a s a -> a
^. forall c. DefiningCodeExpr c => Lens' c CodeExpr
codeExpr)
               DefinitionType
ODE -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => Name -> a
error forall a b. (a -> b) -> a -> b
$ Name
nm forall a. [a] -> [a] -> [a]
++ Name
" missing from ExtLibMap")
                 (\ExtLibState
el -> do
                   [MS (r (Statement r))]
defStmts <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (r :: * -> *).
OOProg r =>
FuncStmt -> GenState (MSStatement r)
convStmt (ExtLibState
el forall s a. s -> Getting a s a -> a
^. Lens' ExtLibState [FuncStmt]
defs)
                   [MS (r (Statement r))]
stepStmts <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (r :: * -> *).
OOProg r =>
FuncStmt -> GenState (MSStatement r)
convStmt (ExtLibState
el forall s a. s -> Getting a s a -> a
^. Lens' ExtLibState [FuncStmt]
steps)
                   forall (m :: * -> *) a. Monad m => a -> m a
return [forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block (forall (r :: * -> *).
DeclStatement r =>
SVariable r -> MSStatement r
varDec VS (r (Variable r))
v forall a. a -> [a] -> [a]
: [MS (r (Statement r))]
defStmts),
                     forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block [MS (r (Statement r))]
stepStmts,
                     forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block [forall (r :: * -> *).
ControlStatement r =>
SValue r -> MSStatement r
returnStmt forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf VS (r (Variable r))
v]])
                 (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
nm (DrasilState -> ExtLibMap
extLibMap DrasilState
g))
  Name
desc <- forall c. CodeIdea c => c -> GenState Name
getComment CodeDefinition
cdef
  forall (r :: * -> *).
OOProg r =>
Name
-> VSType r
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MSBlock r]
-> GenState (SMethod r)
publicFunc
    Name
nm
    (forall (r :: * -> *). TypeSym r => CodeType -> VSType r
convType CodeType
tp)
    (Name
"Calculates " forall a. [a] -> [a] -> [a]
++ Name
desc)
    (forall a b. (a -> b) -> [a] -> [b]
map forall c. CodeIdea c => c -> ParameterChunk
pcAuto [CodeVarChunk]
parms)
    (forall a. a -> Maybe a
Just Name
desc)
    [MS (r (Block r))]
blcks

-- | Calculations may be assigned to a variable or asked for a result.
data CalcType = CalcAssign | CalcReturn deriving CalcType -> CalcType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CalcType -> CalcType -> Bool
$c/= :: CalcType -> CalcType -> Bool
== :: CalcType -> CalcType -> Bool
$c== :: CalcType -> CalcType -> Bool
Eq

-- | Generates a calculation block for the given 'CodeDefinition', and assigns the
-- result to a variable (if 'CalcAssign') or returns the result (if 'CalcReturn').
genCalcBlock :: (OOProg r) => CalcType -> CodeDefinition -> CodeExpr ->
  GenState (MSBlock r)
genCalcBlock :: forall (r :: * -> *).
OOProg r =>
CalcType -> CodeDefinition -> CodeExpr -> GenState (MSBlock r)
genCalcBlock CalcType
t CodeDefinition
v (Case Completeness
c [(CodeExpr, CodeExpr)]
e) = forall (r :: * -> *).
OOProg r =>
CalcType
-> CodeDefinition
-> Completeness
-> [(CodeExpr, CodeExpr)]
-> GenState (MSBlock r)
genCaseBlock CalcType
t CodeDefinition
v Completeness
c [(CodeExpr, CodeExpr)]
e
genCalcBlock CalcType
CalcAssign CodeDefinition
v CodeExpr
e = do
  VS (r (Variable r))
vv <- forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SVariable r)
mkVar (forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar CodeDefinition
v)
  VS (r (Value r))
ee <- forall (r :: * -> *). OOProg r => CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e
  [MS (r (Statement r))]
l <- forall (r :: * -> *).
OOProg r =>
SVariable r -> GenState [MSStatement r]
maybeLog VS (r (Variable r))
vv
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
assign VS (r (Variable r))
vv VS (r (Value r))
ee forall a. a -> [a] -> [a]
: [MS (r (Statement r))]
l
genCalcBlock CalcType
CalcReturn CodeDefinition
_ CodeExpr
e = forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. State a b -> State a [b]
liftS (forall (r :: * -> *).
ControlStatement r =>
SValue r -> MSStatement r
returnStmt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (r :: * -> *). OOProg r => CodeExpr -> GenState (SValue r)
convExpr CodeExpr
e)

-- | Generates a calculation block for a value defined by cases.
-- If the function is defined for every case, the final case is captured by an
-- else clause, otherwise an error-throwing else-clause is generated.
genCaseBlock :: (OOProg r) => CalcType -> CodeDefinition -> Completeness
  -> [(CodeExpr, CodeExpr)] -> GenState (MSBlock r)
genCaseBlock :: forall (r :: * -> *).
OOProg r =>
CalcType
-> CodeDefinition
-> Completeness
-> [(CodeExpr, CodeExpr)]
-> GenState (MSBlock r)
genCaseBlock CalcType
_ CodeDefinition
_ Completeness
_ [] = forall a. HasCallStack => Name -> a
error forall a b. (a -> b) -> a -> b
$ Name
"Case expression with no cases encountered" forall a. [a] -> [a] -> [a]
++
  Name
" in code generator"
genCaseBlock CalcType
t CodeDefinition
v Completeness
c [(CodeExpr, CodeExpr)]
cs = do
  [(VS (r (Value r)), MS (r (Body r)))]
ifs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(CodeExpr
e,CodeExpr
r) -> forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (forall (r :: * -> *). OOProg r => CodeExpr -> GenState (SValue r)
convExpr CodeExpr
r) (forall {r :: * -> *}.
OOProg r =>
CodeExpr -> StateT DrasilState Identity (MS (r (Body r)))
calcBody CodeExpr
e)) (Completeness -> [(CodeExpr, CodeExpr)]
ifEs Completeness
c)
  MS (r (Body r))
els <- forall {r :: * -> *}.
OOProg r =>
Completeness -> StateT DrasilState Identity (MS (r (Body r)))
elseE Completeness
c
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block [forall (r :: * -> *).
ControlStatement r =>
[(SValue r, MSBody r)] -> MSBody r -> MSStatement r
ifCond [(VS (r (Value r)), MS (r (Body r)))]
ifs MS (r (Body r))
els]
  where calcBody :: CodeExpr -> StateT DrasilState Identity (MS (r (Body r)))
calcBody CodeExpr
e = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (r :: * -> *). BodySym r => [MSBlock r] -> MSBody r
body forall a b. (a -> b) -> a -> b
$ forall a b. State a b -> State a [b]
liftS forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *).
OOProg r =>
CalcType -> CodeDefinition -> CodeExpr -> GenState (MSBlock r)
genCalcBlock CalcType
t CodeDefinition
v CodeExpr
e
        ifEs :: Completeness -> [(CodeExpr, CodeExpr)]
ifEs Completeness
Complete = forall a. [a] -> [a]
init [(CodeExpr, CodeExpr)]
cs
        ifEs Completeness
Incomplete = [(CodeExpr, CodeExpr)]
cs
        elseE :: Completeness -> StateT DrasilState Identity (MS (r (Body r)))
elseE Completeness
Complete = forall {r :: * -> *}.
OOProg r =>
CodeExpr -> StateT DrasilState Identity (MS (r (Body r)))
calcBody forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last [(CodeExpr, CodeExpr)]
cs
        elseE Completeness
Incomplete = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *). BodySym r => MSStatement r -> MSBody r
oneLiner forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *). ControlStatement r => Name -> MSStatement r
throw forall a b. (a -> b) -> a -> b
$
          Name
"Undefined case encountered in function " forall a. [a] -> [a] -> [a]
++ forall c. CodeIdea c => c -> Name
codeName CodeDefinition
v

----- OUTPUT -------

-- | Generates a module containing the function for printing outputs.
genOutputMod :: (OOProg r) => GenState [SFile r]
genOutputMod :: forall (r :: * -> *). OOProg r => GenState [SFile r]
genOutputMod = do
  Name
ofDesc <- GenState [Name] -> GenState Name
modDesc forall a b. (a -> b) -> a -> b
$ forall a b. State a b -> State a [b]
liftS GenState Name
outputFormatDesc
  forall a b. State a b -> State a [b]
liftS forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *).
OOProg r =>
Name
-> Name
-> [GenState (Maybe (SMethod r))]
-> [GenState (Maybe (SClass r))]
-> GenState (SFile r)
genModule Name
"OutputFormat" Name
ofDesc [forall (r :: * -> *). OOProg r => GenState (Maybe (SMethod r))
genOutputFormat] []

-- | Generates a function for printing output values.
genOutputFormat :: (OOProg r) => GenState (Maybe (SMethod r))
genOutputFormat :: forall (r :: * -> *). OOProg r => GenState (Maybe (SMethod r))
genOutputFormat = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  let genOutput :: (OOProg r) => Maybe String -> GenState
        (Maybe (SMethod r))
      genOutput :: forall (r :: * -> *).
OOProg r =>
Maybe Name -> GenState (Maybe (SMethod r))
genOutput Maybe Name
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      genOutput (Just Name
_) = do
        let l_outfile :: Name
l_outfile = Name
"outputfile"
            var_outfile :: SVariable r
var_outfile = forall (r :: * -> *).
VariableSym r =>
Name -> VSType r -> SVariable r
var Name
l_outfile forall (r :: * -> *). TypeSym r => VSType r
outfile
            v_outfile :: SValue r
v_outfile = forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable r
var_outfile
        [CodeVarChunk]
parms <- GenState [CodeVarChunk]
getOutputParams
        [[MS (r (Statement r))]]
outp <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\CodeVarChunk
x -> do
          SValue r
v <- forall (r :: * -> *).
OOProg r =>
CodeVarChunk -> GenState (SValue r)
mkVal CodeVarChunk
x
          forall (m :: * -> *) a. Monad m => a -> m a
return [ forall (r :: * -> *).
IOStatement r =>
SValue r -> Name -> MSStatement r
printFileStr SValue r
v_outfile (forall c. CodeIdea c => c -> Name
codeName CodeVarChunk
x forall a. [a] -> [a] -> [a]
++ Name
" = "),
                   forall (r :: * -> *).
IOStatement r =>
SValue r -> SValue r -> MSStatement r
printFileLn SValue r
v_outfile SValue r
v
                 ] ) (CodeSpec -> [CodeVarChunk]
outputs forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g)
        Name
desc <- GenState Name
woFuncDesc
        SMethod r
mthd <- forall (r :: * -> *).
OOProg r =>
Name
-> VSType r
-> Name
-> [ParameterChunk]
-> Maybe Name
-> [MSBlock r]
-> GenState (SMethod r)
publicFunc Name
"write_output" forall (r :: * -> *). TypeSym r => VSType r
void Name
desc (forall a b. (a -> b) -> [a] -> [b]
map forall c. CodeIdea c => c -> ParameterChunk
pcAuto [CodeVarChunk]
parms) forall a. Maybe a
Nothing
          [forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block forall a b. (a -> b) -> a -> b
$ [
          forall (r :: * -> *).
DeclStatement r =>
SVariable r -> MSStatement r
varDec SVariable r
var_outfile,
          forall (r :: * -> *).
IOStatement r =>
SVariable r -> SValue r -> MSStatement r
openFileW SVariable r
var_outfile (forall (r :: * -> *). Literal r => Name -> SValue r
litString Name
"output.txt") ] forall a. [a] -> [a] -> [a]
++
          forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[MS (r (Statement r))]]
outp forall a. [a] -> [a] -> [a]
++ [ forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
closeFile SValue r
v_outfile ]]
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just SMethod r
mthd
  forall (r :: * -> *).
OOProg r =>
Maybe Name -> GenState (Maybe (SMethod r))
genOutput forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
"write_output" (DrasilState -> ModExportMap
eMap DrasilState
g)