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

import Language.Drasil hiding (None)
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.Code (CodeChunk, CodeVarChunk, CodeIdea(codeChunk),
  programName, quantvar, codevars, codevars', varResolve, DefiningCodeExpr(..))
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.Code.Expr.Development (expr, eNamesRI)
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],
  -- | All inputs.
  CodeSpec -> [Input]
inputs :: [Input],
  -- | Explicit inputs (values to be supplied by a file).
  CodeSpec -> [Input]
extInputs :: [Input],
  -- | Derived inputs (each calculated from explicit inputs in a single step).
  CodeSpec -> [Derived]
derivedInputs :: [Derived],
  -- | All outputs.
  CodeSpec -> [Input]
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 -> [Derived]
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 -> [Derived]
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 :: [a] -> Map UID a
assocToMap = [(UID, a)] -> Map UID a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(UID, a)] -> Map UID a)
-> ([a] -> [(UID, a)]) -> [a] -> Map UID a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (UID, a)) -> [a] -> [(UID, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\x :: a
x -> (a
x a -> Getting UID a UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID a UID
forall c. HasUID c => Lens' c UID
uid, a
x))

-- | Get ODE from ExtLib
getODE :: [ExtLib] -> Maybe ODE
getODE :: [ExtLib] -> Maybe ODE
getODE [] = Maybe ODE
forall a. Maybe a
Nothing
getODE (Math ode :: ODE
ode: _) = ODE -> Maybe ODE
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 -> [Derived]
mapODE Nothing = []
mapODE (Just ode :: ODE
ode) = (ODEInfo -> Derived) -> [ODEInfo] -> [Derived]
forall a b. (a -> b) -> [a] -> [b]
map ODEInfo -> Derived
odeDef ([ODEInfo] -> [Derived]) -> [ODEInfo] -> [Derived]
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
           , _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 -> [ConstQDef]
_constants   = [ConstQDef]
cnsts
           , _sysinfodb :: SystemInformation -> ChunkDB
_sysinfodb   = ChunkDB
db} chs :: Choices
chs ms :: [Mod]
ms =
  let n :: Name
n = a -> Name
forall c. CommonIdea c => c -> Name
programName a
sys
      inputs' :: [Input]
inputs' = (h -> Input) -> [h] -> [Input]
forall a b. (a -> b) -> [a] -> [b]
map h -> Input
forall c. (Quantity c, MayHaveUnit c) => c -> Input
quantvar [h]
ins
      const' :: [Derived]
