{-# LANGUAGE GADTs #-}
-- | Defines the CodeSpec structure and related functions.
module Language.Drasil.CodeSpec where

import Language.Drasil hiding (None, new)
import Language.Drasil.Development (showUID)
import Language.Drasil.Display (Symbol(Variable))
import Database.Drasil
import SysInfo.Drasil hiding (sysinfodb)
import Theory.Drasil (DataDefinition, qdEFromDD, getEqModQdsFromIm)

import Language.Drasil.Chunk.ConstraintMap (ConstraintCEMap, ConstraintCE, constraintMap)
import Language.Drasil.Chunk.CodeDefinition (CodeDefinition, qtov, qtoc, odeDef,
  auxExprs)
import Language.Drasil.Choices (Choices(..), Maps(..), ODE(..), ExtLib(..))
import Language.Drasil.CodeExpr.Development (expr, eNamesRI)
import Language.Drasil.Chunk.CodeBase
import Language.Drasil.Mod (Func(..), FuncData(..), FuncDef(..), Mod(..), Name)

import Utils.Drasil (subsetOf)

import Control.Lens ((^.))
import Data.List (intercalate, nub, (\\))
import qualified Data.Map as Map
import Data.Maybe (mapMaybe)

import Prelude hiding (const)

-- | Program input.
type Input = CodeVarChunk
-- | Program output.
type Output = CodeVarChunk
-- | Constants in the problem.
type Const = CodeDefinition
-- | Derived inputs.
type Derived = CodeDefinition
-- | Mathematical definition.
type Def = CodeDefinition

-- | Code specifications. Holds information needed to generate code.
data CodeSpec where
  CodeSpec :: (HasName a) => {
  -- | Program name.
  CodeSpec -> Name
pName :: Name,
  -- | Authors.
  ()
authors :: [a],
  -- | Purpose.
  CodeSpec -> Purpose
purpose :: Purpose,
  -- | Example Background.
  CodeSpec -> Purpose
background :: Background,
  -- | All inputs.
  CodeSpec -> [CodeVarChunk]
inputs :: [Input],
  -- | Explicit inputs (values to be supplied by a file).
  CodeSpec -> [CodeVarChunk]
extInputs :: [Input],
  -- | Derived inputs (each calculated from explicit inputs in a single step).
  CodeSpec -> [CodeDefinition]
derivedInputs :: [Derived],
  -- | All outputs.
  CodeSpec -> [CodeVarChunk]
outputs :: [Output],
  -- | List of files that must be in same directory for running the executable.
  CodeSpec -> [Name]
configFiles :: [FilePath],
  -- | Mathematical definitions, ordered so that they form a path from inputs to
  -- outputs.
  CodeSpec -> [CodeDefinition]
execOrder :: [Def],
  -- | Map from 'UID's to constraints for all constrained chunks used in the problem.
  CodeSpec -> ConstraintCEMap
cMap :: ConstraintCEMap,
  -- | List of all constants used in the problem.
  CodeSpec -> [CodeDefinition]
constants :: [Const],
  -- | Map containing all constants used in the problem.
  CodeSpec -> ConstantMap
constMap :: ConstantMap,
  -- | Additional modules required in the generated code, which Drasil cannot yet
  -- automatically define.
  CodeSpec -> [Mod]
mods :: [Mod],  -- medium hack
  -- | The database of all chunks used in the problem.
  CodeSpec -> ChunkDB
sysinfodb :: ChunkDB
  } -> CodeSpec

-- | Maps constants to their respective 'CodeDefinition'.
type ConstantMap = Map.Map UID CodeDefinition

-- | Converts a list of chunks that have 'UID's to a Map from 'UID' to the associated chunk.
assocToMap :: HasUID a => [a] -> Map.Map UID a
assocToMap :: forall a. HasUID a => [a] -> Map UID a
assocToMap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> (a
x forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid, a
x))

-- | Get ODE from ExtLib
getODE :: [ExtLib] -> Maybe ODE
getODE :: [ExtLib] -> Maybe ODE
getODE [] = forall a. Maybe a
Nothing
getODE (Math ODE
ode: [ExtLib]
_) = forall a. a -> Maybe a
Just ODE
ode
-- getODE (_:xs) = getODE xs

-- | Maps ODE to their respective 'CodeDefinition'.
mapODE :: Maybe ODE -> [CodeDefinition]
mapODE :: Maybe ODE -> [CodeDefinition]
mapODE Maybe ODE
Nothing = []
mapODE (Just ODE
ode) = forall a b. (a -> b) -> [a] -> [b]
map ODEInfo -> CodeDefinition
odeDef forall a b. (a -> b) -> a -> b
$ ODE -> [ODEInfo]
odeInfo ODE
ode

