{-# LANGUAGE TemplateHaskell, TupleSections #-}
module Language.Drasil.Code.Imperative.DrasilState (
  SoftwareDossierInfo, makeSoftwareDossierInfo, doxOutput, softwareDossierFiles,
  sampleData, ChoicesInfo, HasChoices(..), makeChoicesInfo, GenState,
  DrasilState(..), softwareDossierInfo, getDoxOutput, getSoftwareDossierFiles,
  getSampleData, designLog, MatchedSpaces, ModExportMap, ClassDefinitionMap,
  ScopeType(..), modExportMap, clsDefMap, addToDesignLog, addLoggedSpace,
  genICName, lookupC,
) where

import Control.Lens ((^.), makeLenses, over, Lens')
import Control.Monad.State (State, MonadState (get))
import Data.List (nub)
import Data.Containers.ListUtils (nubOrd)
import Data.Set (Set)
import Data.Map (Map, fromList)
import Text.PrettyPrint.HughesPJ (Doc, ($$))

import Drasil.Database (UID, findOrErr)
import Language.Drasil (Space, Expr, DefinedQuantityDict)
import Language.Drasil.Printers (PrintingInformation)
import Drasil.GOOL (VisibilityTag(..), CodeType)

import Drasil.Code.CodeVar (CodeIdea(..))
import Language.Drasil.Chunk.ConstraintMap (ConstraintCE)
import Language.Drasil.Code.ExtLibImport (ExtLibState)
import Language.Drasil.Choices (Choices(..), Architecture (..), DataInfo(..),
  SoftwareDossierFile, Modularity(..), ImplementationType(..), Comments, Verbosity,
  MatchedConceptMap, ConstantRepr, ConstantStructure(..), ConstraintBehaviour, Logging,
  Structure(..), InternalConcept(..))
import Language.Drasil.CodeSpec (Input, Const, Derived, Output,
  CodeSpec(..),  OldCodeSpec(..), getConstraints, systemdbO)
import Language.Drasil.ICOSolutionSearch (Def)
import Language.Drasil.Mod (Mod(..), Name, Version, Class(..),
  StateVariable(..), fname)

data SoftwareDossierInfo = SoftwareDossierInfo {
  SoftwareDossierInfo -> Verbosity
_doxOutput :: Verbosity,
  SoftwareDossierInfo -> [SoftwareDossierFile]
_softwareDossierFiles :: [SoftwareDossierFile],
  SoftwareDossierInfo -> [Expr]
_sampleData :: [Expr]
}

makeSoftwareDossierInfo :: Verbosity -> [SoftwareDossierFile] -> [Expr] -> SoftwareDossierInfo
makeSoftwareDossierInfo :: Verbosity -> [SoftwareDossierFile] -> [Expr] -> SoftwareDossierInfo
makeSoftwareDossierInfo = Verbosity -> [SoftwareDossierFile] -> [Expr] -> SoftwareDossierInfo
SoftwareDossierInfo

data ChoicesInfo = ChoicesInfo {
  ChoicesInfo -> Modularity
_getModular :: Modularity,
  ChoicesInfo -> ImplementationType
_getImplType :: ImplementationType,
  ChoicesInfo -> Structure
_getInStruct :: Structure,
  ChoicesInfo -> ConstantStructure
_getConStruct :: ConstantStructure,
  ChoicesInfo -> ConstantRepr
_getConRepr :: ConstantRepr,
  ChoicesInfo -> MatchedConceptMap
_getConcMatches :: MatchedConceptMap,
  ChoicesInfo -> MatchedSpaces
_getSpaceMatches :: MatchedSpaces,
  ChoicesInfo -> ConstraintBehaviour
_getOnSfwrC :: ConstraintBehaviour,
  ChoicesInfo -> ConstraintBehaviour
_getOnPhysC :: ConstraintBehaviour,
  ChoicesInfo -> [Comments]
_getCommented :: [Comments],
  ChoicesInfo -> Name
_getDate :: String,
  ChoicesInfo -> Name
_getLogName :: String,
  ChoicesInfo -> [Logging]
_getLogKind :: [Logging],
  ChoicesInfo -> InternalConcept -> Name
_getDsICNames :: InternalConcept -> Name
}

makeChoicesInfo :: Modularity -> ImplementationType -> Structure -> ConstantStructure -> ConstantRepr -> MatchedConceptMap
  -> MatchedSpaces -> ConstraintBehaviour -> ConstraintBehaviour -> [Comments] -> String
  -> String -> [Logging] -> (InternalConcept -> Name) -> ChoicesInfo
makeChoicesInfo :: Modularity
-> ImplementationType
-> Structure
-> ConstantStructure
-> ConstantRepr
-> MatchedConceptMap
-> MatchedSpaces
-> ConstraintBehaviour
-> ConstraintBehaviour
-> [Comments]
-> Name
-> Name
-> [Logging]
-> (InternalConcept -> Name)
-> ChoicesInfo
makeChoicesInfo = Modularity
-> ImplementationType
-> Structure
-> ConstantStructure
-> ConstantRepr
-> MatchedConceptMap
-> MatchedSpaces
-> ConstraintBehaviour
-> ConstraintBehaviour
-> [Comments]
-> Name
-> Name
-> [Logging]
-> (InternalConcept -> Name)
-> ChoicesInfo
ChoicesInfo

-- | 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,
  DrasilState -> PrintingInformation
printfo :: PrintingInformation,
  -- Choices
  DrasilState -> ChoicesInfo
_choices :: ChoicesInfo,
  -- Reference materials
  DrasilState -> [Mod]
modules :: [Mod],
  DrasilState -> [(Name, Name)]
extLibNames :: [(Name,Version)],
  DrasilState -> ExtLibMap
extLibMap :: ExtLibMap,
  DrasilState -> [Name]
libPaths :: [FilePath],
  DrasilState -> ModExportMap
eMap :: ModExportMap,
  DrasilState -> ModExportMap
libEMap :: ModExportMap,
  DrasilState -> ModExportMap
clsMap :: ClassDefinitionMap,
  DrasilState -> Set Name
defSet :: Set Name,
  DrasilState -> Int
getVal :: Int,
  DrasilState -> SoftwareDossierInfo
_softwareDossierInfo :: SoftwareDossierInfo,

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

getDoxOutput :: DrasilState -> Verbosity
getDoxOutput :: DrasilState -> Verbosity
getDoxOutput DrasilState
ds = DrasilState
ds DrasilState -> Getting Verbosity DrasilState Verbosity -> Verbosity
forall s a. s -> Getting a s a -> a
^. ((SoftwareDossierInfo -> Const Verbosity SoftwareDossierInfo)
-> DrasilState -> Const Verbosity DrasilState
Lens' DrasilState SoftwareDossierInfo
softwareDossierInfo ((SoftwareDossierInfo -> Const Verbosity SoftwareDossierInfo)
 -> DrasilState -> Const Verbosity DrasilState)
-> ((Verbosity -> Const Verbosity Verbosity)
    -> SoftwareDossierInfo -> Const Verbosity SoftwareDossierInfo)
-> Getting Verbosity DrasilState Verbosity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Verbosity -> Const Verbosity Verbosity)
-> SoftwareDossierInfo -> Const Verbosity SoftwareDossierInfo
Lens' SoftwareDossierInfo Verbosity
doxOutput)

getSoftwareDossierFiles :: DrasilState -> [SoftwareDossierFile]
getSoftwareDossierFiles :: DrasilState -> [SoftwareDossierFile]
getSoftwareDossierFiles DrasilState
ds = DrasilState
ds DrasilState
-> Getting [SoftwareDossierFile] DrasilState [SoftwareDossierFile]
-> [SoftwareDossierFile]
forall s a. s -> Getting a s a -> a
^. ((SoftwareDossierInfo
 -> Const [SoftwareDossierFile] SoftwareDossierInfo)
-> DrasilState -> Const [SoftwareDossierFile] DrasilState
Lens' DrasilState SoftwareDossierInfo
softwareDossierInfo ((SoftwareDossierInfo
  -> Const [SoftwareDossierFile] SoftwareDossierInfo)
 -> DrasilState -> Const [SoftwareDossierFile] DrasilState)
-> (([SoftwareDossierFile]
     -> Const [SoftwareDossierFile] [SoftwareDossierFile])
    -> SoftwareDossierInfo
    -> Const [SoftwareDossierFile] SoftwareDossierInfo)
-> Getting [SoftwareDossierFile] DrasilState [SoftwareDossierFile]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SoftwareDossierFile]
 -> Const [SoftwareDossierFile] [SoftwareDossierFile])