const' = (ConstQDef -> Derived) -> [ConstQDef] -> [Derived]
forall a b. (a -> b) -> [a] -> [b]
map ConstQDef -> Derived
forall e. CanGenCode e => QDefinition e -> Derived
qtov ((ConstQDef -> Bool) -> [ConstQDef] -> [ConstQDef]
forall a. (a -> Bool) -> [a] -> [a]
filter ((UID -> Map UID [CodeConcept] -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.notMember` Maps -> Map UID [CodeConcept]
conceptMatch (Choices -> Maps
maps Choices
chs)) (UID -> Bool) -> (ConstQDef -> UID) -> ConstQDef -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConstQDef -> Getting UID ConstQDef UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID ConstQDef UID
forall c. HasUID c => Lens' c UID
uid))
        [ConstQDef]
cnsts)
      derived :: [Derived]
derived = (QDefinition Expr -> Derived) -> [QDefinition Expr] -> [Derived]
forall a b. (a -> b) -> [a] -> [b]
map QDefinition Expr -> Derived
forall e. CanGenCode e => QDefinition e -> Derived
qtov ([QDefinition Expr] -> [Derived])
-> [QDefinition Expr] -> [Derived]
forall a b. (a -> b) -> a -> b
$ [DataDefinition]
-> [Input] -> [Derived] -> ChunkDB -> [QDefinition Expr]
getDerivedInputs [DataDefinition]
ddefs [Input]
inputs' [Derived]
const' ChunkDB
db
      rels :: [Derived]
rels = ((QDefinition Expr -> Derived) -> [QDefinition Expr] -> [Derived]
forall a b. (a -> b) -> [a] -> [b]
map QDefinition Expr -> Derived
forall (q :: * -> *).
(Quantity (q Expr), MayHaveUnit (q Expr), DefiningExpr q) =>
q Expr -> Derived
qtoc ([InstanceModel] -> [QDefinition Expr]
getEqModQdsFromIm [InstanceModel]
ims [QDefinition Expr] -> [QDefinition Expr] -> [QDefinition Expr]
forall a. [a] -> [a] -> [a]
++ (DataDefinition -> Maybe (QDefinition Expr))
-> [DataDefinition] -> [QDefinition Expr]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DataDefinition -> Maybe (QDefinition Expr)
qdEFromDD [DataDefinition]
ddefs) [Derived] -> [Derived] -> [Derived]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Derived]
derived)
        [Derived] -> [Derived] -> [Derived]
forall a. [a] -> [a] -> [a]
++ Maybe ODE -> [Derived]
mapODE ([ExtLib] -> Maybe ODE
getODE ([ExtLib] -> Maybe ODE) -> [ExtLib] -> Maybe ODE
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' :: [Input]
outs' = (i -> Input) -> [i] -> [Input]
forall a b. (a -> b) -> [a] -> [b]
map i -> Input
forall c. (Quantity c, MayHaveUnit c) => c -> Input
quantvar [i]
outs
      allInputs :: [Input]
allInputs = [Input] -> [Input]
forall a. Eq a => [a] -> [a]
nub ([Input] -> [Input]) -> [Input] -> [Input]
forall a b. (a -> b) -> a -> b
$ [Input]
inputs' [Input] -> [Input] -> [Input]
forall a. [a] -> [a] -> [a]
++ (Derived -> Input) -> [Derived] -> [Input]
forall a b. (a -> b) -> [a] -> [b]
map Derived -> Input
forall c. (Quantity c, MayHaveUnit c) => c -> Input
quantvar [Derived]
derived
      exOrder :: [Derived]
exOrder = [Derived] -> [Input] -> [Input] -> ChunkDB -> [Derived]
getExecOrder [Derived]
rels ([Input]
allInputs [Input] -> [Input] -> [Input]
forall a. [a] -> [a] -> [a]
++ (ConstQDef -> Input) -> [ConstQDef] -> [Input]
forall a b. (a -> b) -> [a] -> [b]
map ConstQDef -> Input
forall c. (Quantity c, MayHaveUnit c) => c -> Input
quantvar [ConstQDef]
cnsts) [Input]
outs' ChunkDB
db
  in  CodeSpec :: forall a.
HasName a =>
Name
-> [a]
-> [Input]
-> [Input]
-> [Derived]
-> [Input]
-> [Name]
-> [Derived]
-> ConstraintCEMap
-> [Derived]
-> ConstantMap
-> [Mod]
-> ChunkDB
-> CodeSpec
CodeSpec {
        pName :: Name
pName = Name
n,
        authors :: [c]
authors = [c]
as,
        inputs :: [Input]
inputs = [Input]
allInputs,
        extInputs :: [Input]
extInputs = [Input]
inputs',
        derivedInputs :: [Derived]
derivedInputs = [Derived]
derived,
        outputs :: [Input]
outputs = [Input]
outs',
        configFiles :: [Name]
configFiles = [Name]
cfp,
        execOrder :: [Derived]
execOrder = [Derived]
exOrder,
        cMap :: ConstraintCEMap
cMap = [j] -> ConstraintCEMap
forall c. (HasUID c, Constrained c) => [c] -> ConstraintCEMap
constraintMap [j]
cs,
        constants :: [Derived]
constants = [Derived]
const',
        constMap :: ConstantMap
constMap = [Derived] -> ConstantMap
forall a. HasUID a => [a] -> Map UID a
assocToMap [Derived]
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 n :: Name
n _ _ _ _ _)) = Name -> NP -> Space -> Symbol -> QuantityDict
implVar Name
n (Name -> NP
nounPhraseSP Name
n) Space
Real (Name -> Symbol
Variable Name
n)
asVC (FDef (CtorDef n :: Name
n _ _ _ _))   = Name -> NP -> Space -> Symbol -> QuantityDict
implVar Name
n (Name -> NP
nounPhraseSP Name
n) Space
Real (Name -> Symbol
Variable Name
n)
asVC (FData (FuncData n :: Name
n _ _))     = 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 f :: Func
f = Func -> QuantityDict
asVC Func
f QuantityDict -> Getting UID QuantityDict UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID QuantityDict UID
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]
-> [Input] -> [Derived] -> ChunkDB -> [QDefinition Expr]
getDerivedInputs ddefs :: [DataDefinition]
ddefs ins :: [Input]
ins cnsts :: [Derived]
cnsts sm :: ChunkDB
sm =
  (QDefinition Expr -> Bool)
-> [QDefinition Expr] -> [QDefinition Expr]
forall a. (a -> Bool) -> [a] -> [a]
filter (([Input] -> [Input] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`subsetOf` [Input]
refSet) ([Input] -> Bool)
-> (QDefinition Expr -> [Input]) -> QDefinition Expr -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CodeExpr -> ChunkDB -> [Input]) -> ChunkDB -> CodeExpr -> [Input]
forall a b c. (a -> b -> c) -> b -> a -> c
flip CodeExpr -> ChunkDB -> [Input]
codevars ChunkDB
sm (CodeExpr -> [Input])
-> (QDefinition Expr -> CodeExpr) -> QDefinition Expr -> [Input]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> CodeExpr
expr (Expr -> CodeExpr)
-> (QDefinition Expr -> Expr) -> QDefinition Expr -> CodeExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QDefinition Expr -> Getting Expr (QDefinition Expr) Expr -> Expr
forall s a. s -> Getting a s a -> a
^. Getting Expr (QDefinition Expr) Expr
forall (c :: * -> *) e. DefiningExpr c => Lens' (c e) e
defnExpr)) ((DataDefinition -> Maybe (QDefinition Expr))
-> [DataDefinition] -> [QDefinition Expr]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DataDefinition -> Maybe (QDefinition Expr)
qdEFromDD [DataDefinition]
ddefs)
  where refSet :: [Input]
refSet = [Input]
ins [Input] -> [Input] -> [Input]
forall a. [a] -> [a] -> [a]
++ (Derived -> Input) -> [Derived] -> [Input]
forall a b. (a -> b) -> [a] -> [b]
map Derived -> Input
forall c. (Quantity c, MayHaveUnit c) => c -> Input
quantvar [Derived]
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 :: [Derived] -> [Input] -> [Input] -> ChunkDB -> [Derived]
getExecOrder d :: [Derived]
d k' :: [Input]
k' n' :: [Input]
n' sm :: ChunkDB
sm  = [Derived] -> [Derived] -> [Input] -> [Input] -> [Derived]
getExecOrder' [] [Derived]
d [Input]
k' ([Input]
n' [Input] -> [Input] -> [Input]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Input]
k')
  where getExecOrder' :: [Derived] -> [Derived] -> [Input] -> [Input] -> [Derived]
getExecOrder' ord :: [Derived]
ord _ _ []   = [Derived]
ord
        getExecOrder' ord :: [Derived]
ord defs' :: [Derived]
defs' k :: [Input]
k n :: [Input]
n =
          let new :: [Derived]
new  = (Derived -> Bool) -> [Derived] -> [Derived]
forall a. (a -> Bool) -> [a] -> [a]
filter (\def :: Derived
def -> ([Input] -> [Input] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`subsetOf` [Input]
k) ((CodeExpr -> [Input]) -> [CodeExpr] -> [Input]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (CodeExpr -> ChunkDB -> [Input]
`codevars'` ChunkDB
sm)
                (Derived
def Derived -> Getting CodeExpr Derived CodeExpr -> CodeExpr
forall s a. s -> Getting a s a -> a
^. Getting CodeExpr Derived CodeExpr
forall c. DefiningCodeExpr c => Lens' c CodeExpr
codeExpr CodeExpr -> [CodeExpr] -> [CodeExpr]
forall a. a -> [a] -> [a]
: Derived
def Derived -> Getting [CodeExpr] Derived [CodeExpr] -> [CodeExpr]
forall s a. s -> Getting a s a -> a
^. Getting [CodeExpr] Derived [CodeExpr]
Lens' Derived [CodeExpr]
auxExprs) [Input] -> [Input] -> [Input]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Derived -> Input
forall c. (Quantity c, MayHaveUnit c) => c -> Input
quantvar Derived
def])) [Derived]
defs'
              cnew :: [Input]