-- | Defines a 'CodeSpec' based on the 'SystemInformation', 'Choices', and 'Mod's
-- defined by the user.
codeSpec :: SystemInformation -> Choices -> [Mod] -> CodeSpec
codeSpec :: SystemInformation -> Choices -> [Mod] -> CodeSpec
codeSpec SI {_sys :: ()
_sys         = a
sys
           , _authors :: ()
_authors     = [c]
as
           , _purpose :: SystemInformation -> Purpose
_purpose     = Purpose
ps
           , _background :: SystemInformation -> Purpose
_background  = Purpose
bk
           , _instModels :: SystemInformation -> [InstanceModel]
_instModels  = [InstanceModel]
ims
           , _datadefs :: SystemInformation -> [DataDefinition]
_datadefs    = [DataDefinition]
ddefs
           , _configFiles :: SystemInformation -> [Name]
_configFiles = [Name]
cfp
           , _inputs :: ()
_inputs      = [h]
ins
           , _outputs :: ()
_outputs     = [i]
outs
           , _constraints :: ()
_constraints = [j]
cs
           , _constants :: SystemInformation -> [QDefinition Literal]
_constants   = [QDefinition Literal]
cnsts
           , _sysinfodb :: SystemInformation -> ChunkDB
_sysinfodb   = ChunkDB
db} Choices
chs [Mod]
ms =
  let n :: Name
n = forall c. CommonIdea c => c -> Name
programName a
sys
      inputs' :: [CodeVarChunk]
inputs' = forall a b. (a -> b) -> [a] -> [b]
map forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar [h]
ins
      const' :: [CodeDefinition]
const' = forall a b. (a -> b) -> [a] -> [b]
map forall e. CanGenCode e => QDefinition e -> CodeDefinition
qtov (forall a. (a -> Bool) -> [a] -> [a]
filter ((forall k a. Ord k => k -> Map k a -> Bool
`Map.notMember` Maps -> ConceptMatchMap
conceptMatch (Choices -> Maps
maps Choices
chs)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid))
        [QDefinition Literal]
cnsts)
      derived :: [CodeDefinition]
derived = forall a b. (a -> b) -> [a] -> [b]
map forall e. CanGenCode e => QDefinition e -> CodeDefinition
qtov forall a b. (a -> b) -> a -> b
$ [DataDefinition]
-> [CodeVarChunk]
-> [CodeDefinition]
-> ChunkDB
-> [QDefinition Expr]
getDerivedInputs [DataDefinition]
ddefs [CodeVarChunk]
inputs' [CodeDefinition]
const' ChunkDB
db
      rels :: [CodeDefinition]
rels = (forall a b. (a -> b) -> [a] -> [b]
map forall (q :: * -> *).
(Quantity (q Expr), MayHaveUnit (q Expr), DefiningExpr q) =>
q Expr -> CodeDefinition
qtoc ([InstanceModel] -> [QDefinition Expr]
getEqModQdsFromIm [InstanceModel]
ims forall a. [a] -> [a] -> [a]
++ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DataDefinition -> Maybe (QDefinition Expr)
qdEFromDD [DataDefinition]
ddefs) forall a. Eq a => [a] -> [a] -> [a]
\\ [CodeDefinition]
derived)
        forall a. [a] -> [a] -> [a]
++ Maybe ODE -> [CodeDefinition]
mapODE ([ExtLib] -> Maybe ODE
getODE forall a b. (a -> b) -> a -> b
$ Choices -> [ExtLib]
extLibs Choices
chs)
      -- TODO: When we have better DEModels, we should be deriving our ODE information
      --       directly from the instance models (ims) instead of directly from the choices.
      outs' :: [CodeVarChunk]
outs' = forall a b. (a -> b) -> [a] -> [b]
map forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar [i]
outs
      allInputs :: [CodeVarChunk]
allInputs = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ [CodeVarChunk]
inputs' forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar [CodeDefinition]
derived
      exOrder :: [CodeDefinition]