-> SoftwareDossierInfo
-> Const [SoftwareDossierFile] SoftwareDossierInfo
Lens' SoftwareDossierInfo [SoftwareDossierFile]
softwareDossierFiles)

getSampleData :: DrasilState -> [Expr]
getSampleData :: DrasilState -> [Expr]
getSampleData DrasilState
ds = DrasilState
ds DrasilState -> Getting [Expr] DrasilState [Expr] -> [Expr]
forall s a. s -> Getting a s a -> a
^. ((SoftwareDossierInfo -> Const [Expr] SoftwareDossierInfo)
-> DrasilState -> Const [Expr] DrasilState
Lens' DrasilState SoftwareDossierInfo
softwareDossierInfo ((SoftwareDossierInfo -> Const [Expr] SoftwareDossierInfo)
 -> DrasilState -> Const [Expr] DrasilState)
-> (([Expr] -> Const [Expr] [Expr])
    -> SoftwareDossierInfo -> Const [Expr] SoftwareDossierInfo)
-> Getting [Expr] DrasilState [Expr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Expr] -> Const [Expr] [Expr])
-> SoftwareDossierInfo -> Const [Expr] SoftwareDossierInfo
Lens' SoftwareDossierInfo [Expr]
sampleData)

class HasChoices a where
  modular :: Lens' a Modularity
  implType :: Lens' a ImplementationType
  inStruct :: Lens' a Structure
  conStruct :: Lens' a ConstantStructure
  conRepr :: Lens' a ConstantRepr
  concMatches :: Lens' a MatchedConceptMap
  spaceMatches :: Lens' a MatchedSpaces
  onSfwrC :: Lens' a ConstraintBehaviour
  onPhysC :: Lens' a ConstraintBehaviour
  commented :: Lens' a [Comments]
  date :: Lens' a String
  logName :: Lens' a String
  logKind :: Lens' a [Logging]
  dsICNames :: Lens' a (InternalConcept -> Name)

instance HasChoices ChoicesInfo where
  modular :: Lens' ChoicesInfo Modularity
modular = (Modularity -> f Modularity) -> ChoicesInfo -> f ChoicesInfo
Lens' ChoicesInfo Modularity
getModular
  implType :: Lens' ChoicesInfo ImplementationType
implType = (ImplementationType -> f ImplementationType)
-> ChoicesInfo -> f ChoicesInfo
Lens' ChoicesInfo ImplementationType
getImplType
  inStruct :: Lens' ChoicesInfo Structure