cnew = (Derived -> Input) -> [Derived] -> [Input]
forall a b. (a -> b) -> [a] -> [b]
map Derived -> Input
forall c. (Quantity c, MayHaveUnit c) => c -> Input
quantvar [Derived]
new
              kNew :: [Input]
kNew = [Input]
k [Input] -> [Input] -> [Input]
forall a. [a] -> [a] -> [a]
++ [Input]
cnew
              nNew :: [Input]
nNew = [Input]
n [Input] -> [Input] -> [Input]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Input]
cnew
          in  if [Derived] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Derived]
new
              then Name -> [Derived]
forall a. HasCallStack => Name -> a
error ("The following outputs cannot be computed: " Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++
                       Name -> [Name] -> Name
forall a. [a] -> [[a]] -> [a]
intercalate ", " ((Input -> Name) -> [Input] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Input -> Name
forall a. HasUID a => a -> Name
showUID [Input]
n) Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ "\n"
                     Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ "Unused definitions are: "
                       Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name -> [Name] -> Name
forall a. [a] -> [[a]] -> [a]
intercalate ", " ((Derived -> Name) -> [Derived] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Derived -> Name
forall a. HasUID a => a -> Name
showUID [Derived]
defs') Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ "\n"
                     Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ "Known values are: "
                       Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name -> [Name] -> Name
forall a. [a] -> [[a]] -> [a]
intercalate ", " ((Input -> Name) -> [Input] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Input -> Name
forall a. HasUID a => a -> Name
showUID [Input]
k))
              else [Derived] -> [Derived] -> [Input] -> [Input] -> [Derived]
getExecOrder' ([Derived]
ord [Derived] -> [Derived] -> [Derived]
forall a. [a] -> [a] -> [a]
++ [Derived]
new) ([Derived]
defs' [Derived] -> [Derived] -> [Derived]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Derived]
new) [Input]
kNew [Input]
nNew


