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

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

import Data.Containers.ListUtils (nubOrd)

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, Logging, 
  Structure(..), InternalConcept(..))
import Language.Drasil.CodeSpec (Input, Const, Derived, Output, Def,
  CodeSpec(..),  OldCodeSpec(..), getConstraints)
import Language.Drasil.Mod (Mod(..), Name, Version, Class(..),
  StateVariable(..), fname)

import Control.Lens ((^.), makeLenses, over)
import Control.Monad.State (State, gets)
import Data.List (nub)
import Data.Set (Set)
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

-- | Variable scope
data ScopeType = Local | Global | MainFn

-- | 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],
  DrasilState -> InternalConcept -> String
dsICNames :: InternalConcept -> Name,
  -- 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 -> Set String
defSet :: Set Name,
  DrasilState -> Int
getVal :: Int,

  -- Stateful
  DrasilState -> String
currentModule :: String,
  DrasilState -> String
currentClass :: String,
  DrasilState -> Doc
_designLog :: Doc,
  DrasilState -> [(Space, CodeType)]
_loggedSpaces :: [(Space, CodeType)],
  DrasilState -> ScopeType
currentScope :: ScopeType
}
makeLenses ''DrasilState

-- | 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) (Space, CodeType) -> [(Space, CodeType)] -> Bool
forall a. Eq a => a -> [a] -> 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 Space
s 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 :: OldCodeSpec -> Choices -> [Mod] -> ModExportMap
modExportMap :: OldCodeSpec -> Choices -> [Mod] -> ModExportMap
modExportMap cs :: OldCodeSpec
cs@OldCodeSpec {
  _pName :: OldCodeSpec -> String
_pName = String
prn,
  _inputs :: OldCodeSpec -> [Input]
_inputs = [Input]
ins,
  _extInputs :: OldCodeSpec -> [Input]
_extInputs = [Input]
extIns,
  _derivedInputs :: OldCodeSpec -> [Def]
_derivedInputs = [Def]
ds,
  _constants :: OldCodeSpec -> [Def]
_constants = [Def]
cns
  } chs :: Choices
