{-# LANGUAGE TemplateHaskell #-}
module Language.Drasil.Code.Imperative.DrasilState (
  GenState, DrasilState(..), designLog, inMod, MatchedSpaces, ModExportMap, 
  ClassDefinitionMap, modExportMap, clsDefMap, addToDesignLog, addLoggedSpace
) where

import Language.Drasil
import GOOL.Drasil (ScopeTag(..), CodeType)

import Language.Drasil.Chunk.Code (codeName)
import Language.Drasil.Chunk.ConstraintMap (ConstraintCE)
import Language.Drasil.Code.ExtLibImport (ExtLibState)
import Language.Drasil.Choices (Choices(..), Architecture (..), DataInfo(..),
  AuxFile, Modularity(..), 
  ImplementationType(..), Comments, Verbosity, MatchedConceptMap, 
  ConstantRepr, ConstantStructure(..), ConstraintBehaviour, 
  InputModule(..), Logging, Structure(..), inputModule)
import Language.Drasil.CodeSpec (Input, Const, Derived, Output, Def, 
  CodeSpec(..),  getConstraints)
import Language.Drasil.Mod (Mod(..), Name, Version, Class(..), 
  StateVariable(..), fname)

import Control.Lens ((^.), makeLenses, over)
import Control.Monad.State (State)
import Data.List (nub)
import Data.Map (Map, fromList)
import Text.PrettyPrint.HughesPJ (Doc, ($$))

-- | Type for the mapping between 'Space's and 'CodeType's.
type MatchedSpaces = Space -> GenState CodeType

-- | Map from calculation function name to the 'ExtLibState' containing the contents of the function.
type ExtLibMap = Map String ExtLibState

-- | Variable/function name maps to module name.
type ModExportMap = Map String String

-- | Variable/function name maps to class name.
type ClassDefinitionMap = Map String String

-- | Abbreviation used throughout generator.
type GenState = State DrasilState

-- | Private State, used to push these options around the generator.
data DrasilState = DrasilState {
  DrasilState -> CodeSpec
codeSpec :: CodeSpec,
  -- Choices
  DrasilState -> Modularity
modular :: Modularity,
  DrasilState -> ImplementationType
implType :: ImplementationType,
  DrasilState -> Structure
inStruct :: Structure,
  DrasilState -> ConstantStructure
conStruct :: ConstantStructure,
  DrasilState -> ConstantRepr
conRepr :: ConstantRepr,
  DrasilState -> MatchedConceptMap
concMatches :: MatchedConceptMap,
  DrasilState -> MatchedSpaces
spaceMatches :: MatchedSpaces,
  DrasilState -> ConstraintBehaviour
onSfwrC :: ConstraintBehaviour,
  DrasilState -> ConstraintBehaviour
onPhysC :: ConstraintBehaviour,
  DrasilState -> [Comments]
commented :: [Comments],
  DrasilState -> Verbosity
doxOutput :: Verbosity,
  DrasilState -> String
date :: String,
  DrasilState -> String
logName :: String,
  DrasilState -> [Logging]
logKind :: [Logging],
  DrasilState -> [AuxFile]
auxiliaries :: [AuxFile],
  DrasilState -> [Expr]
sampleData :: [Expr],
  -- Reference materials
  DrasilState -> [Mod]
modules :: [Mod],
  DrasilState -> [(String, String)]
extLibNames :: [(Name,Version)],
  DrasilState -> ExtLibMap
extLibMap :: ExtLibMap,
  DrasilState -> [String]
libPaths :: [FilePath],
  DrasilState -> ModExportMap
eMap :: ModExportMap,
  DrasilState -> ModExportMap
libEMap :: ModExportMap, 
  DrasilState -> ModExportMap
clsMap :: ClassDefinitionMap,
  DrasilState -> [String]
defList :: [Name],
  -- Stateful
  DrasilState -> String
currentModule :: String,
  DrasilState -> String
currentClass :: String,
  DrasilState -> Doc
_designLog :: Doc,
  DrasilState -> [(Space, CodeType)]
_loggedSpaces :: [(Space, CodeType)]
}
makeLenses ''DrasilState

-- | Determines whether input modules are 'Combined' or 'Separated' based on the
-- 'Modularity' stored in 'DrasilState'.
inMod :: DrasilState -> InputModule
inMod :: DrasilState -> InputModule
inMod ds :: DrasilState
ds = Modularity -> InputModule
inMod' (Modularity -> InputModule) -> Modularity -> InputModule
forall a b. (a -> b) -> a -> b
$ DrasilState -> Modularity
modular DrasilState
ds
  where inMod' :: Modularity -> InputModule
inMod' Unmodular = InputModule
Combined
        inMod' (Modular im :: InputModule
im) = InputModule
im