-- | Get a list of 'Constraint's for a list of 'CodeChunk's.
getConstraints :: (HasUID c) => ConstraintCEMap -> [c] -> [ConstraintCE]
getConstraints :: ConstraintCEMap -> [c] -> [ConstraintCE]
getConstraints cm :: ConstraintCEMap
cm cs :: [c]
cs = [[ConstraintCE]] -> [ConstraintCE]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ConstraintCE]] -> [ConstraintCE])
-> [[ConstraintCE]] -> [ConstraintCE]
forall a b. (a -> b) -> a -> b
$ (c -> Maybe [ConstraintCE]) -> [c] -> [[ConstraintCE]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\c :: c
c -> UID -> ConstraintCEMap -> Maybe [ConstraintCE]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (c
c c -> Getting UID c UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID c UID
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 _ ri :: RealInterval CodeExpr CodeExpr
ri) m :: ChunkDB
m =
  (UID -> CodeChunk) -> [UID] -> [CodeChunk]
forall a b. (a -> b) -> [a] -> [b]
map (Input -> CodeChunk
forall c. CodeIdea c => c -> CodeChunk
codeChunk (Input -> CodeChunk) -> (UID -> Input) -> UID -> CodeChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChunkDB -> UID -> Input
varResolve ChunkDB
m) ([UID] -> [CodeChunk]) -> [UID] -> [CodeChunk]
forall a b. (a -> b) -> a -> b
$ [UID] -> [UID]
forall a. Eq a => [a] -> [a]
nub ([UID] -> [UID]) -> [UID] -> [UID]
forall a b. (a -> b) -> a -> b
$ RealInterval CodeExpr CodeExpr -> [UID]
eNamesRI RealInterval CodeExpr CodeExpr
ri