exOrder = [CodeDefinition]
-> [CodeVarChunk] -> [CodeVarChunk] -> ChunkDB -> [CodeDefinition]
getExecOrder [CodeDefinition]
rels ([CodeVarChunk]
allInputs forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar [QDefinition Literal]
cnsts) [CodeVarChunk]
outs' ChunkDB
db
  in  CodeSpec {
        pName :: Name
pName = Name
n,
        authors :: [c]
authors = [c]
as,
        purpose :: Purpose
purpose = Purpose
ps,
        background :: Purpose
background = Purpose
bk,
        inputs :: [CodeVarChunk]
inputs = [CodeVarChunk]
allInputs,
        extInputs :: [CodeVarChunk]
extInputs = [CodeVarChunk]
inputs',
        derivedInputs :: [CodeDefinition]
derivedInputs = [CodeDefinition]
derived,
        outputs :: [CodeVarChunk]
outputs = [CodeVarChunk]
outs',
        configFiles :: [Name]
configFiles = [Name]
cfp,
        execOrder :: [CodeDefinition]
execOrder = [CodeDefinition]
exOrder,
        cMap :: ConstraintCEMap
cMap = forall c. (HasUID c, Constrained c) => [c] -> ConstraintCEMap
constraintMap [j]
cs,
        constants :: [CodeDefinition]
constants = [CodeDefinition]
const',
        constMap :: ConstantMap
constMap = forall a. HasUID a => [a] -> Map UID a
assocToMap [CodeDefinition]
const',
        mods :: [Mod]
mods = [Mod]
ms,
        sysinfodb :: ChunkDB
sysinfodb = ChunkDB
db
      }

-- medium hacks ---

-- | Convert a 'Func' to an implementation-stage 'QuantityDict' representing the
-- function.
asVC :: Func -> QuantityDict
asVC :: Func -> QuantityDict
asVC (FDef (FuncDef Name
n Name
_ [ParameterChunk]
_ Space
_ Maybe Name
_ [FuncStmt]
_)) = Name -> NP -> Space -> Symbol -> QuantityDict
implVar Name
n (Name -> NP
nounPhraseSP Name
n) Space
Real (Name -> Symbol
Variable Name
n)
asVC (FDef (CtorDef Name
n Name
_ [ParameterChunk]
_ [Initializer]
_ [FuncStmt]
_))   = Name -> NP -> Space -> Symbol -> QuantityDict
implVar Name
n (Name -> NP
nounPhraseSP Name
n) Space
Real (Name -> Symbol
Variable Name
n)
asVC (FData (FuncData Name
n Name
_ DataDesc
_))     = Name -> NP -> Space -> Symbol -> QuantityDict
implVar Name
n (Name -> NP
nounPhraseSP Name
n) Space
Real (Name -> Symbol
Variable Name
n)

-- | Get a 'UID' of a chunk corresponding to a 'Func'.
funcUID :: Func -> UID
funcUID :: Func -> UID
funcUID Func
f = Func -> QuantityDict
asVC Func
f forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid

-- | Determines the derived inputs, which can be immediately calculated from the
-- knowns (inputs and constants). If there are DDs, the derived inputs will
-- come from those. If there are none, then the 'QDefinition's are used instead.
getDerivedInputs :: [DataDefinition] -> [Input] -> [Const] ->
  ChunkDB -> [SimpleQDef]
getDerivedInputs :: [DataDefinition]
-> [CodeVarChunk]
-> [CodeDefinition]
-> ChunkDB
-> [QDefinition Expr]
getDerivedInputs [DataDefinition]
ddefs [CodeVarChunk]
ins [CodeDefinition]
cnsts ChunkDB
sm =
  forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => [a] -> [a] -> Bool
`subsetOf` [CodeVarChunk]
refSet) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip CodeExpr -> ChunkDB -> [CodeVarChunk]
codevars ChunkDB
sm forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> CodeExpr
expr forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s a. s -> Getting a s a -> a
^. forall (c :: * -> *) e. DefiningExpr c => Lens' (c e) e
defnExpr)) (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DataDefinition -> Maybe (QDefinition Expr)
qdEFromDD [DataDefinition]
ddefs)
  where refSet :: [CodeVarChunk]
refSet = [CodeVarChunk]
ins forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar [CodeDefinition]
cnsts

-- | Known values.
type Known = CodeVarChunk
-- | Calculated values.
type Need  = CodeVarChunk

-- | Orders a list of definitions such that they form a path between 'Known' values
-- and values that 'Need' to be calculated.
getExecOrder :: [Def] -> [Known] -> [Need] -> ChunkDB -> [Def]
getExecOrder :: [CodeDefinition]
-> [CodeVarChunk] -> [CodeVarChunk] -> ChunkDB -> [CodeDefinition]
getExecOrder [CodeDefinition]
d [CodeVarChunk]
k' [CodeVarChunk]
n' ChunkDB
sm  = [CodeDefinition]
-> [CodeDefinition]
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [CodeDefinition]
getExecOrder' [] [CodeDefinition]
d [CodeVarChunk]
k' ([CodeVarChunk]
n' forall a. Eq a => [a] -> [a] -> [a]
\\ [CodeVarChunk]
k')
  where getExecOrder' :: [CodeDefinition]