-- | Adds a message to the design log if the given 'Space'-'CodeType' match has not
-- already been logged.
addToDesignLog :: Space -> CodeType -> Doc -> DrasilState -> DrasilState
addToDesignLog :: Space -> CodeType -> Doc -> DrasilState -> DrasilState
addToDesignLog s :: Space
s t :: CodeType
t l :: Doc
l ds :: DrasilState
ds = if (Space
s,CodeType
t) (Space, CodeType) -> [(Space, CodeType)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (DrasilState
ds DrasilState
-> Getting [(Space, CodeType)] DrasilState [(Space, CodeType)]
-> [(Space, CodeType)]
forall s a. s -> Getting a s a -> a
^. Getting [(Space, CodeType)] DrasilState [(Space, CodeType)]
Lens' DrasilState [(Space, CodeType)]
loggedSpaces) then DrasilState
ds 
  else ASetter DrasilState DrasilState Doc Doc
-> (Doc -> Doc) -> DrasilState -> DrasilState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter DrasilState DrasilState Doc Doc
Lens' DrasilState Doc
designLog (Doc -> Doc -> Doc
$$ Doc
l) DrasilState
ds

-- | Adds a 'Space'-'CodeType' pair to the loggedSpaces list in 'DrasilState' to prevent a duplicate 
-- log from being generated for that 'Space'-'CodeType' pair.
addLoggedSpace :: Space -> CodeType -> DrasilState -> DrasilState
addLoggedSpace :: Space -> CodeType -> DrasilState -> DrasilState
addLoggedSpace s :: Space
s t :: CodeType
t = ASetter
  DrasilState DrasilState [(Space, CodeType)] [(Space, CodeType)]
-> ([(Space, CodeType)] -> [(Space, CodeType)])
-> DrasilState
-> DrasilState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  DrasilState DrasilState [(Space, CodeType)] [(Space, CodeType)]
Lens' DrasilState [(Space, CodeType)]
loggedSpaces ((Space
s,CodeType
t)(Space, CodeType) -> [(Space, CodeType)] -> [(Space, CodeType)]
forall a. a -> [a] -> [a]
:) 

-- | Builds the module export map, mapping each function and state variable name 
-- in the generated code to the name of the generated module that exports it.
modExportMap :: CodeSpec -> Choices -> [Mod] -> ModExportMap
modExportMap :: CodeSpec -> Choices -> [Mod] -> ModExportMap
modExportMap cs :: CodeSpec
cs@CodeSpec {
  pName :: CodeSpec -> String
pName = String
prn,
  inputs :: CodeSpec -> [Input]
inputs = [Input]
ins,
  extInputs :: CodeSpec -> [Input]
extInputs = [Input]
extIns,
  derivedInputs :: CodeSpec -> [Derived]
derivedInputs = [Derived]
ds,
  constants :: CodeSpec -> [Derived]
constants = [Derived]
cns
  } chs :: Choices
chs@Choices {
    architecture :: Choices -> Architecture
architecture = Architecture
m
  } ms :: [Mod]
ms = [(String, String)] -> ModExportMap
forall k a. Ord k => [(k, a)] -> Map k a
fromList ([(String, String)] -> ModExportMap)
-> [(String, String)] -> ModExportMap
forall a b. (a -> b) -> a -> b
$ [(String, String)] -> [(String, String)]
forall a. Eq a => [a] -> [a]
nub ([(String, String)] -> [(String, String)])
-> [(String, String)] -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ (Mod -> [(String, String)]) -> [Mod] -> [(String, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Mod -> [(String, String)]
mpair [Mod]
ms
    [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ String -> Choices -> [Input] -> [(String, String)]
getExpInput String
prn Choices
chs [Input]
ins
    [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ String -> Choices -> [Derived] -> [(String, String)]
getExpConstants String
prn Choices
chs [Derived]
cns
    [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ String -> Choices -> [Derived] -> [(String, String)]
getExpDerived String
prn Choices
chs [Derived]
ds
    [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ String -> Choices -> [ConstraintCE] -> [(String, String)]
getExpConstraints String
prn Choices
chs (ConstraintCEMap -> [Input] -> [ConstraintCE]
forall c. HasUID c => ConstraintCEMap -> [c] -> [ConstraintCE]
getConstraints (CodeSpec -> ConstraintCEMap
cMap CodeSpec
cs) [Input]
ins)
    [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ String -> Choices -> [Input] -> [(String, String)]
getExpInputFormat String
prn Choices
chs [Input]
extIns
    [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ String -> Choices -> [Derived] -> [(String, String)]
getExpCalcs String
prn Choices
chs (CodeSpec -> [Derived]
execOrder CodeSpec
cs)
    [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ String -> Choices -> [Input] -> [(String, String)]
getExpOutput String
prn Choices
chs (CodeSpec -> [Input]
outputs CodeSpec
cs)
  where mpair :: Mod -> [(String, String)]
mpair (Mod n :: String
n _ _ cls :: [Class]
cls fs :: [Func]
fs) = ((Class -> String) -> [Class] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Class -> String
className [Class]
cls [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ 
          (Class -> [String]) -> [Class] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((StateVariable -> String) -> [StateVariable] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Input -> String
forall c. CodeIdea c => c -> String
codeName (Input -> String)
-> (StateVariable -> Input) -> StateVariable -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateVariable -> Input
stVar) ([StateVariable] -> [String])
-> (Class -> [StateVariable]) -> Class -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateVariable -> Bool) -> [StateVariable] -> [StateVariable]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ScopeTag -> ScopeTag -> Bool
forall a. Eq a => a -> a -> Bool
== ScopeTag
Pub) (ScopeTag -> Bool)
-> (StateVariable -> ScopeTag) -> StateVariable -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateVariable -> ScopeTag
svScope) ([StateVariable] -> [StateVariable])
-> (Class -> [StateVariable]) -> Class -> [StateVariable]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
          Class -> [StateVariable]
stateVars) [Class]
cls [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (Func -> String) -> [Func] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Func -> String
fname ([Func]
fs [Func] -> [Func] -> [Func]
forall a. [a] -> [a] -> [a]
++ (Class -> [Func]) -> [Class] -> [Func]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Class -> [Func]
methods [Class]
cls)) [String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` 
          String -> [String]
forall a. a -> [a]
repeat (Modularity -> String -> String
defModName (Architecture -> Modularity
modularity Architecture
m) String
n)
        defModName :: Modularity -> String -> String
defModName Unmodular _ = String
prn
        defModName _ nm :: String
nm = String
nm

-- | Builds the class definition map, mapping each generated method and state 
-- variable name to the name of the generated class where it is defined.
clsDefMap :: CodeSpec -> Choices -> [Mod] -> ClassDefinitionMap
clsDefMap :: CodeSpec -> Choices -> [Mod] -> ModExportMap
clsDefMap cs :: CodeSpec
cs@CodeSpec {
  inputs :: CodeSpec -> [Input]
inputs = [Input]
ins,
  extInputs :: CodeSpec -> [Input]
extInputs = [Input]
extIns,
  derivedInputs :: CodeSpec -> [Derived]
derivedInputs = [Derived]
ds,
  constants :: CodeSpec -> [Derived]
constants = [Derived]
cns
  } chs :: Choices
chs ms :: [Mod]
ms = [(String, String)] -> ModExportMap
forall k a. Ord k => [(k, a)] -> Map k a
fromList ([(String, String)] -> ModExportMap)
-> [(String, String)] -> ModExportMap
forall a b. (a -> b) -> a -> b
$ [(String, String)] -> [(String, String)]
forall a. Eq a => [a] -> [a]
nub ([(String, String)] -> [(String, String)])
-> [(String, String)] -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ (Mod -> [(String, String)]) -> [Mod] -> [(String, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Mod -> [(String, String)]
modClasses [Mod]
ms
    [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ Choices -> [Input] -> [(String, String)]
getInputCls Choices
chs [Input]
ins
    [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ Choices -> [Derived] -> [(String, String)]
getConstantsCls Choices
chs [Derived]
cns
    [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ Choices -> [Derived] -> [(String, String)]
getDerivedCls Choices
chs [Derived]
ds
    [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ Choices -> [ConstraintCE] -> [(String, String)]
getConstraintsCls Choices
chs (ConstraintCEMap -> [Input] -> [ConstraintCE]
forall c. HasUID c => ConstraintCEMap -> [c] -> [ConstraintCE]
getConstraints (CodeSpec -> ConstraintCEMap
cMap CodeSpec
cs) [Input]
ins)
    [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ Choices -> [Input] -> [(String, String)]
getInputFormatCls Choices
chs [Input]
extIns
    where modClasses :: Mod -> [(String, String)]
modClasses (Mod _ _ _ cls :: [Class]
cls _) = (Class -> [(String, String)]) -> [Class] -> [(String, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\cl :: Class
cl -> 
            let cln :: String
cln = Class -> String
className Class
cl in
            (String
cln, String
cln) (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: (StateVariable -> (String, String))
-> [StateVariable] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\sv :: StateVariable
sv -> (Input -> String
forall c. CodeIdea c => c -> String
codeName (StateVariable -> Input
stVar StateVariable
sv), String
cln)) (Class -> [StateVariable]
stateVars Class
cl) 
              [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ (Func -> (String, String)) -> [Func] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\m :: Func
m -> (Func -> String
fname Func
m, String
cln)) (Class -> [Func]
methods Class
cl)) [Class]
cls

-- | Module exports.
type ModExp = (String, String)
-- | Class definitions.
type ClassDef = (String, String)

-- | Gets exported inputs for InputParameters module.
-- If there are no inputs, no input variables are exported.
-- If 'Unbundled', no input variables are exported.
-- If 'Unmodular' and 'Bundled', module is named after program.
-- If 'Modular' and 'Bundled', inputs are exported by InputParameters module.
-- In 'Unmodular' 'Bundled' and ('Modular' 'Combined') 'Bundled' cases, an InputParameters
-- constructor is generated, thus "InputParameters" is added to map.
getExpInput :: Name -> Choices -> [Input] -> [ModExp]
getExpInput :: String -> Choices -> [Input] -> [(String, String)]
getExpInput _ _ [] = []
getExpInput prn :: String
prn chs :: Choices
chs ins :: [Input]
ins = Modularity -> Structure -> [(String, String)]
inExp (Architecture -> Modularity
modularity (Architecture -> Modularity) -> Architecture -> Modularity
forall a b. (a -> b) -> a -> b
$ Choices -> Architecture
architecture Choices
chs) (DataInfo -> Structure
inputStructure (DataInfo -> Structure) -> DataInfo -> Structure
forall a b. (a -> b) -> a -> b
$ Choices -> DataInfo
dataInfo Choices
chs) 
  where inExp :: Modularity -> Structure -> [(String, String)]
inExp _ Unbundled = []
        inExp Unmodular Bundled = (String
ipName, String
prn) (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: String -> [(String, String)]
forall b. b -> [(String, b)]
inVarDefs String
prn
        inExp (Modular Separated) Bundled = String -> [(String, String)]
forall b. b -> [(String, b)]
inVarDefs String
ipName
        inExp (Modular Combined) Bundled = (String
ipName , String
ipName) (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: String -> [(String, String)]
forall b. b -> [(String, b)]
inVarDefs String
ipName
        inVarDefs :: b -> [(String, b)]
inVarDefs n :: b
n = (Input -> String) -> [Input] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Input -> String
forall c. CodeIdea c => c -> String
codeName [Input]
ins [String] -> [b] -> [(String, b)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` b -> [b]
forall a. a -> [a]
repeat b
n
        ipName :: String
ipName = "InputParameters"

-- | Gets input variables for classes for InputParameters module. 
-- If no inputs, input variables will not be defined in any class.
-- If 'Unbundled', input variables will not be defined in any class.
-- If 'Bundled' and input modules are 'Combined', input variables and input constructor are defined in InputParameters.
-- If 'Bundled' and input modules are 'Separated', input variables are defined in InputParameters but no constructor is generated.
getInputCls :: Choices -> [Input] -> [ClassDef]
getInputCls :: Choices -> [Input] -> [(String, String)]
getInputCls _ [] = []
getInputCls chs :: Choices
chs ins :: [Input]
ins = InputModule -> Structure -> [(String, String)]
inCls (Choices -> InputModule
inputModule Choices
chs) (DataInfo -> Structure
inputStructure (DataInfo -> Structure) -> DataInfo -> Structure
forall a b. (a -> b) -> a -> b
$ Choices -> DataInfo
dataInfo Choices
chs) 
  where inCls :: InputModule -> Structure -> [(String, String)]
inCls _ Unbundled = []
        inCls Combined Bundled = (String
ipName, String
ipName) (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: [(String, String)]
inVarDefs
        inCls Separated Bundled = [(String, String)]
inVarDefs
        inVarDefs :: [(String, String)]
inVarDefs = (Input -> String) -> [Input] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Input -> String
forall c. CodeIdea c => c -> String
codeName [Input]
ins [String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` String -> [String]
forall a. a -> [a]
repeat String
ipName
        ipName :: String
ipName = "InputParameters"

-- | Gets constants to be exported for InputParameters or Constants module.
-- If there are no constants, constants will not be exported.
-- If 'Unmodular' and 'Bundled', constants will be exported by the module named after the program.
-- If 'Modular' and 'Store' 'Bundled', constants will be exported by the Constants module.
-- If 'Modular' 'WithInputs' and inputs are 'Bundled', constants will be exported by the InputParameters module.
-- If 'Unbundled', constants are not exported by any module.
getExpConstants :: Name -> Choices -> [Const] -> [ModExp]
getExpConstants :: String -> Choices -> [Derived] -> [(String, String)]
getExpConstants _ _ [] = []
getExpConstants n :: String
n chs :: Choices
chs cs :: [Derived]
cs = Modularity -> ConstantStructure -> Structure -> [(String, String)]
cExp (Architecture -> Modularity
modularity (Architecture -> Modularity) -> Architecture -> Modularity
forall a b. (a -> b) -> a -> b
$ Choices -> Architecture
architecture Choices
chs) (DataInfo -> ConstantStructure
constStructure (DataInfo -> ConstantStructure) -> DataInfo -> ConstantStructure
forall a b. (a -> b) -> a -> b
$ Choices -> DataInfo
dataInfo Choices
chs) 
  (DataInfo -> Structure
inputStructure (DataInfo -> Structure) -> DataInfo -> Structure
forall a b. (a -> b) -> a -> b
$ Choices -> DataInfo
dataInfo Choices
chs)
  where cExp :: Modularity -> ConstantStructure -> Structure -> [(String, String)]
cExp Unmodular (Store Bundled) _ = [String] -> [(String, String)]
forall b. [b] -> [(String, b)]
zipCs ([String] -> [(String, String)]) -> [String] -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ String -> [String]
forall a. a -> [a]
repeat String
n
        cExp Unmodular WithInputs Bundled = [String] -> [(String, String)]
forall b. [b] -> [(String, b)]
zipCs ([String] -> [(String, String)]) -> [String] -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ String -> [String]
forall a. a -> [a]
repeat String
n
        cExp _ (Store Bundled) _ = [String] -> [(String, String)]
forall b. [b] -> [(String, b)]
zipCs ([String] -> [(String, String)]) -> [String] -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ String -> [String]
forall a. a -> [a]
repeat "Constants"
        cExp _ WithInputs Bundled = [String] -> [(String, String)]
forall b. [b] -> [(String, b)]
zipCs ([String] -> [(String, String)]) -> [String] -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ String -> [String]
forall a. a -> [a]
repeat "InputParameters"
        cExp _ _ _ = []
        zipCs :: [b] -> [(String, b)]
zipCs = [String] -> [b] -> [(String, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Derived -> String) -> [Derived] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Derived -> String
forall c. CodeIdea c => c -> String
codeName [Derived]
cs)

-- | Gets state variables for constants in a class for InputParameters or Constants module.
-- If there are no constants, state variables for the constants are not defined in any class.
-- If constants are 'Bundled', state variables for the constants are in Constants.
-- If constants are 'Bundled' 'WithInputs', state variables for the constants are in InputParameters.
-- If constants are 'Unbundled', state variables for the constants are not defined in any class.
getConstantsCls :: Choices -> [Const] -> [ClassDef]
getConstantsCls :: Choices -> [Derived] -> [(String, String)]
getConstantsCls _ [] = []
getConstantsCls chs :: Choices
chs cs :: [Derived]
cs = ConstantStructure -> Structure -> [(String, String)]
cnCls (DataInfo -> ConstantStructure
constStructure (DataInfo -> ConstantStructure) -> DataInfo -> ConstantStructure
forall a b. (a -> b) -> a -> b
$ Choices -> DataInfo
dataInfo Choices
chs) (DataInfo -> Structure
inputStructure (DataInfo -> Structure) -> DataInfo -> Structure
forall a b. (a -> b) -> a -> b
$ Choices -> DataInfo
dataInfo Choices
chs)
  where cnCls :: ConstantStructure -> Structure -> [(String, String)]
cnCls (Store Bundled) _ = [String] -> [(String, String)]
forall b. [b] -> [(String, b)]
zipCs ([String] -> [(String, String)]) -> [String] -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ String -> [String]
forall a. a -> [a]
repeat "Constants"
        cnCls WithInputs Bundled = [String] -> [(String, String)]
forall b. [b] -> [(String, b)]
zipCs ([String] -> [(String, String)]) -> [String] -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ String -> [String]
forall a. a -> [a]
repeat "InputParameters"
        cnCls _ _ = []
        zipCs :: [b] -> [(String, b)]
zipCs = [String] -> [b] -> [(String, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Derived -> String) -> [Derived] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Derived -> String
forall c. CodeIdea c => c -> String
codeName [Derived]
cs)

-- | Get derived input functions (for @derived_values@).
-- If there are no derived inputs, a derived inputs function is not generated.
-- If input modules are 'Separated', derived_values will always be exported.
-- If input modules are 'Combined' and inputs are 'Bundled', derived_values will be a private method, not exported.
-- If input modules are 'Combined' and inputs are 'Unbundled', derived_values will be exported.
-- Similar logic for input_constraints and get_input below.
getExpDerived :: Name -> Choices -> [Derived] -> [ModExp]
getExpDerived :: String -> Choices -> [Derived] -> [(String, String)]
getExpDerived _ _ [] = []
getExpDerived n :: String
n chs :: Choices
chs _ = Modularity -> Structure -> [(String, String)]
dMod (Architecture -> Modularity
modularity (Architecture -> Modularity) -> Architecture -> Modularity
forall a b. (a -> b) -> a -> b
$ Choices -> Architecture
architecture Choices
chs) (DataInfo -> Structure
inputStructure (DataInfo -> Structure) -> DataInfo -> Structure
forall a b. (a -> b) -> a -> b
$ Choices -> DataInfo
dataInfo Choices
chs)
  where dMod :: Modularity -> Structure -> [(String, String)]
dMod (Modular Separated) _ = [(String
dvNm, "DerivedValues")]
        dMod _ Bundled = []
        dMod Unmodular _ = [(String
dvNm, String
n)]
        dMod (Modular Combined) _ = [(String
dvNm, "InputParameters")]
        dvNm :: String
dvNm = "derived_values"

-- | Get derived values defined in a class (for @derived_values@).
-- If there are no derived inputs, derived_values is not defined in any class.
-- If input modules are 'Combined' and inputs are 'Bundled', derived_values is defined in an InputParameters class.
-- Otherwise, derived_values is not defined in any class.
-- Similar logic for input_constraints and get_input below.
getDerivedCls :: Choices -> [Derived] -> [ClassDef]
getDerivedCls :: Choices -> [Derived] -> [(String, String)]
getDerivedCls _ [] = []
getDerivedCls chs :: Choices
chs _ = InputModule -> Structure -> [(String, String)]
dCls (Choices -> InputModule
inputModule Choices
chs) (DataInfo -> Structure
inputStructure (DataInfo -> Structure) -> DataInfo -> Structure
forall a b. (a -> b) -> a -> b
$ Choices -> DataInfo
dataInfo Choices
chs)
  where dCls :: InputModule -> Structure -> [(String, String)]
dCls Combined Bundled = [("derived_values", "InputParameters")]
        dCls _ _ = []

-- | Get input constraints to be exported (for @input_constraints@).
-- See 'getExpDerived' for full logic details.
getExpConstraints :: Name -> Choices -> [ConstraintCE] -> [ModExp]
getExpConstraints :: String -> Choices -> [ConstraintCE] -> [(String, String)]
getExpConstraints _ _ [] = []
getExpConstraints n :: String
n chs :: Choices
chs _ = Modularity -> Structure -> [(String, String)]
cMod (Architecture -> Modularity
modularity (Architecture -> Modularity) -> Architecture -> Modularity
forall a b. (a -> b) -> a -> b
$ Choices -> Architecture
architecture Choices
chs) (DataInfo -> Structure
inputStructure (DataInfo -> Structure) -> DataInfo -> Structure
forall a b. (a -> b) -> a -> b
$ Choices -> DataInfo
dataInfo Choices
chs)
  where cMod :: Modularity -> Structure -> [(String, String)]
cMod (Modular Separated) _ = [(String
icNm, "InputConstraints")]
        cMod _ Bundled = []
        cMod Unmodular _ = [(String
icNm, String
n)]
        cMod (Modular Combined) _ = [(String
icNm, "InputParameters")]
        icNm :: String
icNm = "input_constraints"

-- | Get constraints defined in a class (for @input_constraints@).
-- See 'getDerivedCls' for full logic details.
getConstraintsCls :: Choices -> [ConstraintCE] -> [ClassDef]
getConstraintsCls :: Choices -> [ConstraintCE] -> [(String, String)]
getConstraintsCls _   [] = []
getConstraintsCls chs :: Choices
chs _  = InputModule -> Structure -> [(String, String)]
cCls (Choices -> InputModule
inputModule Choices
chs) (DataInfo -> Structure
inputStructure (DataInfo -> Structure) -> DataInfo -> Structure
forall a b. (a -> b) -> a -> b
$ Choices -> DataInfo
dataInfo Choices
chs)
  where cCls :: InputModule -> Structure -> [(String, String)]
cCls Combined Bundled = [("input_constraints", "InputParameters")]
        cCls _ _ = []

-- | Get input format to be exported (for @get_input@).
-- See 'getExpDerived' for full logic details.
getExpInputFormat :: Name -> Choices -> [Input] -> [ModExp]
getExpInputFormat :: String -> Choices -> [Input] -> [(String, String)]
getExpInputFormat _ _ [] = []
getExpInputFormat n :: String
n chs :: Choices
chs _ = Modularity -> Structure -> [(String, String)]
fMod (Architecture -> Modularity
modularity (Architecture -> Modularity) -> Architecture -> Modularity
forall a b. (a -> b) -> a -> b
$ Choices -> Architecture
architecture Choices
chs) (DataInfo -> Structure
inputStructure (DataInfo -> Structure) -> DataInfo -> Structure
forall a b. (a -> b) -> a -> b
$ Choices -> DataInfo
dataInfo Choices
chs)
  where fMod :: Modularity -> Structure -> [(String, String)]
fMod (Modular Separated) _ = [(String
giNm, "InputFormat")]
        fMod _ Bundled = []
        fMod Unmodular _ = [(String
giNm, String
n)]
        fMod (Modular Combined) _ = [(String
giNm, "InputParameters")]
        giNm :: String
giNm = "get_input"

-- | Get input format defined in a class (for @get_input@).
-- See 'getDerivedCls' for full logic details.
getInputFormatCls :: Choices -> [Input] -> [ClassDef]
getInputFormatCls :: Choices -> [Input] -> [(String, String)]
getInputFormatCls _ [] = []
getInputFormatCls chs :: Choices
chs _ = InputModule -> Structure -> [(String, String)]
ifCls (Choices -> InputModule
inputModule Choices
chs) (DataInfo -> Structure
inputStructure (DataInfo -> Structure) -> DataInfo -> Structure
forall a b. (a -> b) -> a -> b
$ Choices -> DataInfo
dataInfo Choices
chs)
  where ifCls :: InputModule -> Structure -> [(String, String)]
ifCls Combined Bundled = [("get_input", "InputParameters")]
        ifCls _ _ = []

-- | Gets exported calculations.
-- Functions are exported by module named after program if 'Unmodular'.
-- Function is exported by Calculations module if program is 'Modular'.
getExpCalcs :: Name -> Choices -> [Def] -> [ModExp]
getExpCalcs :: String -> Choices -> [Derived] -> [(String, String)]
getExpCalcs n :: String
n chs :: Choices
chs = (Derived -> (String, String)) -> [Derived] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\d :: Derived
d -> (Derived -> String
forall c. CodeIdea c => c -> String
codeName Derived
d, String
calMod))
  where calMod :: String
calMod = Modularity -> String
cMod (Modularity -> String) -> Modularity -> String
forall a b. (a -> b) -> a -> b
$ Architecture -> Modularity
modularity (Architecture -> Modularity) -> Architecture -> Modularity
forall a b. (a -> b) -> a -> b
$ Choices -> Architecture
architecture Choices
chs
        cMod :: Modularity -> String
cMod Unmodular = String
n
        cMod _ = "Calculations"

-- | Get exported outputs (for @write_output@).
-- No output function is exported if there are no outputs.
-- Function is exported by module named after program if 'Unmodular'.
-- Function is exported by OutputFormat module if program is 'Modular'.
getExpOutput :: Name -> Choices -> [Output] -> [ModExp]
getExpOutput :: String -> Choices -> [Input] -> [(String, String)]
getExpOutput _ _ [] = []
getExpOutput n :: String
n chs :: Choices
chs _ = [("write_output", Modularity -> String
oMod (Modularity -> String) -> Modularity -> String
forall a b. (a -> b) -> a -> b
$ Architecture -> Modularity
modularity (Architecture -> Modularity) -> Architecture -> Modularity
forall a b. (a -> b) -> a -> b
$ Choices -> Architecture
architecture Choices
chs)]
  where oMod :: Modularity -> String
oMod Unmodular = String
n
        oMod _ = "OutputFormat"