inStruct = (Structure -> f Structure) -> ChoicesInfo -> f ChoicesInfo
Lens' ChoicesInfo Structure
getInStruct
  conStruct :: Lens' ChoicesInfo ConstantStructure
conStruct = (ConstantStructure -> f ConstantStructure)
-> ChoicesInfo -> f ChoicesInfo
Lens' ChoicesInfo ConstantStructure
getConStruct
  conRepr :: Lens' ChoicesInfo ConstantRepr
conRepr = (ConstantRepr -> f ConstantRepr) -> ChoicesInfo -> f ChoicesInfo
Lens' ChoicesInfo ConstantRepr
getConRepr
  concMatches :: Lens' ChoicesInfo MatchedConceptMap
concMatches = (MatchedConceptMap -> f MatchedConceptMap)
-> ChoicesInfo -> f ChoicesInfo
Lens' ChoicesInfo MatchedConceptMap
getConcMatches
  spaceMatches :: Lens' ChoicesInfo MatchedSpaces
spaceMatches = (MatchedSpaces -> f MatchedSpaces) -> ChoicesInfo -> f ChoicesInfo
Lens' ChoicesInfo MatchedSpaces
getSpaceMatches
  onSfwrC :: Lens' ChoicesInfo ConstraintBehaviour
onSfwrC = (ConstraintBehaviour -> f ConstraintBehaviour)
-> ChoicesInfo -> f ChoicesInfo
Lens' ChoicesInfo ConstraintBehaviour
getOnSfwrC
  onPhysC :: Lens' ChoicesInfo ConstraintBehaviour
onPhysC = (ConstraintBehaviour -> f ConstraintBehaviour)
-> ChoicesInfo -> f ChoicesInfo
Lens' ChoicesInfo ConstraintBehaviour
getOnPhysC
  commented :: Lens' ChoicesInfo [Comments]
commented = ([Comments] -> f [Comments]) -> ChoicesInfo -> f ChoicesInfo
Lens' ChoicesInfo [Comments]
getCommented
  date :: Lens' ChoicesInfo Name
date = (Name -> f Name) -> ChoicesInfo -> f ChoicesInfo
Lens' ChoicesInfo Name
getDate
  logName :: Lens' ChoicesInfo Name
logName = (Name -> f Name) -> ChoicesInfo -> f ChoicesInfo
Lens' ChoicesInfo Name
getLogName
  logKind :: Lens' ChoicesInfo [Logging]
logKind = ([Logging] -> f [Logging]) -> ChoicesInfo -> f ChoicesInfo
Lens' ChoicesInfo [Logging]
getLogKind
  dsICNames :: Lens' ChoicesInfo (InternalConcept -> Name)
dsICNames = ((InternalConcept -> Name) -> f (InternalConcept -> Name))
-> ChoicesInfo -> f ChoicesInfo
Lens' ChoicesInfo (InternalConcept -> Name)
getDsICNames

instance HasChoices DrasilState where
  modular :: Lens' DrasilState Modularity
modular = (ChoicesInfo -> f ChoicesInfo) -> DrasilState -> f DrasilState
Lens' DrasilState ChoicesInfo
choices ((ChoicesInfo -> f ChoicesInfo) -> DrasilState -> f DrasilState)
-> ((Modularity -> f Modularity) -> ChoicesInfo -> f ChoicesInfo)
-> (Modularity -> f Modularity)
-> DrasilState
-> f DrasilState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Modularity -> f Modularity) -> ChoicesInfo -> f ChoicesInfo
forall a. HasChoices a => Lens' a Modularity
Lens' ChoicesInfo Modularity
modular
  implType :: Lens' DrasilState ImplementationType
implType = (ChoicesInfo -> f ChoicesInfo) -> DrasilState -> f DrasilState
Lens' DrasilState ChoicesInfo
choices ((ChoicesInfo -> f ChoicesInfo) -> DrasilState -> f DrasilState)
-> ((ImplementationType -> f ImplementationType)
    -> ChoicesInfo -> f ChoicesInfo)
-> (ImplementationType -> f ImplementationType)
-> DrasilState
-> f DrasilState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ImplementationType -> f ImplementationType)
-> ChoicesInfo -> f ChoicesInfo
forall a. HasChoices a => Lens' a ImplementationType
Lens' ChoicesInfo ImplementationType
implType
  inStruct :: Lens' DrasilState Structure
inStruct = (ChoicesInfo -> f ChoicesInfo) -> DrasilState -> f DrasilState
Lens' DrasilState ChoicesInfo
choices ((ChoicesInfo -> f ChoicesInfo) -> DrasilState -> f DrasilState)
-> ((Structure -> f Structure) -> ChoicesInfo -> f ChoicesInfo)
-> (Structure -> f Structure)
-> DrasilState
-> f DrasilState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Structure -> f Structure) -> ChoicesInfo -> f ChoicesInfo
forall a. HasChoices a => Lens' a Structure
Lens' ChoicesInfo Structure
inStruct
  conStruct :: Lens' DrasilState ConstantStructure
conStruct = (ChoicesInfo -> f ChoicesInfo) -> DrasilState -> f DrasilState
Lens' DrasilState ChoicesInfo
choices ((ChoicesInfo -> f ChoicesInfo) -> DrasilState -> f DrasilState)
-> ((ConstantStructure -> f ConstantStructure)
    -> ChoicesInfo -> f ChoicesInfo)
