{-# LANGUAGE TemplateHaskell, TupleSections #-}
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.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],
  DrasilState -> Int
getVal :: Int,
  
  -- 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 DrasilState
ds = Modularity -> InputModule
inMod' forall a b. (a -> b) -> a -> b
$ DrasilState -> Modularity
modular DrasilState
ds
  where inMod' :: Modularity -> InputModule
inMod' Modularity
Unmodular = InputModule
Combined
        inMod' (Modular 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 Space
s CodeType
t Doc
l DrasilState
ds = if (Space
s,CodeType
t) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (DrasilState
ds forall s a. s -> Getting a s a -> a
^. Lens' DrasilState [(Space, CodeType)]
loggedSpaces) then DrasilState
ds
  else forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over 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 Space
s CodeType
t = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' DrasilState [(Space, CodeType)]
loggedSpaces ((Space
s,CodeType
t)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 -> [Def]
derivedInputs = [Def]
ds,
  constants :: CodeSpec -> [Def]
constants = [Def]
cns
  } chs :: Choices
chs@Choices {
    architecture :: Choices -> Architecture
architecture = Architecture
m
  } [Mod]
ms = forall k a. Ord k => [(k, a)] -> Map k a
fromList forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Mod -> [(String, String)]
mpair [Mod]
ms
    forall a. [a] -> [a] -> [a]
++ String -> Choices -> [Input] -> [(String, String)]
getExpInput String
prn Choices
chs [Input]
ins
    forall a. [a] -> [a] -> [a]
++ String -> Choices -> [Def] -> [(String, String)]
getExpConstants String
prn Choices
chs [Def]
cns
    forall a. [a] -> [a] -> [a]
++ String -> Choices -> [Def] -> [(String, String)]
getExpDerived String
prn Choices
chs [Def]
ds
    forall a. [a] -> [a] -> [a]
++ String -> Choices -> [ConstraintCE] -> [(String, String)]
getExpConstraints String
prn Choices
chs (forall c. HasUID c => ConstraintCEMap -> [c] -> [ConstraintCE]
getConstraints (CodeSpec -> ConstraintCEMap
cMap CodeSpec
cs) [Input]
ins)
    forall a. [a] -> [a] -> [a]
++ String -> Choices -> [Input] -> [(String, String)]
getExpInputFormat String
prn Choices
chs [Input]
extIns
    forall a. [a] -> [a] -> [a]
++ String -> Choices -> [Def] -> [(String, String)]
getExpCalcs String
prn Choices
chs (CodeSpec -> [Def]
execOrder CodeSpec
cs)
    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 String
n String
_ [String]
_ [Class]
cls [Func]
fs) = forall a b. (a -> b) -> [a] -> [b]
map
          (, Modularity -> String -> String
defModName (Architecture -> Modularity
modularity Architecture
m) String
n)
          (forall a b. (a -> b) -> [a] -> [b]
map Class -> String
className [Class]
cls
            forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b. (a -> b) -> [a] -> [b]
map (forall c. CodeIdea c => c -> String
codeName forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateVariable -> Input
stVar) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== ScopeTag
Pub) forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateVariable -> ScopeTag
svScope) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> [StateVariable]
stateVars) [Class]
cls
            forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map Func -> String
fname ([Func]
fs forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Class -> [Func]
methods [Class]
cls))
        defModName :: Modularity -> String -> String
defModName Modularity
Unmodular String
_ = String
prn
        defModName Modularity
_ 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 -> [Def]
derivedInputs = [Def]
ds,
  constants :: CodeSpec -> [Def]
constants = [Def]
cns
  } Choices
chs [Mod]
ms = forall k a. Ord k => [(k, a)] -> Map k a
fromList forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Mod -> [(String, String)]
modClasses [Mod]
ms
    forall a. [a] -> [a] -> [a]
++ Choices -> [Input] -> [(String, String)]
getInputCls Choices
chs [Input]
ins
    forall a. [a] -> [a] -> [a]
++ Choices -> [Def] -> [(String, String)]
getConstantsCls Choices
chs [Def]
cns
    forall a. [a] -> [a] -> [a]