-> [CodeDefinition]
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [CodeDefinition]
getExecOrder' [CodeDefinition]
ord [CodeDefinition]
_ [CodeVarChunk]
_ []   = [CodeDefinition]
ord
        getExecOrder' [CodeDefinition]
ord [CodeDefinition]
defs' [CodeVarChunk]
k [CodeVarChunk]
n =
          let new :: [CodeDefinition]
new  = forall a. (a -> Bool) -> [a] -> [a]
filter (\CodeDefinition
def -> (forall a. Eq a => [a] -> [a] -> Bool
`subsetOf` [CodeVarChunk]
k) (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (CodeExpr -> ChunkDB -> [CodeVarChunk]
`codevars'` ChunkDB
sm)
                (CodeDefinition
def forall s a. s -> Getting a s a -> a
^. forall c. DefiningCodeExpr c => Lens' c CodeExpr
codeExpr forall a. a -> [a] -> [a]
: CodeDefinition
def forall s a. s -> Getting a s a -> a
^. Lens' CodeDefinition [CodeExpr]
auxExprs) forall a. Eq a => [a] -> [a] -> [a]
\\ [forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar CodeDefinition
def])) [CodeDefinition]
defs'
              cnew :: [CodeVarChunk]
cnew = forall a b. (a -> b) -> [a] -> [b]
map forall c. (Quantity c, MayHaveUnit c) => c -> CodeVarChunk
quantvar [CodeDefinition]
new
              kNew :: [CodeVarChunk]
kNew = [CodeVarChunk]
k forall a. [a] -> [a] -> [a]
++ [CodeVarChunk]
cnew
              nNew :: [CodeVarChunk]
nNew = [CodeVarChunk]
n forall a. Eq a => [a] -> [a] -> [a]
\\ [CodeVarChunk]
cnew
          in  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CodeDefinition]
new
              then forall a. HasCallStack => Name -> a
error (Name
"The following outputs cannot be computed: " forall a. [a] -> [a] -> [a]
++
                       forall a. [a] -> [[a]] -> [a]
intercalate Name
", " (forall a b. (a -> b) -> [a] -> [b]
map forall a. HasUID a => a -> Name
showUID [CodeVarChunk]
n) forall a. [a] -> [a] -> [a]
++ Name
"\n"
                     forall a. [a] -> [a] -> [a]
++ Name
"Unused definitions are: "
                       forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate Name
", " (forall a b. (a -> b) -> [a] -> [b]
map forall a. HasUID a => a -> Name
showUID [CodeDefinition]
defs') forall a. [a] -> [a] -> [a]
++ Name
"\n"
                     forall a. [a] -> [a] -> [a]
++ Name
"Known values are: "
                       forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate Name
", " (forall a b. (a -> b) -> [a] -> [b]
map forall a. HasUID a => a -> Name
showUID [CodeVarChunk]
k))
              else [CodeDefinition]
-> [CodeDefinition]
-> [CodeVarChunk]
-> [CodeVarChunk]
-> [CodeDefinition]
getExecOrder' ([CodeDefinition]
ord forall a. [a] -> [a] -> [a]
++ [CodeDefinition]
new) ([CodeDefinition]
defs' forall a. Eq a => [a] -> [a] -> [a]
\\ [CodeDefinition]
new) [CodeVarChunk]
kNew [CodeVarChunk]
nNew


-- | Get a list of 'Constraint's for a list of 'CodeChunk's.
getConstraints :: (HasUID c) => ConstraintCEMap -> [c] -> [ConstraintCE]
getConstraints :: forall c. HasUID c => ConstraintCEMap -> [c] -> [ConstraintCE]
getConstraints ConstraintCEMap
cm [c]
cs = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\c
c -> forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (c
c forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid) ConstraintCEMap
cm) [c]
cs

-- | Get a list of 'CodeChunk's from a constraint.
constraintvars :: ConstraintCE -> ChunkDB -> [CodeChunk]
constraintvars :: ConstraintCE -> ChunkDB -> [CodeChunk]
constraintvars (Range ConstraintReason
_ RealInterval CodeExpr CodeExpr
ri) ChunkDB
m =
  forall a b. (a -> b) -> [a] -> [b]
map (forall c. CodeIdea c => c -> CodeChunk
codeChunk forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChunkDB -> UID -> CodeVarChunk
varResolve ChunkDB
m) forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ RealInterval CodeExpr CodeExpr -> [UID]
eNamesRI RealInterval CodeExpr CodeExpr
ri