-> (ConstantStructure -> f ConstantStructure)
-> DrasilState
-> f DrasilState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConstantStructure -> f ConstantStructure)
-> ChoicesInfo -> f ChoicesInfo
forall a. HasChoices a => Lens' a ConstantStructure
Lens' ChoicesInfo ConstantStructure
conStruct
  conRepr :: Lens' DrasilState ConstantRepr
conRepr = (ChoicesInfo -> f ChoicesInfo) -> DrasilState -> f DrasilState
Lens' DrasilState ChoicesInfo
choices ((ChoicesInfo -> f ChoicesInfo) -> DrasilState -> f DrasilState)
-> ((ConstantRepr -> f ConstantRepr)
    -> ChoicesInfo -> f ChoicesInfo)
-> (ConstantRepr -> f ConstantRepr)
-> DrasilState
-> f DrasilState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConstantRepr -> f ConstantRepr) -> ChoicesInfo -> f ChoicesInfo
forall a. HasChoices a => Lens' a ConstantRepr
Lens' ChoicesInfo ConstantRepr
conRepr
  concMatches :: Lens' DrasilState MatchedConceptMap
concMatches = (ChoicesInfo -> f ChoicesInfo) -> DrasilState -> f DrasilState
Lens' DrasilState ChoicesInfo
choices ((ChoicesInfo -> f ChoicesInfo) -> DrasilState -> f DrasilState)
-> ((MatchedConceptMap -> f MatchedConceptMap)
    -> ChoicesInfo -> f ChoicesInfo)
-> (MatchedConceptMap -> f MatchedConceptMap)
-> DrasilState
-> f DrasilState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MatchedConceptMap -> f MatchedConceptMap)
-> ChoicesInfo -> f ChoicesInfo
forall a. HasChoices a => Lens' a MatchedConceptMap
Lens' ChoicesInfo MatchedConceptMap
concMatches
  spaceMatches :: Lens' DrasilState MatchedSpaces
spaceMatches = (ChoicesInfo -> f ChoicesInfo) -> DrasilState -> f DrasilState
Lens' DrasilState ChoicesInfo
choices ((ChoicesInfo -> f ChoicesInfo) -> DrasilState -> f DrasilState)
-> ((MatchedSpaces -> f MatchedSpaces)
    -> ChoicesInfo -> f ChoicesInfo)
-> (MatchedSpaces -> f MatchedSpaces)
-> DrasilState
-> f DrasilState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MatchedSpaces -> f MatchedSpaces) -> ChoicesInfo -> f ChoicesInfo
forall a. HasChoices a => Lens' a MatchedSpaces
Lens' ChoicesInfo MatchedSpaces
spaceMatches
  onSfwrC :: Lens' DrasilState ConstraintBehaviour
onSfwrC = (ChoicesInfo -> f ChoicesInfo) -> DrasilState -> f DrasilState
Lens' DrasilState ChoicesInfo
choices ((ChoicesInfo -> f ChoicesInfo) -> DrasilState -> f DrasilState)
-> ((ConstraintBehaviour -> f ConstraintBehaviour)
    -> ChoicesInfo -> f ChoicesInfo)
-> (ConstraintBehaviour -> f ConstraintBehaviour)
-> DrasilState
-> f DrasilState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConstraintBehaviour -> f ConstraintBehaviour)
-> ChoicesInfo -> f ChoicesInfo
forall a. HasChoices a => Lens' a ConstraintBehaviour
Lens' ChoicesInfo ConstraintBehaviour
onSfwrC
  onPhysC :: Lens' DrasilState ConstraintBehaviour
onPhysC = (ChoicesInfo -> f ChoicesInfo) -> DrasilState -> f DrasilState
Lens' DrasilState ChoicesInfo
choices ((ChoicesInfo -> f ChoicesInfo) -> DrasilState -> f DrasilState)
-> ((ConstraintBehaviour -> f ConstraintBehaviour)
    -> ChoicesInfo -> f ChoicesInfo)
-> (ConstraintBehaviour -> f ConstraintBehaviour)
-> DrasilState
-> f DrasilState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConstraintBehaviour -> f ConstraintBehaviour)
-> ChoicesInfo -> f ChoicesInfo
forall a. HasChoices a => Lens' a ConstraintBehaviour
Lens' ChoicesInfo ConstraintBehaviour
onPhysC
  commented :: Lens' DrasilState [Comments]
commented = (ChoicesInfo -> f ChoicesInfo) -> DrasilState -> f DrasilState
Lens' DrasilState ChoicesInfo
choices ((ChoicesInfo -> f ChoicesInfo) -> DrasilState -> f DrasilState)
-> (([Comments] -> f [Comments]) -> ChoicesInfo -> f ChoicesInfo)
-> ([Comments] -> f [Comments])
-> DrasilState
-> f DrasilState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Comments] -> f [Comments]) -> ChoicesInfo -> f ChoicesInfo
forall a. HasChoices a => Lens' a [Comments]
Lens' ChoicesInfo [Comments]
commented
  date :: Lens' DrasilState Name
date = (ChoicesInfo -> f ChoicesInfo) -> DrasilState -> f DrasilState
Lens' DrasilState ChoicesInfo
choices ((ChoicesInfo -> f ChoicesInfo) -> DrasilState -> f DrasilState)
-> ((Name -> f Name) -> ChoicesInfo -> f ChoicesInfo)
-> (Name -> f Name)
-> DrasilState
-> f DrasilState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> f Name) -> ChoicesInfo -> f ChoicesInfo
forall a. HasChoices a => Lens' a Name
Lens' ChoicesInfo Name
date
  logName :: Lens' DrasilState Name