chs@Choices {
    architecture :: Choices -> Architecture
architecture = Architecture
m
  } [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. Ord a => [a] -> [a]
nubOrd ([(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 -> [Def] -> [(String, String)]
getExpConstants String
prn Choices
chs [Def]
cns
    [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ String -> Choices -> [Def] -> [(String, String)]
getExpDerived String
prn Choices
chs [Def]
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 (OldCodeSpec -> ConstraintCEMap
_cMap OldCodeSpec
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 -> [Def] -> [(String, String)]
getExpCalcs String
prn Choices
chs (OldCodeSpec -> [Def]
_execOrder OldCodeSpec
cs)
    [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ String -> Choices -> [Input] -> [(String, String)]
getExpOutput String
prn Choices
chs (OldCodeSpec -> [Input]
_outputs OldCodeSpec
cs)
  where mpair :: Mod -> [(String, String)]
mpair (Mod String
n String
_ [String]
_ [Class]
cls [Func]
fs) = (String -> (String, String)) -> [String] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map
          (, Modularity -> String -> String
defModName (Architecture -> Modularity
modularity Architecture
m) String
n)
          ((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 ((VisibilityTag -> VisibilityTag -> Bool
forall a. Eq a => a -> a -> Bool
== VisibilityTag
Pub) (VisibilityTag -> Bool)
-> (StateVariable -> VisibilityTag) -> StateVariable -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateVariable -> VisibilityTag
svVisibility) ([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))
        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 :: OldCodeSpec -> Choices -> [Mod] -> ClassDefinitionMap
clsDefMap :: OldCodeSpec -> Choices -> [Mod] -> ModExportMap
clsDefMap cs :: OldCodeSpec
cs@OldCodeSpec {
  _inputs :: OldCodeSpec -> [Input]
_inputs = [Input]
ins,
  _extInputs :: OldCodeSpec -> [Input]
_extInputs = [Input]
extIns,
  _derivedInputs :: OldCodeSpec -> [Def]
_derivedInputs = [Def]
ds,
  _constants :: OldCodeSpec -> [Def]
_constants = [Def]
cns
  } Choices
chs [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 -> [Def] -> [(String, String)]
getConstantsCls Choices
chs [Def]
cns
    [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ Choices -> [Def] -> [(String, String)]
getDerivedCls Choices
chs [Def]
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 (OldCodeSpec -> ConstraintCEMap
_cMap OldCodeSpec
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 String
_ String
_ [String]
_ [Class]
cls [Func]
_) = (Class -> [(String, String)]) -> [Class] -> [(String, String)]
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) (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 (\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 (\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' '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 (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 Modularity
_ Structure
Unbundled = []
        inExp Modularity
Unmodular Structure
Bundled = (String
ipName, String
prn) (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: String -> [(String, String)]
forall {t}. t -> [(String, t)]
inVarDefs String
prn
        inExp Modularity
Modular Structure
Bundled = (String
ipName , String
ipName) (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: String -> [(String, String)]
forall {t}. t -> [(String, t)]
inVarDefs String
ipName
        inVarDefs :: t -> [(String, t)]
inVarDefs t
n = (Input -> (String, t)) -> [Input] -> [(String, t)]
forall a b. (a -> b) -> [a] -> [b]
map ((, t
n) (String -> (String, t))
-> (Input -> String) -> Input -> (String, t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input -> String
forall c. CodeIdea c => c -> String
codeName) [Input]
ins
        ipName :: String
ipName = Choices -> InternalConcept -> String
icNames Choices
chs InternalConcept
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', input variables and input constructor are defined in InputParameters.
getInputCls :: Choices -> [Input] -> [ClassDef]
getInputCls :: Choices -> [Input] -> [(String, String)]
getInputCls Choices
_ [] = []
getInputCls Choices
chs [Input]
ins = Structure -> [(String, String)]
inCls (DataInfo -> Structure
inputStructure (DataInfo -> Structure) -> DataInfo -> Structure
forall a b. (a -> b) -> a -> b
$ Choices -> DataInfo
dataInfo Choices
chs)
  where inCls :: Structure -> [(String, String)]
inCls Structure
Unbundled = []
        inCls Structure
Bundled = (String
ipName, String
ipName) (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: [(String, String)]
inVarDefs
        inVarDefs :: [(String, String)]
inVarDefs = (Input -> (String, String)) -> [Input] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((, String
ipName) (String -> (String, String))
-> (Input -> String) -> Input -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input -> String
forall c. CodeIdea c => c -> String
codeName) [Input]
ins
        ipName :: String
ipName = Choices -> InternalConcept -> String
icNames Choices
chs InternalConcept
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 (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 Modularity
Unmodular (Store Structure
Bundled) Structure
_ = [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 Modularity
Unmodular ConstantStructure
WithInputs Structure
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 Modularity
_ (Store Structure
Bundled) Structure
_ = [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 (Choices -> InternalConcept -> String
icNames Choices
chs InternalConcept
Constants)
        cExp Modularity
_ ConstantStructure
WithInputs Structure
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 (Choices -> InternalConcept -> String
icNames Choices
chs InternalConcept
InputParameters)
        cExp Modularity
_ ConstantStructure
_ Structure
_ = []
        zipCs :: [b] -> [(String, b)]
zipCs = [String] -> [b] -> [(String, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Def -> String) -> [Def] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Def -> String
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 (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 Structure
Bundled) Structure
_ = InternalConcept -> [(String, String)]
zipCs InternalConcept
Constants
        cnCls ConstantStructure
WithInputs Structure
Bundled = InternalConcept -> [(String, String)]
zipCs InternalConcept
InputParameters
        cnCls ConstantStructure
_ Structure
_ = []
        zipCs :: InternalConcept -> [(String, String)]
zipCs InternalConcept
ic = (Def -> (String, String)) -> [Def] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((, Choices -> InternalConcept -> String
icNames Choices
chs InternalConcept
ic) (String -> (String, String))
-> (Def -> String) -> Def -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Def -> String
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 inputs are 'Bundled', derived_values will be a private method, not exported.
-- If 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 (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 Modularity
_ Structure
Bundled = []
        dMod Modularity
Unmodular Structure
_ = [(String
dvNm, String
n)]
        dMod Modularity
Modular Structure
_ = [(String
dvNm, Choices -> InternalConcept -> String
icNames Choices
chs InternalConcept
InputParameters)]
        dvNm :: String
dvNm = Choices -> InternalConcept -> String
icNames Choices
chs InternalConcept
DerivedValuesFn

-- | 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 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]
_ = Structure -> [(String, String)]
dCls (DataInfo -> Structure
inputStructure (DataInfo -> Structure) -> DataInfo -> Structure
forall a b. (a -> b) -> a -> b
$ Choices -> DataInfo
dataInfo Choices
chs)
  where dCls :: Structure -> [(String, String)]
dCls Structure
Bundled = [(Choices -> InternalConcept -> String
icNames Choices
chs InternalConcept
DerivedValuesFn, Choices -> InternalConcept -> String
icNames Choices
chs InternalConcept
InputParameters)]
        dCls 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 (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 Modularity
_ Structure
Bundled = []
        cMod Modularity
Unmodular Structure
_ = [(String
icNm, String
n)]
        cMod Modularity
Modular Structure
_ = [(String
icNm, Choices -> InternalConcept -> String
icNames Choices
chs InternalConcept
InputParameters)]
        icNm :: String
icNm =  Choices -> InternalConcept -> String
icNames Choices
chs InternalConcept
InputConstraintsFn

-- | 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]
_  = Structure -> [(String, String)]
cCls (DataInfo -> Structure
inputStructure (DataInfo -> Structure) -> DataInfo -> Structure
forall a b. (a -> b) -> a -> b
$ Choices -> DataInfo
dataInfo Choices
chs)
  where cCls :: Structure -> [(String, String)]
cCls Structure
Bundled = [(Choices -> InternalConcept -> String
icNames Choices
chs InternalConcept
InputConstraintsFn, Choices -> InternalConcept -> String
icNames Choices
chs InternalConcept
InputParameters)]
        cCls 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 (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 Modularity
_ Structure
Bundled = []
        fMod Modularity
Unmodular Structure
_ = [(String
giNm, String
n)]
        fMod Modularity
Modular Structure
_ = [(String
giNm, Choices -> InternalConcept -> String
icNames Choices
chs InternalConcept
InputParameters)]
        giNm :: String
giNm = Choices -> InternalConcept -> String
icNames Choices
chs InternalConcept
GetInput

-- | 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]
_ = Structure -> [(String, String)]
ifCls (DataInfo -> Structure
inputStructure (DataInfo -> Structure) -> DataInfo -> Structure
forall a b. (a -> b) -> a -> b
$ Choices -> DataInfo
dataInfo Choices
chs)
  where ifCls :: Structure -> [(String, String)]
ifCls Structure
Bundled = [(Choices -> InternalConcept -> String
icNames Choices
chs InternalConcept
GetInput, Choices -> InternalConcept -> String
icNames Choices
chs InternalConcept
InputParameters)]
        ifCls 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 = (Def -> (String, String)) -> [Def] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\Def
d -> (Def -> String
forall c. CodeIdea c => c -> String
codeName Def
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 Modularity
Unmodular = String
n
        cMod Modularity
_ = Choices -> InternalConcept -> String
icNames Choices
chs InternalConcept
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]
_ = [(Choices -> InternalConcept -> String
icNames Choices
chs InternalConcept
WriteOutput, 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 Modularity
Unmodular = String
n
        oMod Modularity
_ = Choices -> InternalConcept -> String
icNames Choices
chs InternalConcept
OutputFormat

-- | Get InternalConcept name using DrasilState
genICName :: InternalConcept -> GenState Name
genICName :: InternalConcept -> GenState String
genICName InternalConcept
ic = (DrasilState -> String) -> GenState String
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (DrasilState -> InternalConcept -> String
`dsICNames` InternalConcept
ic)