++ Choices -> [Def] -> [(String, String)]
getDerivedCls Choices
chs [Def]
ds
    forall a. [a] -> [a] -> [a]
++ Choices -> [ConstraintCE] -> [(String, String)]
getConstraintsCls Choices
chs (forall c. HasUID c => ConstraintCEMap -> [c] -> [ConstraintCE]
getConstraints (CodeSpec -> ConstraintCEMap
cMap CodeSpec
cs) [Input]
ins)
    forall a. [a] -> [a] -> [a]
++ Choices -> [Input] -> [(String, String)]
getInputFormatCls Choices
chs [Input]
extIns
    where modClasses :: Mod -> [(String, String)]
modClasses (Mod String
_ String
_ [String]
_ [Class]
cls [Func]
_) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Class
cl ->
            let cln :: String
cln = Class -> String
className Class
cl in
            (String
cln, String
cln) forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (\StateVariable
sv -> (forall c. CodeIdea c => c -> String
codeName (StateVariable -> Input
stVar StateVariable
sv), String
cln)) (Class -> [StateVariable]
stateVars Class
cl)
              forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (\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 String
_ Choices
_ [] = []
getExpInput String
prn Choices
chs [Input]
ins = Modularity -> Structure -> [(String, String)]
inExp (Architecture -> Modularity
modularity forall a b. (a -> b) -> a -> b
$ Choices -> Architecture
architecture Choices
chs) (DataInfo -> Structure
inputStructure forall a b. (a -> b) -> a -> b
$ Choices -> DataInfo
dataInfo Choices
chs)
  where inExp :: Modularity -> Structure -> [(String, String)]
inExp Modularity
_ Structure
Unbundled = []
        inExp Modularity
Unmodular Structure
Bundled = (String
ipName, String
prn) forall a. a -> [a] -> [a]
: forall {t}. t -> [(String, t)]
inVarDefs String
prn
        inExp (Modular InputModule
Separated) Structure
Bundled = forall {t}. t -> [(String, t)]
inVarDefs String
ipName
        inExp (Modular InputModule
Combined) Structure
Bundled = (String
ipName , String
ipName) forall a. a -> [a] -> [a]
: forall {t}. t -> [(String, t)]
inVarDefs String
ipName
        inVarDefs :: t -> [(String, t)]
inVarDefs t
n = forall a b. (a -> b) -> [a] -> [b]
map ((, t
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. CodeIdea c => c -> String
codeName) [Input]
ins
        ipName :: String
ipName = String
"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 Choices
_ [] = []
getInputCls Choices
chs [Input]
ins = InputModule -> Structure -> [(String, String)]
inCls (Choices -> InputModule
inputModule Choices
chs) (DataInfo -> Structure
inputStructure forall a b. (a -> b) -> a -> b
$ Choices -> DataInfo
dataInfo Choices
chs)
  where inCls :: InputModule -> Structure -> [(String, String)]
inCls InputModule
_ Structure
Unbundled = []
        inCls InputModule
Combined Structure
Bundled = (String
ipName, String
ipName) forall a. a -> [a] -> [a]
: [(String, String)]
inVarDefs
        inCls InputModule
Separated Structure
Bundled = [(String, String)]
inVarDefs
        inVarDefs :: [(String, String)]
inVarDefs = forall a b. (a -> b) -> [a] -> [b]
map ((, String
ipName) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. CodeIdea c => c -> String
codeName) [Input]
ins
        ipName :: String
ipName = String
"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 -> [Def] -> [(String, String)]
getExpConstants String
_ Choices
_ [] = []
getExpConstants String
n Choices
chs [Def]
cs = Modularity -> ConstantStructure -> Structure -> [(String, String)]
cExp (Architecture -> Modularity
modularity forall a b. (a -> b) -> a -> b
$ Choices -> Architecture
architecture Choices
chs) (DataInfo -> ConstantStructure
constStructure forall a b. (a -> b) -> a -> b
$ Choices -> DataInfo
dataInfo Choices
chs)
  (DataInfo -> Structure
inputStructure forall a b. (a -> b) -> a -> b
$ Choices -> DataInfo
dataInfo Choices
chs)
  where cExp :: Modularity -> ConstantStructure -> Structure -> [(String, String)]
cExp Modularity
Unmodular (Store Structure
Bundled) Structure
_ = forall {b}. [b] -> [(String, b)]
zipCs forall a b. (a -> b) -> a -> b
$ forall a. a -> [a]
repeat String
n
        cExp Modularity
Unmodular ConstantStructure
WithInputs Structure
Bundled = forall {b}. [b] -> [(String, b)]
zipCs forall a b. (a -> b) -> a -> b
$ forall a. a -> [a]
repeat String
n
        cExp Modularity
_ (Store Structure
Bundled) Structure
_ = forall {b}. [b] -> [(String, b)]
zipCs forall a b. (a -> b) -> a -> b
$ forall a. a -> [a]
repeat String
"Constants"
        cExp Modularity
_ ConstantStructure
WithInputs Structure
Bundled = forall {b}. [b] -> [(String, b)]
zipCs forall a b. (a -> b) -> a -> b
$ forall a. a -> [a]
repeat String
"InputParameters"
        cExp Modularity
_ ConstantStructure
_ Structure
_ = []
        zipCs :: [b] -> [(String, b)]
zipCs = forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map forall c. CodeIdea c => c -> String
codeName [Def]
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 -> [Def] -> [(String, String)]
getConstantsCls Choices
_ [] = []
getConstantsCls Choices
chs [Def]
cs = ConstantStructure -> Structure -> [(String, String)]
cnCls (DataInfo -> ConstantStructure
constStructure forall a b. (a -> b) -> a -> b
$ Choices -> DataInfo
dataInfo Choices
chs) (DataInfo -> Structure
inputStructure forall a b. (a -> b) -> a -> b
$ Choices -> DataInfo
dataInfo Choices
chs)
  where cnCls :: ConstantStructure -> Structure -> [(String, String)]
cnCls (Store Structure
Bundled) Structure
_ = forall {b}. [b] -> [(String, b)]
zipCs forall a b. (a -> b) -> a -> b
$ forall a. a -> [a]
repeat String
"Constants"
        cnCls ConstantStructure
WithInputs Structure
Bundled = forall {b}. [b] -> [(String, b)]
zipCs forall a b. (a -> b) -> a -> b
$ forall a. a -> [a]
repeat String
"InputParameters"
        cnCls ConstantStructure
_ Structure
_ = []
        zipCs :: [b] -> [(String, b)]
zipCs = forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map forall c. CodeIdea c => c -> String
codeName [Def]
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 -> [Def] -> [(String, String)]
getExpDerived String
_ Choices
_ [] = []
getExpDerived String
n Choices
chs [Def]
_ = Modularity -> Structure -> [(String, String)]
dMod (Architecture -> Modularity
modularity forall a b. (a -> b) -> a -> b
$ Choices -> Architecture
architecture Choices
chs) (DataInfo -> Structure
inputStructure forall a b. (a -> b) -> a -> b
$ Choices -> DataInfo
dataInfo Choices
chs)
  where dMod :: Modularity -> Structure -> [(String, String)]
dMod (Modular InputModule
Separated) Structure
_ = [(String
dvNm, String
"DerivedValues")]
        dMod Modularity
_ Structure
Bundled = []
        dMod Modularity
Unmodular Structure
_ = [(String
dvNm, String
n)]
        dMod (Modular InputModule
Combined) Structure
_ = [(String
dvNm, String
"InputParameters")]
        dvNm :: String
dvNm = String
"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 -> [Def] -> [(String, String)]
getDerivedCls Choices
_ [] = []
getDerivedCls Choices
chs [Def]
_ = InputModule -> Structure -> [(String, String)]
dCls (Choices -> InputModule
inputModule Choices
chs) (DataInfo -> Structure
inputStructure forall a b. (a -> b) -> a -> b
$ Choices -> DataInfo
dataInfo Choices
chs)
  where dCls :: InputModule -> Structure -> [(String, String)]
dCls InputModule
Combined Structure
Bundled = [(String
"derived_values", String
"InputParameters")]
        dCls InputModule
_ Structure
_ = []

-- | 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 String
_ Choices
_ [] = []
getExpConstraints String
n Choices
chs [ConstraintCE]
_ = Modularity -> Structure -> [(String, String)]
cMod (Architecture -> Modularity
modularity forall a b. (a -> b) -> a -> b
$ Choices -> Architecture
architecture Choices
chs) (DataInfo -> Structure
inputStructure forall a b. (a -> b) -> a -> b
$ Choices -> DataInfo
dataInfo Choices
chs)
  where cMod :: Modularity -> Structure -> [(String, String)]
cMod (Modular InputModule
Separated) Structure
_ = [(String
icNm, String
"InputConstraints")]
        cMod Modularity
_ Structure
Bundled = []
        cMod Modularity
Unmodular Structure
_ = [(String
icNm, String
n)]
        cMod (Modular InputModule
Combined) Structure
_ = [(String
icNm, String
"InputParameters")]
        icNm :: String
icNm = String
"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 Choices
_   [] = []
getConstraintsCls Choices
chs [ConstraintCE]
_  = InputModule -> Structure -> [(String, String)]
cCls (Choices -> InputModule
inputModule Choices
chs) (DataInfo -> Structure
inputStructure forall a b. (a -> b) -> a -> b
$ Choices -> DataInfo
dataInfo Choices
chs)
  where cCls :: InputModule -> Structure -> [(String, String)]
cCls InputModule
Combined Structure
Bundled = [(String
"input_constraints", String
"InputParameters")]
        cCls InputModule
_ Structure
_ = []

-- | 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 String
_ Choices
_ [] = []
getExpInputFormat String
n Choices
chs [Input]
_ = Modularity -> Structure -> [(String, String)]
fMod (Architecture -> Modularity
modularity forall a b. (a -> b) -> a -> b
$ Choices -> Architecture
architecture Choices
chs) (DataInfo -> Structure
inputStructure forall a b. (a -> b) -> a -> b
$ Choices -> DataInfo
dataInfo Choices
chs)
  where fMod :: Modularity -> Structure -> [(String, String)]
fMod (Modular InputModule
Separated) Structure
_ = [(String
giNm, String
"InputFormat")]
        fMod Modularity
_ Structure
Bundled = []
        fMod Modularity
Unmodular Structure
_ = [(String
giNm, String
n)]
        fMod (Modular InputModule
Combined) Structure
_ = [(String
giNm, String
"InputParameters")]
        giNm :: String
giNm = String
"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 Choices
_ [] = []
getInputFormatCls Choices
chs [Input]
_ = InputModule -> Structure -> [(String, String)]
ifCls (Choices -> InputModule
inputModule Choices
chs) (DataInfo -> Structure
inputStructure forall a b. (a -> b) -> a -> b
$ Choices -> DataInfo
dataInfo Choices
chs)
  where ifCls :: InputModule -> Structure -> [(String, String)]
ifCls InputModule
Combined Structure
Bundled = [(String
"get_input", String
"InputParameters")]
        ifCls InputModule
_ Structure
_ = []

-- | 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 -> [Def] -> [(String, String)]
getExpCalcs String
n Choices
chs = forall a b. (a -> b) -> [a] -> [b]
map (\Def
d -> (forall c. CodeIdea c => c -> String
codeName Def
d, String
calMod))
  where calMod :: String
calMod = Modularity -> String
cMod forall a b. (a -> b) -> a -> b
$ Architecture -> Modularity
modularity forall a b. (a -> b) -> a -> b
$ Choices -> Architecture
architecture Choices
chs
        cMod :: Modularity -> String
cMod Modularity
Unmodular = String
n
        cMod Modularity
_ = String
"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 String
_ Choices
_ [] = []
getExpOutput String
n Choices
chs [Input]
_ = [(String
"write_output", Modularity -> String
oMod forall a b. (a -> b) -> a -> b
$ Architecture -> Modularity
modularity forall a b. (a -> b) -> a -> b
$ Choices -> Architecture
architecture Choices
chs)]
  where oMod :: Modularity -> String
oMod Modularity
Unmodular = String
n
        oMod Modularity
_ = String
"OutputFormat"