logName = (ChoicesInfo -> f ChoicesInfo) -> DrasilState -> f DrasilState
Lens' DrasilState ChoicesInfo
choices ((ChoicesInfo -> f ChoicesInfo) -> DrasilState -> f DrasilState)
-> ((Name -> f Name) -> ChoicesInfo -> f ChoicesInfo)
-> (Name -> f Name)
-> DrasilState
-> f DrasilState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> f Name) -> ChoicesInfo -> f ChoicesInfo
forall a. HasChoices a => Lens' a Name
Lens' ChoicesInfo Name
logName
  logKind :: Lens' DrasilState [Logging]
logKind = (ChoicesInfo -> f ChoicesInfo) -> DrasilState -> f DrasilState
Lens' DrasilState ChoicesInfo
choices ((ChoicesInfo -> f ChoicesInfo) -> DrasilState -> f DrasilState)
-> (([Logging] -> f [Logging]) -> ChoicesInfo -> f ChoicesInfo)
-> ([Logging] -> f [Logging])
-> DrasilState
-> f DrasilState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Logging] -> f [Logging]) -> ChoicesInfo -> f ChoicesInfo
forall a. HasChoices a => Lens' a [Logging]
Lens' ChoicesInfo [Logging]
logKind
  dsICNames :: Lens' DrasilState (InternalConcept -> Name)
dsICNames = (ChoicesInfo -> f ChoicesInfo) -> DrasilState -> f DrasilState
Lens' DrasilState ChoicesInfo
choices ((ChoicesInfo -> f ChoicesInfo) -> DrasilState -> f DrasilState)
-> (((InternalConcept -> Name) -> f (InternalConcept -> Name))
    -> ChoicesInfo -> f ChoicesInfo)
-> ((InternalConcept -> Name) -> f (InternalConcept -> Name))
-> DrasilState
-> f DrasilState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((InternalConcept -> Name) -> f (InternalConcept -> Name))
-> ChoicesInfo -> f ChoicesInfo
forall a. HasChoices a => Lens' a (InternalConcept -> Name)
Lens' ChoicesInfo (InternalConcept -> Name)
dsICNames

-- | 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 -> Name
_pName = Name
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 = [(Name, Name)] -> ModExportMap
forall k a. Ord k => [(k, a)] -> Map k a
fromList ([(Name, Name)] -> ModExportMap) -> [(Name, Name)] -> ModExportMap
forall a b. (a -> b) -> a -> b
$ [(Name, Name)] -> [(Name, Name)]
forall a. Ord a => [a] -> [a]
nubOrd ([(Name, Name)] -> [(Name, Name)])
-> [(Name, Name)] -> [(Name, Name)]
forall a b. (a -> b) -> a -> b
$ (Mod -> [(Name, Name)]) -> [Mod] -> [(Name, Name)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Mod -> [(Name, Name)]
mpair [Mod]
ms
    [(Name, Name)] -> [(Name, Name)] -> [(Name, Name)]
forall a. [a] -> [a] -> [a]
++ Name -> Choices -> [Input] -> [(Name, Name)]
getExpInput Name
prn Choices
chs [Input]
ins
    [(Name, Name)] -> [(Name, Name)] -> [(Name, Name)]
forall a. [a] -> [a] -> [a]
++ Name -> Choices -> [Def] -> [(Name, Name)]
getExpConstants Name
prn Choices
chs [Def]
cns
    [(Name, Name)] -> [(Name, Name)] -> [(Name, Name)]
forall a. [a] -> [a] -> [a]
++ Name -> Choices -> [Def] -> [(Name, Name)]
getExpDerived Name
prn Choices
chs [Def]
ds
    [(Name, Name)] -> [(Name, Name)] -> [(Name, Name)]
forall a. [a] -> [a] -> [a]
++ Name -> Choices -> [ConstraintCE] -> [(Name, Name)]
getExpConstraints Name
prn Choices
chs (ConstraintCEMap -> [Input] -> [ConstraintCE]
forall c. HasUID c => ConstraintCEMap -> [c] -> [ConstraintCE]
getConstraints (OldCodeSpec -> ConstraintCEMap
_cMap OldCodeSpec
cs) [Input]
ins)
    [(Name, Name)] -> [(Name, Name)] -> [(Name, Name)]
forall a. [a] -> [a] -> [a]
++ Name -> Choices -> [Input] -> [(Name, Name)]
getExpInputFormat Name
prn Choices
chs [Input]
extIns
    [(Name, Name)] -> [(Name, Name)] -> [(Name, Name)]
forall a. [a] -> [a] -> [a]
++ Name -> Choices -> [Def] -> [(Name, Name)]
getExpCalcs Name
prn Choices
chs (OldCodeSpec -> [Def]
_execOrder OldCodeSpec
cs)
    [(Name, Name)] -> [(Name, Name)] -> [(Name, Name)]
forall a. [a] -> [a] -> [a]
++ Name -> Choices -> [Input] -> [(Name, Name)]
getExpOutput Name
prn Choices
chs (OldCodeSpec -> [Input]
_outputs OldCodeSpec
cs)
  where mpair :: Mod -> [(Name, Name)]
mpair (Mod Name
n Name
_ [Name]
_ [Class]
cls [Func]
fs) = (Name -> (Name, Name)) -> [Name] -> [(Name, Name)]
forall a b. (a -> b) -> [a] -> [b]
map
          (, Modularity -> Name -> Name
defModName (Architecture -> Modularity
modularity Architecture
m) Name
n)
          ((Class -> Name) -> [Class] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Class -> Name
className [Class]
cls
            [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ (Class -> [Name]) -> [Class] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((StateVariable -> Name) -> [StateVariable] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Input -> Name
forall c. CodeIdea c => c -> Name
codeName (Input -> Name)
-> (StateVariable -> Input) -> StateVariable -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateVariable -> Input
stVar) ([StateVariable] -> [Name])
-> (Class -> [StateVariable]) -> Class -> [Name]
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
            [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ (Func -> Name) -> [Func] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Func -> Name
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 -> Name -> Name
defModName Modularity
Unmodular Name
_ = Name
prn
        defModName Modularity
_ Name
nm = Name
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 = [(Name, Name)] -> ModExportMap
forall k a. Ord k => [(k, a)] -> Map k a
fromList ([(Name, Name)] -> ModExportMap) -> [(Name, Name)] -> ModExportMap
forall a b. (a -> b) -> a -> b
$ [(Name, Name)] -> [(Name, Name)]
forall a. Eq a => [a] -> [a]
nub ([(Name, Name)] -> [(Name, Name)])
-> [(Name, Name)] -> [(Name, Name)]
forall a b. (a -> b) -> a -> b
$ (Mod -> [(Name, Name)]) -> [Mod] -> [(Name, Name)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Mod -> [(Name, Name)]
modClasses [Mod]
ms
    [(Name, Name)] -> [(Name, Name)] -> [(Name, Name)]
forall a. [a] -> [a] -> [a]
++ Choices -> [Input] -> [(Name, Name)]
getInputCls Choices
chs [Input]
ins
    [(Name, Name)] -> [(Name, Name)] -> [(Name, Name)]
forall a. [a] -> [a] -> [a]
++ Choices -> [Def] -> [(Name, Name)]
getConstantsCls Choices
chs [Def]
cns
    [(Name, Name)] -> [(Name, Name)] -> [(Name, Name)]
forall a. [a] -> [a] -> [a]
++ Choices -> [Def] -> [(Name, Name)]
getDerivedCls Choices
chs [Def]
ds
    [(Name, Name)] -> [(Name, Name)] -> [(Name, Name)]
forall a. [a] -> [a] -> [a]
++ Choices -> [ConstraintCE] -> [(Name, Name)]
getConstraintsCls Choices
chs (ConstraintCEMap -> [Input] -> [ConstraintCE]
forall c. HasUID c => ConstraintCEMap -> [c] -> [ConstraintCE]
getConstraints (OldCodeSpec -> ConstraintCEMap
_cMap OldCodeSpec
cs) [Input]
ins)
    [(Name, Name)] -> [(Name, Name)] -> [(Name, Name)]
forall a. [a] -> [a] -> [a]
++ Choices -> [Input] -> [(Name, Name)]
getInputFormatCls Choices
chs [Input]
extIns
    where modClasses :: Mod -> [(Name, Name)]
modClasses (Mod Name
_ Name
_ [Name]
_ [Class]
cls [Func]
_) = (Class -> [(Name, Name)]) -> [Class] -> [(Name, Name)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Class
cl ->
            let cln :: Name
cln = Class -> Name
className Class
cl in
            (Name
cln, Name
cln) (Name, Name) -> [(Name, Name)] -> [(Name, Name)]
forall a. a -> [a] -> [a]
: (StateVariable -> (Name, Name))
-> [StateVariable] -> [(Name, Name)]
forall a b. (a -> b) -> [a] -> [b]
map (\StateVariable
sv -> (Input -> Name
forall c. CodeIdea c => c -> Name
codeName (StateVariable -> Input
stVar StateVariable
sv), Name
cln)) (Class -> [StateVariable]
stateVars Class
cl)
              [(Name, Name)] -> [(Name, Name)] -> [(Name, Name)]
forall a. [a] -> [a] -> [a]
++ (Func -> (Name, Name)) -> [Func] -> [(Name, Name)]
forall a b. (a -> b) -> [a] -> [b]
map (\Func
m -> (Func -> Name
fname Func
m, Name
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 :: Name -> Choices -> [Input] -> [(Name, Name)]
getExpInput Name
_ Choices
_ [] = []
getExpInput Name
prn Choices
chs [Input]
ins = Modularity -> Structure -> [(Name, Name)]
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 -> [(Name, Name)]
inExp Modularity
_ Structure
Unbundled = []
        inExp Modularity
Unmodular Structure
Bundled = (Name
ipName, Name
prn) (Name, Name) -> [(Name, Name)] -> [(Name, Name)]
forall a. a -> [a] -> [a]
: Name -> [(Name, Name)]
forall {t}. t -> [(Name, t)]
inVarDefs Name
prn
        inExp Modularity
Modular Structure
Bundled = (Name
ipName , Name
ipName) (Name, Name) -> [(Name, Name)] -> [(Name, Name)]
forall a. a -> [a] -> [a]
: Name -> [(Name, Name)]
forall {t}. t -> [(Name, t)]
inVarDefs Name
ipName
        inVarDefs :: t -> [(Name, t)]
inVarDefs t
n = (Input -> (Name, t)) -> [Input] -> [(Name, t)]
forall a b. (a -> b) -> [a] -> [b]
map ((, t
n) (Name -> (Name, t)) -> (Input -> Name) -> Input -> (Name, t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input -> Name
forall c. CodeIdea c => c -> Name
codeName) [Input]
ins
        ipName :: Name
ipName = Choices -> InternalConcept -> Name
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] -> [(Name, Name)]
getInputCls Choices
_ [] = []
getInputCls Choices
chs [Input]
ins = Structure -> [(Name, Name)]
inCls (DataInfo -> Structure
inputStructure (DataInfo -> Structure) -> DataInfo -> Structure
forall a b. (a -> b) -> a -> b
$ Choices -> DataInfo
dataInfo Choices
chs)
  where inCls :: Structure -> [(Name, Name)]
inCls Structure
Unbundled = []
        inCls Structure
Bundled = (Name
ipName, Name
ipName) (Name, Name) -> [(Name, Name)] -> [(Name, Name)]
forall a. a -> [a] -> [a]
: [(Name, Name)]
inVarDefs
        inVarDefs :: [(Name, Name)]
inVarDefs = (Input -> (Name, Name)) -> [Input] -> [(Name, Name)]
forall a b. (a -> b) -> [a] -> [b]
map ((, Name
ipName) (Name -> (Name, Name)) -> (Input -> Name) -> Input -> (Name, Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input -> Name
forall c. CodeIdea c => c -> Name
codeName) [Input]
ins
        ipName :: Name
ipName = Choices -> InternalConcept -> Name
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 :: Name -> Choices -> [Def] -> [(Name, Name)]
getExpConstants Name
_ Choices
_ [] = []
getExpConstants Name
n Choices
chs [Def]
cs = Modularity -> ConstantStructure -> Structure -> [(Name, Name)]
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 -> [(Name, Name)]
cExp Modularity
Unmodular (Store Structure
Bundled) Structure
_ = [Name] -> [(Name, Name)]
forall {b}. [b] -> [(Name, b)]
zipCs ([Name] -> [(Name, Name)]) -> [Name] -> [(Name, Name)]
forall a b. (a -> b) -> a -> b
$ Name -> [Name]
forall a. a -> [a]
repeat Name
n
        cExp Modularity
Unmodular ConstantStructure
WithInputs Structure
Bundled = [Name] -> [(Name, Name)]
forall {b}. [b] -> [(Name, b)]
zipCs ([Name] -> [(Name, Name)]) -> [Name] -> [(Name, Name)]
forall a b. (a -> b) -> a -> b
$ Name -> [Name]
forall a. a -> [a]
repeat Name
n
        cExp Modularity
_ (Store Structure
Bundled) Structure
_ = [Name] -> [(Name, Name)]
forall {b}. [b] -> [(Name, b)]
zipCs ([Name] -> [(Name, Name)]) -> [Name] -> [(Name, Name)]
forall a b. (a -> b) -> a -> b
$ Name -> [Name]
forall a. a -> [a]
repeat (Choices -> InternalConcept -> Name
icNames Choices
chs InternalConcept
Constants)
        cExp Modularity
_ ConstantStructure
WithInputs Structure
Bundled = [Name] -> [(Name, Name)]
forall {b}. [b] -> [(Name, b)]
zipCs ([Name] -> [(Name, Name)]) -> [Name] -> [(Name, Name)]
forall a b. (a -> b) -> a -> b
$ Name -> [Name]
forall a. a -> [a]
repeat (Choices -> InternalConcept -> Name
icNames Choices
chs InternalConcept
InputParameters)
        cExp Modularity
_ ConstantStructure
_ Structure
_ = []
        zipCs :: [b] -> [(Name, b)]
zipCs = [Name] -> [b] -> [(Name, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Def -> Name) -> [Def] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Def -> Name
forall c. CodeIdea c => c -> Name
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] -> [(Name, Name)]
getConstantsCls Choices
_ [] = []
getConstantsCls Choices
chs [Def]
cs = ConstantStructure -> Structure -> [(Name, Name)]
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 -> [(Name, Name)]
cnCls (Store Structure
Bundled) Structure
_ = InternalConcept -> [(Name, Name)]
zipCs InternalConcept
Constants
        cnCls ConstantStructure
WithInputs Structure
Bundled = InternalConcept -> [(Name, Name)]
zipCs InternalConcept
InputParameters
        cnCls ConstantStructure
_ Structure
_ = []
        zipCs :: InternalConcept -> [(Name, Name)]
zipCs InternalConcept
ic = (Def -> (Name, Name)) -> [Def] -> [(Name, Name)]
forall a b. (a -> b) -> [a] -> [b]
map ((, Choices -> InternalConcept -> Name
icNames Choices
chs InternalConcept
ic) (Name -> (Name, Name)) -> (Def -> Name) -> Def -> (Name, Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Def -> Name
forall c. CodeIdea c => c -> Name
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 :: Name -> Choices -> [Def] -> [(Name, Name)]
getExpDerived Name
_ Choices
_ [] = []
getExpDerived Name
n Choices
chs [Def]
_ = Modularity -> Structure -> [(Name, Name)]
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 -> [(Name, Name)]
dMod Modularity
_ Structure
Bundled = []
        dMod Modularity
Unmodular Structure
_ = [(Name
dvNm, Name
n)]
        dMod Modularity
Modular Structure
_ = [(Name
dvNm, Choices -> InternalConcept -> Name
icNames Choices
chs InternalConcept
InputParameters)]
        dvNm :: Name
dvNm = Choices -> InternalConcept -> Name
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] -> [(Name, Name)]
getDerivedCls Choices
_ [] = []
getDerivedCls Choices
chs [Def]
_ = Structure -> [(Name, Name)]
dCls (DataInfo -> Structure
inputStructure (DataInfo -> Structure) -> DataInfo -> Structure
forall a b. (a -> b) -> a -> b
$ Choices -> DataInfo
dataInfo Choices
chs)
  where dCls :: Structure -> [(Name, Name)]
dCls Structure
Bundled = [(Choices -> InternalConcept -> Name
icNames Choices
chs InternalConcept
DerivedValuesFn, Choices -> InternalConcept -> Name
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 :: Name -> Choices -> [ConstraintCE] -> [(Name, Name)]
getExpConstraints Name
_ Choices
_ [] = []
getExpConstraints Name
n Choices
chs [ConstraintCE]
_ = Modularity -> Structure -> [(Name, Name)]
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 -> [(Name, Name)]
cMod Modularity
_ Structure
Bundled = []
        cMod Modularity
Unmodular Structure
_ = [(Name
icNm, Name
n)]
        cMod Modularity
Modular Structure
_ = [(Name
icNm, Choices -> InternalConcept -> Name
icNames Choices
chs InternalConcept
InputParameters)]
        icNm :: Name
icNm =  Choices -> InternalConcept -> Name
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] -> [(Name, Name)]
getConstraintsCls Choices
_   [] = []
getConstraintsCls Choices
chs [ConstraintCE]
_  = Structure -> [(Name, Name)]
cCls (DataInfo -> Structure
inputStructure (DataInfo -> Structure) -> DataInfo -> Structure
forall a b. (a -> b) -> a -> b
$ Choices -> DataInfo
dataInfo Choices
chs)
  where cCls :: Structure -> [(Name, Name)]
cCls Structure
Bundled = [(Choices -> InternalConcept -> Name
icNames Choices
chs InternalConcept
InputConstraintsFn, Choices -> InternalConcept -> Name
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 :: Name -> Choices -> [Input] -> [(Name, Name)]
getExpInputFormat Name
_ Choices
_ [] = []
getExpInputFormat Name
n Choices
chs [Input]
_ = Modularity -> Structure -> [(Name, Name)]
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 -> [(Name, Name)]
fMod Modularity
_ Structure
Bundled = []
        fMod Modularity
Unmodular Structure
_ = [(Name
giNm, Name
n)]
        fMod Modularity
Modular Structure
_ = [(Name
giNm, Choices -> InternalConcept -> Name
icNames Choices
chs InternalConcept
InputParameters)]
        giNm :: Name
giNm = Choices -> InternalConcept -> Name
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] -> [(Name, Name)]
getInputFormatCls Choices
_ [] = []
getInputFormatCls Choices
chs [Input]
_ = Structure -> [(Name, Name)]
ifCls (DataInfo -> Structure
inputStructure (DataInfo -> Structure) -> DataInfo -> Structure
forall a b. (a -> b) -> a -> b
$ Choices -> DataInfo
dataInfo Choices
chs)
  where ifCls :: Structure -> [(Name, Name)]
ifCls Structure
Bundled = [(Choices -> InternalConcept -> Name
icNames Choices
chs InternalConcept
GetInput, Choices -> InternalConcept -> Name
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 :: Name -> Choices -> [Def] -> [(Name, Name)]
getExpCalcs Name
n Choices
chs = (Def -> (Name, Name)) -> [Def] -> [(Name, Name)]
forall a b. (a -> b) -> [a] -> [b]
map (\Def
d -> (Def -> Name
forall c. CodeIdea c => c -> Name
codeName Def
d, Name
calMod))
  where calMod :: Name
calMod = Modularity -> Name
cMod (Modularity -> Name) -> Modularity -> Name
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 -> Name
cMod Modularity
Unmodular = Name
n
        cMod Modularity
_ = Choices -> InternalConcept -> Name
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 :: Name -> Choices -> [Input] -> [(Name, Name)]
getExpOutput Name
_ Choices
_ [] = []
getExpOutput Name
n Choices
chs [Input]
_ = [(Choices -> InternalConcept -> Name
icNames Choices
chs InternalConcept
WriteOutput, Modularity -> Name
oMod (Modularity -> Name) -> Modularity -> Name
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 -> Name
oMod Modularity
Unmodular = Name
n
        oMod Modularity
_ = Choices -> InternalConcept -> Name
icNames Choices
chs InternalConcept
OutputFormat

-- | Get InternalConcept name using DrasilState
genICName :: InternalConcept -> GenState Name
genICName :: InternalConcept -> GenState Name
genICName InternalConcept
ic = do
  DrasilState
ds <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  Name -> GenState Name
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> GenState Name) -> Name -> GenState Name
forall a b. (a -> b) -> a -> b
$ (DrasilState
ds DrasilState
-> Getting
     (InternalConcept -> Name) DrasilState (InternalConcept -> Name)
-> InternalConcept
-> Name
forall s a. s -> Getting a s a -> a
^. Getting
  (InternalConcept -> Name) DrasilState (InternalConcept -> Name)
forall a. HasChoices a => Lens' a (InternalConcept -> Name)
Lens' DrasilState (InternalConcept -> Name)
dsICNames) InternalConcept
ic

-- | Gets the 'DefinedQuantityDict' corresponding to a 'UID'.
lookupC :: DrasilState -> UID -> DefinedQuantityDict
lookupC :: DrasilState -> UID -> DefinedQuantityDict
lookupC DrasilState
g UID
u = UID -> ChunkDB -> DefinedQuantityDict
forall a. Typeable a => UID -> ChunkDB -> a
findOrErr UID
u (DrasilState -> CodeSpec
codeSpec DrasilState
g CodeSpec -> Getting ChunkDB CodeSpec ChunkDB -> ChunkDB
forall s a. s -> Getting a s a -> a
^. Getting ChunkDB CodeSpec ChunkDB
forall c. HasOldCodeSpec c => Lens' c ChunkDB
Lens' CodeSpec ChunkDB
systemdbO)