{-# LANGUAGE TemplateHaskell #-}
-- | Defines functions for simultaneous interpretation of ExternalLibrary and
-- ExternalLibraryCall.
module Language.Drasil.Code.ExtLibImport (ExtLibState(..), auxMods, defs,
  imports, modExports, steps, genExternalLibraryCall) where

import Prelude hiding ((!!))
import Control.Lens (makeLenses, (^.), over)
import Control.Monad (zipWithM)
import Control.Monad.State (State, execState, get, modify)
import Data.List (nub, partition)
import Data.List.NonEmpty (NonEmpty(..), (!!), toList)
import Data.Maybe (isJust)

import Language.Drasil (HasSpace(typ), getActorName)

import Drasil.Code.CodeExpr (CodeExpr, ($&&), applyWithNamedArgs,
  msgWithNamedArgs, new, newWithNamedArgs, sy)
import Drasil.Code.CodeVar (CodeVarChunk, CodeFuncChunk, codeName)
import Language.Drasil.Chunk.Code (ccObjVar)
import Language.Drasil.Chunk.Parameter (ParameterChunk)
import Language.Drasil.Chunk.NamedArgument (NamedArgument)
import Language.Drasil.Mod (Class, StateVariable, Func(..), Mod, Name,
  Description, packmodRequires, classDef, classImplements, FuncStmt(..),
  funcDefParams, ctorDef)
import Language.Drasil.Code.ExternalLibrary (ExternalLibrary, Step(..),
  FunctionInterface(..), Result(..), Argument(..), ArgumentInfo(..),
  Parameter(..), ClassInfo(..), MethodInfo(..), FuncType(..), isConstructor)
import Language.Drasil.Code.ExternalLibraryCall (ExternalLibraryCall,
  StepGroupFill(..), StepFill(..), FunctionIntFill(..), ArgumentFill(..),
  ParameterFill(..), ClassInfoFill(..), MethodInfoFill(..))

-- | State object used during interpretation of an 'ExternalLibrary' and
-- 'ExternalLibraryCall'.
data ExtLibState = ELS {
  -- | Additional modules that must be generated to use the library.
  ExtLibState -> [Mod]
_auxMods :: [Mod],
  -- | The defining statements for variables that must be pre-defined before
  -- being passed as arguments in an external library call.
  ExtLibState -> [FuncStmt]
_defs :: [FuncStmt],
  -- | The names of variables for which a defining statement has already been
  -- generated.
  ExtLibState -> [String]
_defined :: [Name],
  -- | The statements corresponding to the external library use case.
  ExtLibState -> [FuncStmt]
_steps :: [FuncStmt],
  -- | The imports required to use the external library.
  ExtLibState -> [String]
_imports :: [String],
  -- | An association list between library method/function names and the external
  -- library module that exports them.
  ExtLibState -> [(String, String)]
_modExports :: [(Name, Name)]
}
makeLenses ''ExtLibState

-- | Initialize an empty 'ExtLibState'.
initELS :: ExtLibState
initELS :: ExtLibState
initELS = ELS {
  _auxMods :: [Mod]
_auxMods = [],
  _defs :: [FuncStmt]
_defs = [],
  _defined :: [String]
_defined = [],
  _steps :: [FuncStmt]
_steps = [],
  _imports :: [String]
_imports = [],
  _modExports :: [(String, String)]
_modExports = []
}

-- State Modifiers

-- | Adds a module definition to an ExtLibState.
addMod :: Mod -> ExtLibState -> ExtLibState
addMod :: Mod -> ExtLibState -> ExtLibState
addMod Mod
m = ASetter ExtLibState ExtLibState [Mod] [Mod]
-> ([Mod] -> [Mod]) -> ExtLibState -> ExtLibState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter ExtLibState ExtLibState [Mod] [Mod]
Lens' ExtLibState [Mod]
auxMods (Mod
mMod -> [Mod] -> [Mod]
forall a. a -> [a] -> [a]
:)

-- | Adds a defining statement for the given 'CodeVarChunk' and 'CodeExpr' to the
-- 'ExtLibState' and adds the 'CodeVarChunk''s name to the defined field of the
-- state, but only if it was not already in the defined field.
addDef :: CodeExpr -> CodeVarChunk -> ExtLibState -> ExtLibState
addDef :: CodeExpr -> CodeVarChunk -> ExtLibState -> ExtLibState
addDef CodeExpr
e CodeVarChunk
c ExtLibState
s = if String
n String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (ExtLibState
s ExtLibState -> Getting [String] ExtLibState [String] -> [String]
forall s a. s -> Getting a s a -> a
^. Getting [String] ExtLibState [String]
Lens' ExtLibState [String]
defined)
               then ExtLibState
s
               else ASetter ExtLibState ExtLibState [FuncStmt] [FuncStmt]
-> ([FuncStmt] -> [FuncStmt]) -> ExtLibState -> ExtLibState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter ExtLibState ExtLibState [FuncStmt] [FuncStmt]
Lens' ExtLibState [FuncStmt]
defs ([FuncStmt] -> [FuncStmt] -> [FuncStmt]
forall a. [a] -> [a] -> [a]
++ [CodeVarChunk -> CodeExpr -> FuncStmt
FDecDef CodeVarChunk
c CodeExpr
e]) (String -> ExtLibState -> ExtLibState
addDefined String
n ExtLibState
s)
  where n :: String
n = CodeVarChunk -> String
forall c. CodeIdea c => c -> String
codeName CodeVarChunk
c

-- | Adds a defining statement for a local function, represented by the given
-- 'CodeFuncChunk', 'ParameterChunk's, and 'FuncStmt's, to the 'ExtLibState', and adds
-- the function's name to the defined field, but only if it was not already in
-- the defined field.
addFuncDef :: CodeFuncChunk -> [ParameterChunk] -> [FuncStmt] -> ExtLibState ->
  ExtLibState
addFuncDef :: CodeFuncChunk
-> [ParameterChunk] -> [FuncStmt] -> ExtLibState -> ExtLibState
addFuncDef CodeFuncChunk
c [ParameterChunk]
ps [FuncStmt]
b ExtLibState
s = if String
n String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (ExtLibState
s ExtLibState -> Getting [String] ExtLibState [String] -> [String]
forall s a. s -> Getting a s a -> a
^. Getting [String] ExtLibState [String]
Lens' ExtLibState [String]
defined) then ExtLibState
s else ASetter ExtLibState ExtLibState [FuncStmt] [FuncStmt]
-> ([FuncStmt] -> [FuncStmt]) -> ExtLibState -> ExtLibState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter ExtLibState ExtLibState [FuncStmt] [FuncStmt]
Lens' ExtLibState [FuncStmt]
defs
  ([FuncStmt] -> [FuncStmt] -> [FuncStmt]
forall a. [a] -> [a] -> [a]
++ [CodeFuncChunk -> [ParameterChunk] -> [FuncStmt] -> FuncStmt
FFuncDef CodeFuncChunk
c [ParameterChunk]
ps [FuncStmt]
b]) (String -> ExtLibState -> ExtLibState
addDefined String
n ExtLibState
s)
  where n :: String
n = CodeFuncChunk -> String
forall c. CodeIdea c => c -> String
codeName CodeFuncChunk
c

-- | Adds to the 'ExtLibState' statements for initializing fields, represented by
-- the list of 'CodeVarChunk', of a record, represented by the 'CodeVarChunk', with
-- values, represented by the list of 'CodeExpr'.
addFieldAsgs :: CodeVarChunk -> [CodeVarChunk] -> [CodeExpr] -> ExtLibState ->
  ExtLibState
addFieldAsgs :: CodeVarChunk
-> [CodeVarChunk] -> [CodeExpr] -> ExtLibState -> ExtLibState
addFieldAsgs CodeVarChunk
o [CodeVarChunk]
cs [CodeExpr]
es = ASetter ExtLibState ExtLibState [FuncStmt] [FuncStmt]
-> ([FuncStmt] -> [FuncStmt]) -> ExtLibState -> ExtLibState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter ExtLibState ExtLibState [FuncStmt] [FuncStmt]
Lens' ExtLibState [FuncStmt]
defs ([FuncStmt] -> [FuncStmt] -> [FuncStmt]
forall a. [a] -> [a] -> [a]
++ (CodeVarChunk -> CodeExpr -> FuncStmt)
-> [CodeVarChunk] -> [CodeExpr] -> [FuncStmt]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith CodeVarChunk -> CodeExpr -> FuncStmt
FAsg ((CodeVarChunk -> CodeVarChunk) -> [CodeVarChunk] -> [CodeVarChunk]
forall a b. (a -> b) -> [a] -> [b]
map (CodeVarChunk -> CodeVarChunk -> CodeVarChunk
ccObjVar CodeVarChunk
o) [CodeVarChunk]
cs) [CodeExpr]
es)

-- | Adds a name to the defined field of 'ExtLibState'.
addDefined :: Name -> ExtLibState -> ExtLibState
addDefined :: String -> ExtLibState -> ExtLibState
addDefined String
n = ASetter ExtLibState ExtLibState [String] [String]
-> ([String] -> [String]) -> ExtLibState -> ExtLibState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter ExtLibState ExtLibState [String] [String]
Lens' ExtLibState [String]
defined (String
nString -> [String] -> [String]
forall a. a -> [a] -> [a]
:)

-- | Adds a list of imports to the 'ExtLibState'.
addImports :: [String] -> ExtLibState -> ExtLibState
addImports :: [String] -> ExtLibState -> ExtLibState
addImports [String]
is = ASetter ExtLibState ExtLibState [String] [String]
-> ([String] -> [String]) -> ExtLibState -> ExtLibState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter ExtLibState ExtLibState [String] [String]
Lens' ExtLibState [String]
imports (\[String]
l -> [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
l [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
is)

-- | Adds to the 'ExtLibState' an association between a library function/method and
-- the library's module that exports it.
addModExport :: (Name, Name) -> ExtLibState -> ExtLibState
addModExport :: (String, String) -> ExtLibState -> ExtLibState
addModExport (String, String)
e = ASetter
  ExtLibState ExtLibState [(String, String)] [(String, String)]
-> ([(String, String)] -> [(String, String)])
-> ExtLibState
-> ExtLibState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  ExtLibState ExtLibState [(String, String)] [(String, String)]
Lens' ExtLibState [(String, String)]
modExports ((String, String)
e(String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
:)

-- | Adds a list of statements for an external library use case to the 'ExtLibState'.
addSteps :: [FuncStmt] -> ExtLibState -> ExtLibState
addSteps :: [FuncStmt] -> ExtLibState -> ExtLibState
addSteps [FuncStmt]
fs = ASetter ExtLibState ExtLibState [FuncStmt] [FuncStmt]
-> ([FuncStmt] -> [FuncStmt]) -> ExtLibState -> ExtLibState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter ExtLibState ExtLibState [FuncStmt] [FuncStmt]
Lens' ExtLibState [FuncStmt]
steps ([FuncStmt] -> [FuncStmt] -> [FuncStmt]
forall a. [a] -> [a] -> [a]
++[FuncStmt]
fs)

-- | Resets fields of 'ExtLibState' that are local to each module.
refreshLocal :: ExtLibState -> ExtLibState
refreshLocal :: ExtLibState -> ExtLibState
refreshLocal ExtLibState
s = ExtLibState
s {_defs = [], _defined = [], _imports = []}

-- | Returns fields of 'ExtLibState' that are local to each module to a previous state.
returnLocal :: ExtLibState -> ExtLibState -> ExtLibState
returnLocal :: ExtLibState -> ExtLibState -> ExtLibState
returnLocal ExtLibState
oldS ExtLibState
newS = ExtLibState
newS {_defs = oldS ^. defs,
                              _defined = oldS ^. defined,
                              _imports = oldS ^. imports}

-- Generators

-- | Interprets an 'ExternalLibrary' and 'ExternalLibraryCall' and returns the
-- resulting 'ExtLibState'.
genExternalLibraryCall :: ExternalLibrary -> ExternalLibraryCall ->
  ExtLibState
genExternalLibraryCall :: ExternalLibrary -> ExternalLibraryCall -> ExtLibState
genExternalLibraryCall ExternalLibrary
el ExternalLibraryCall
elc = State ExtLibState () -> ExtLibState -> ExtLibState
forall s a. State s a -> s -> s
execState (ExternalLibrary -> ExternalLibraryCall -> State ExtLibState ()
genExtLibCall ExternalLibrary
el ExternalLibraryCall
elc) ExtLibState
initELS

-- | Interprets a list of 'StepGroups' and 'StepGroupFills', adding the resulting
-- statements to the 'ExtLibState'.
genExtLibCall :: ExternalLibrary -> ExternalLibraryCall ->
  State ExtLibState ()
genExtLibCall :: ExternalLibrary -> ExternalLibraryCall -> State ExtLibState ()
genExtLibCall [] [] = () -> State ExtLibState ()
forall a. a -> StateT ExtLibState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
genExtLibCall (StepGroup
sg:ExternalLibrary
el) (SGF Int
n [StepFill]
sgf:ExternalLibraryCall
elc) = let s :: [Step]
s = StepGroup
sgStepGroup -> Int -> [Step]
forall a. HasCallStack => NonEmpty a -> Int -> a
!!Int
n in
  if [Step] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Step]
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [StepFill] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [StepFill]
sgf then String -> State ExtLibState ()
forall a. HasCallStack => String -> a
error String
stepNumberMismatch else do
    fs <- (Step -> StepFill -> StateT ExtLibState Identity FuncStmt)
-> [Step] -> [StepFill] -> StateT ExtLibState Identity [FuncStmt]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Step -> StepFill -> StateT ExtLibState Identity FuncStmt
genStep [Step]
s [StepFill]
sgf
    modify (addSteps fs)
    genExtLibCall el elc
genExtLibCall ExternalLibrary
_ ExternalLibraryCall
_ = String -> State ExtLibState ()
forall a. HasCallStack => String -> a
error String
stepNumberMismatch

-- | Interprets a 'Step' and 'StepFill', resulting in a 'FuncStmt' that performs the step.
genStep :: Step -> StepFill -> State ExtLibState FuncStmt
genStep :: Step -> StepFill -> StateT ExtLibState Identity FuncStmt
genStep (Call FunctionInterface
fi) (CallF FunctionIntFill
fif) = FunctionInterface
-> FunctionIntFill -> StateT ExtLibState Identity FuncStmt
genFI FunctionInterface
fi FunctionIntFill
fif
genStep (Loop NonEmpty FunctionInterface
fis [CodeExpr] -> CodeExpr
f NonEmpty Step
ss) (LoopF NonEmpty FunctionIntFill
fifs [CodeExpr]
ccList NonEmpty StepFill
sfs) = do
  es <- (FunctionInterface
 -> FunctionIntFill -> StateT ExtLibState Identity CodeExpr)
-> [FunctionInterface]
-> [FunctionIntFill]
-> StateT ExtLibState Identity [CodeExpr]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM FunctionInterface
-> FunctionIntFill -> StateT ExtLibState Identity CodeExpr
genFIVal (NonEmpty FunctionInterface -> [FunctionInterface]
forall a. NonEmpty a -> [a]
toList NonEmpty FunctionInterface
fis) (NonEmpty FunctionIntFill -> [FunctionIntFill]
forall a. NonEmpty a -> [a]
toList NonEmpty FunctionIntFill
fifs)
  fs <- zipWithM genStep (toList ss) (toList sfs)
  return $ FWhile (foldl1 ($&&) es $&& f ccList) fs
genStep (Statement [CodeVarChunk] -> [CodeExpr] -> FuncStmt
f) (StatementF [CodeVarChunk]
ccList [CodeExpr]
exList) = FuncStmt -> StateT ExtLibState Identity FuncStmt
forall a. a -> StateT ExtLibState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (FuncStmt -> StateT ExtLibState Identity FuncStmt)
-> FuncStmt -> StateT ExtLibState Identity FuncStmt
forall a b. (a -> b) -> a -> b
$ [CodeVarChunk] -> [CodeExpr] -> FuncStmt
f [CodeVarChunk]
ccList [CodeExpr]
exList
genStep Step
_ StepFill
_ = String -> StateT ExtLibState Identity FuncStmt
forall a. HasCallStack => String -> a
error String
stepTypeMismatch

-- | Interprets a 'FunctionInterface' and 'FunctionIntFill', resulting in a 'CodeExpr'
-- representing a call to the library. Imports required for the call are added
-- to the 'ExtLibState', and the called function/method is added to the library
-- export association list in the 'ExtLibState'.
genFIVal :: FunctionInterface -> FunctionIntFill -> State ExtLibState CodeExpr
genFIVal :: FunctionInterface
-> FunctionIntFill -> StateT ExtLibState Identity CodeExpr
genFIVal (FI (String
r:|[String]
rs) FuncType
ft CodeFuncChunk
f [Argument]
as Maybe Result
_) (FIF [ArgumentFill]
afs) = do
  args <- [Argument]
-> [ArgumentFill]
-> State ExtLibState [(Maybe NamedArgument, CodeExpr)]
genArguments [Argument]
as [ArgumentFill]
afs
  let isNamed = Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (Maybe a -> Bool)
-> ((Maybe a, b) -> Maybe a) -> (Maybe a, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe a, b) -> Maybe a
forall a b. (a, b) -> a
fst
      (nas, ars) = partition isNamed args
  modify (addImports rs . addModExport (codeName f, r))
  return $ getCallFunc ft f (map snd ars) (map (\(Maybe NamedArgument
n, CodeExpr
e) ->
    (NamedArgument, CodeExpr)
-> (NamedArgument -> (NamedArgument, CodeExpr))
-> Maybe NamedArgument
-> (NamedArgument, CodeExpr)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> (NamedArgument, CodeExpr)
forall a. HasCallStack => String -> a
error String
"defective isNamed") (,CodeExpr
e) Maybe NamedArgument
n) nas)
  where getCallFunc :: FuncType -> f -> [r] -> [(a, r)] -> r
getCallFunc FuncType
Function = f -> [r] -> [(a, r)] -> r
forall r f a.
(CodeExprC r, IsChunk f, HasSymbol f, IsChunk a,
 IsArgumentName a) =>
f -> [r] -> [(a, r)] -> r
forall f a.
(IsChunk f, HasSymbol f, IsChunk a, IsArgumentName a) =>
f -> [r] -> [(a, r)] -> r
applyWithNamedArgs
        getCallFunc (Method CodeVarChunk
o) = CodeVarChunk -> f -> [r] -> [(a, r)] -> r
forall r f c a.
(CodeExprC r, Callable f, IsChunk f, CodeIdea f, IsChunk c,
 HasSpace c, CodeIdea c, IsChunk a, IsArgumentName a) =>
c -> f -> [r] -> [(a, r)] -> r
forall f c a.
(Callable f, IsChunk f, CodeIdea f, IsChunk c, HasSpace c,
 CodeIdea c, IsChunk a, IsArgumentName a) =>
c -> f -> [r] -> [(a, r)] -> r
msgWithNamedArgs CodeVarChunk
o
        getCallFunc FuncType
Constructor = f -> [r] -> [(a, r)] -> r
forall r f a.
(CodeExprC r, Callable f, IsChunk f, CodeIdea f, IsChunk a,
 IsArgumentName a) =>
f -> [r] -> [(a, r)] -> r
forall f a.
(Callable f, IsChunk f, CodeIdea f, IsChunk a, IsArgumentName a) =>
f -> [r] -> [(a, r)] -> r
newWithNamedArgs

-- | Interprets a 'FunctionInterface' and 'FunctionIntFill', resulting in a 'FuncStmt'
-- for the function/method call.
genFI :: FunctionInterface -> FunctionIntFill -> State ExtLibState FuncStmt
genFI :: FunctionInterface
-> FunctionIntFill -> StateT ExtLibState Identity FuncStmt
genFI fi :: FunctionInterface
fi@(FI NonEmpty String
_ FuncType
_ CodeFuncChunk
_ [Argument]
_ Maybe Result
r) FunctionIntFill
fif = do
  fiEx <- FunctionInterface
-> FunctionIntFill -> StateT ExtLibState Identity CodeExpr
genFIVal FunctionInterface
fi FunctionIntFill
fif
  return $ maybeGenAssg r fiEx

-- | Interprets a list of 'Argument' and list of 'ArgumentFill', returning the 'CodeExpr'
-- for each argument and the 'NamedArgument' chunk for arguments that are named.
genArguments :: [Argument] -> [ArgumentFill] ->
  State ExtLibState [(Maybe NamedArgument, CodeExpr)]
genArguments :: [Argument]
-> [ArgumentFill]
-> State ExtLibState [(Maybe NamedArgument, CodeExpr)]
genArguments (Arg Maybe NamedArgument
n (LockedArg CodeExpr
e):[Argument]
as) [ArgumentFill]
afs = ([(Maybe NamedArgument, CodeExpr)]
 -> [(Maybe NamedArgument, CodeExpr)])
-> State ExtLibState [(Maybe NamedArgument, CodeExpr)]
-> State ExtLibState [(Maybe NamedArgument, CodeExpr)]
forall a b.
(a -> b)
-> StateT ExtLibState Identity a -> StateT ExtLibState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe NamedArgument
n,CodeExpr
e)(Maybe NamedArgument, CodeExpr)
-> [(Maybe NamedArgument, CodeExpr)]
-> [(Maybe NamedArgument, CodeExpr)]
forall a. a -> [a] -> [a]
:) ([Argument]
-> [ArgumentFill]
-> State ExtLibState [(Maybe NamedArgument, CodeExpr)]
genArguments [Argument]
as [ArgumentFill]
afs)
genArguments [Argument]
as (UserDefinedArgF Maybe NamedArgument
n CodeExpr
e:[ArgumentFill]
afs) = ([(Maybe NamedArgument, CodeExpr)]
 -> [(Maybe NamedArgument, CodeExpr)])
-> State ExtLibState [(Maybe NamedArgument, CodeExpr)]
-> State ExtLibState [(Maybe NamedArgument, CodeExpr)]
forall a b.
(a -> b)
-> StateT ExtLibState Identity a -> StateT ExtLibState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe NamedArgument
n,CodeExpr
e)(Maybe NamedArgument, CodeExpr)
-> [(Maybe NamedArgument, CodeExpr)]
-> [(Maybe NamedArgument, CodeExpr)]
forall a. a -> [a] -> [a]
:) ([Argument]
-> [ArgumentFill]
-> State ExtLibState [(Maybe NamedArgument, CodeExpr)]
genArguments [Argument]
as [ArgumentFill]
afs)
genArguments (Arg Maybe NamedArgument
n (Basic Space
_ Maybe CodeVarChunk
Nothing):[Argument]
as) (BasicF CodeExpr
e:[ArgumentFill]
afs) = ([(Maybe NamedArgument, CodeExpr)]
 -> [(Maybe NamedArgument, CodeExpr)])
-> State ExtLibState [(Maybe NamedArgument, CodeExpr)]
-> State ExtLibState [(Maybe NamedArgument, CodeExpr)]
forall a b.
(a -> b)
-> StateT ExtLibState Identity a -> StateT ExtLibState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe NamedArgument
n,CodeExpr
e)(Maybe NamedArgument, CodeExpr)
-> [(Maybe NamedArgument, CodeExpr)]
-> [(Maybe NamedArgument, CodeExpr)]
forall a. a -> [a] -> [a]
:)
  ([Argument]
-> [ArgumentFill]
-> State ExtLibState [(Maybe NamedArgument, CodeExpr)]
genArguments [Argument]
as [ArgumentFill]
afs)
genArguments (Arg Maybe NamedArgument
n (Basic Space
_ (Just CodeVarChunk
v)):[Argument]
as) (BasicF CodeExpr
e:[ArgumentFill]
afs) = do
  (ExtLibState -> ExtLibState) -> State ExtLibState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (CodeExpr -> CodeVarChunk -> ExtLibState -> ExtLibState
addDef CodeExpr
e CodeVarChunk
v)
  ([(Maybe NamedArgument, CodeExpr)]
 -> [(Maybe NamedArgument, CodeExpr)])
-> State ExtLibState [(Maybe NamedArgument, CodeExpr)]
-> State ExtLibState [(Maybe NamedArgument, CodeExpr)]
forall a b.
(a -> b)
-> StateT ExtLibState Identity a -> StateT ExtLibState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe NamedArgument
n, CodeVarChunk -> CodeExpr
forall c. (IsChunk c, HasSymbol c) => c -> CodeExpr
forall r c. (ExprC r, IsChunk c, HasSymbol c) => c -> r
sy CodeVarChunk
v)(Maybe NamedArgument, CodeExpr)
-> [(Maybe NamedArgument, CodeExpr)]
-> [(Maybe NamedArgument, CodeExpr)]
forall a. a -> [a] -> [a]
:) ([Argument]
-> [ArgumentFill]
-> State ExtLibState [(Maybe NamedArgument, CodeExpr)]
genArguments [Argument]
as [ArgumentFill]
afs)
genArguments (Arg Maybe NamedArgument
n (Fn CodeFuncChunk
c [Parameter]
ps Step
s):[Argument]
as) (FnF [ParameterFill]
pfs StepFill
sf:[ArgumentFill]
afs) = do
  let prms :: [ParameterChunk]
prms = [Parameter] -> [ParameterFill] -> [ParameterChunk]
genParameters [Parameter]
ps [ParameterFill]
pfs
  st <- Step -> StepFill -> StateT ExtLibState Identity FuncStmt
genStep Step
s StepFill
sf
  modify (addFuncDef c prms [st])
  fmap ((n, sy c):) (genArguments as afs)
genArguments (Arg Maybe NamedArgument
n (Class [String]
rs String
desc CodeVarChunk
o CodeFuncChunk
ctor ClassInfo
ci):[Argument]
as) (ClassF [StateVariable]
svs ClassInfoFill
cif:[ArgumentFill]
afs) = do
  (c, is) <- CodeVarChunk
-> CodeFuncChunk
-> String
-> String
-> [StateVariable]
-> ClassInfo
-> ClassInfoFill
-> State ExtLibState (Class, [String])
genClassInfo CodeVarChunk
o CodeFuncChunk
ctor String
an String
desc [StateVariable]
svs ClassInfo
ci ClassInfoFill
cif
  modify (addMod (packmodRequires an desc (rs ++ is) [c] []))
  fmap ((n, sy o):) (genArguments as afs)
  where an :: String
an = Space -> String
getActorName (CodeVarChunk
o CodeVarChunk -> Getting Space CodeVarChunk Space -> Space
forall s a. s -> Getting a s a -> a
^. Getting Space CodeVarChunk Space
forall c. HasSpace c => Getter c Space
Getter CodeVarChunk Space
typ)
genArguments (Arg Maybe NamedArgument
n (Record (String
rq:|[String]
rqs) CodeFuncChunk
rn CodeVarChunk
r [CodeVarChunk]
fs):[Argument]
as) (RecordF [CodeExpr]
es:[ArgumentFill]
afs) =
  if [CodeVarChunk] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CodeVarChunk]
fs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [CodeExpr] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CodeExpr]
es then String -> State ExtLibState [(Maybe NamedArgument, CodeExpr)]
forall a. HasCallStack => String -> a
error String
recordFieldsMismatch else do
    (ExtLibState -> ExtLibState) -> State ExtLibState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (CodeVarChunk
-> [CodeVarChunk] -> [CodeExpr] -> ExtLibState -> ExtLibState
addFieldAsgs CodeVarChunk
r [CodeVarChunk]
fs [CodeExpr]
es (ExtLibState -> ExtLibState)
-> (ExtLibState -> ExtLibState) -> ExtLibState -> ExtLibState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeExpr -> CodeVarChunk -> ExtLibState -> ExtLibState
addDef (CodeFuncChunk -> [CodeExpr] -> CodeExpr
forall f.
(Callable f, IsChunk f, CodeIdea f) =>
f -> [CodeExpr] -> CodeExpr
forall r f.
(CodeExprC r, Callable f, IsChunk f, CodeIdea f) =>
f -> [r] -> r
new CodeFuncChunk
rn []) CodeVarChunk
r (ExtLibState -> ExtLibState)
-> (ExtLibState -> ExtLibState) -> ExtLibState -> ExtLibState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      (String, String) -> ExtLibState -> ExtLibState
addModExport (CodeFuncChunk -> String
forall c. CodeIdea c => c -> String
codeName CodeFuncChunk
rn, String
rq) (ExtLibState -> ExtLibState)
-> (ExtLibState -> ExtLibState) -> ExtLibState -> ExtLibState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> ExtLibState -> ExtLibState
addImports [String]
rqs)
    ([(Maybe NamedArgument, CodeExpr)]
 -> [(Maybe NamedArgument, CodeExpr)])
-> State ExtLibState [(Maybe NamedArgument, CodeExpr)]
-> State ExtLibState [(Maybe NamedArgument, CodeExpr)]
forall a b.
(a -> b)
-> StateT ExtLibState Identity a -> StateT ExtLibState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe NamedArgument
n, CodeVarChunk -> CodeExpr
forall c. (IsChunk c, HasSymbol c) => c -> CodeExpr
forall r c. (ExprC r, IsChunk c, HasSymbol c) => c -> r
sy CodeVarChunk
r)(Maybe NamedArgument, CodeExpr)
-> [(Maybe NamedArgument, CodeExpr)]
-> [(Maybe NamedArgument, CodeExpr)]
forall a. a -> [a] -> [a]
:) ([Argument]
-> [ArgumentFill]
-> State ExtLibState [(Maybe NamedArgument, CodeExpr)]
genArguments [Argument]
as [ArgumentFill]
afs)
genArguments [] [] = [(Maybe NamedArgument, CodeExpr)]
-> State ExtLibState [(Maybe NamedArgument, CodeExpr)]
forall a. a -> StateT ExtLibState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return []
genArguments [Argument]
_ [ArgumentFill]
_ = String -> State ExtLibState [(Maybe NamedArgument, CodeExpr)]
forall a. HasCallStack => String -> a
error String
argumentMismatch

-- | Interprets a 'ClassInfo' and 'ClassInfoFill'. These are required when a
-- 'customObjArg' is needed for an external library call, so the 'CodeVarChunk'
-- parameter represents the object of the class. The 'CodeFuncChunk' represents
-- the class's constructor. Other parameters are the name, description, and
-- state variables for the class.
genClassInfo :: CodeVarChunk -> CodeFuncChunk -> Name -> Description ->
  [StateVariable] -> ClassInfo -> ClassInfoFill ->
  State ExtLibState (Class, [String])
genClassInfo :: CodeVarChunk
-> CodeFuncChunk
-> String
-> String
-> [StateVariable]
-> ClassInfo
-> ClassInfoFill
-> State ExtLibState (Class, [String])
genClassInfo CodeVarChunk
o CodeFuncChunk
c String
n String
desc [StateVariable]
svs ClassInfo
ci ClassInfoFill
cif = let
  ([MethodInfo]
mis, [MethodInfoFill]
mifs, String -> [StateVariable] -> [Func] -> [Func] -> Class
f) = ClassInfo
-> ClassInfoFill
-> ([MethodInfo], [MethodInfoFill],
    String -> [StateVariable] -> [Func] -> [Func] -> Class)
genCI ClassInfo
ci ClassInfoFill
cif
  zMs :: [(MethodInfo, MethodInfoFill)]
zMs = [MethodInfo] -> [MethodInfoFill] -> [(MethodInfo, MethodInfoFill)]
forall a b. [a] -> [b] -> [(a, b)]
zip [MethodInfo]
mis [MethodInfoFill]
mifs
  ([(MethodInfo, MethodInfoFill)]
zCtrs, [(MethodInfo, MethodInfoFill)]
zMths) = ((MethodInfo, MethodInfoFill) -> Bool)
-> [(MethodInfo, MethodInfoFill)]
-> ([(MethodInfo, MethodInfoFill)], [(MethodInfo, MethodInfoFill)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\(MethodInfo
mi, MethodInfoFill
_) -> MethodInfo -> Bool
isConstructor MethodInfo
mi) [(MethodInfo, MethodInfoFill)]
zMs
  ([MethodInfo]
ctrIs, [MethodInfoFill]
ctrIFs) = [(MethodInfo, MethodInfoFill)] -> ([MethodInfo], [MethodInfoFill])
forall a b. [(a, b)] -> ([a], [b])
unzip [(MethodInfo, MethodInfoFill)]
zCtrs
  ([MethodInfo]
mthIs, [MethodInfoFill]
mthIFs) = [(MethodInfo, MethodInfoFill)] -> ([MethodInfo], [MethodInfoFill])
forall a b. [(a, b)] -> ([a], [b])
unzip [(MethodInfo, MethodInfoFill)]
zMths
  in
    if [MethodInfo] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [MethodInfo]
mis Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [MethodInfoFill] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [MethodInfoFill]
mifs then String -> State ExtLibState (Class, [String])
forall a. HasCallStack => String -> a
error String
methodInfoNumberMismatch else do
      cs <- (MethodInfo
 -> MethodInfoFill -> StateT ExtLibState Identity (Func, [String]))
-> [MethodInfo]
-> [MethodInfoFill]
-> StateT ExtLibState Identity [(Func, [String])]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (CodeVarChunk
-> CodeFuncChunk
-> MethodInfo
-> MethodInfoFill
-> StateT ExtLibState Identity (Func, [String])
genMethodInfo CodeVarChunk
o CodeFuncChunk
c) [MethodInfo]
ctrIs [MethodInfoFill]
ctrIFs
      ms <- zipWithM (genMethodInfo o c) mthIs mthIFs
      modify (if any isConstructor mis then id else addDef (new c []) o)
      return (f desc svs (map fst cs) (map fst ms), concatMap snd ms)
  where genCI :: ClassInfo
-> ClassInfoFill
-> ([MethodInfo], [MethodInfoFill],
    String -> [StateVariable] -> [Func] -> [Func] -> Class)
genCI (Regular [MethodInfo]
mis') (RegularF [MethodInfoFill]
mifs') = ([MethodInfo]
mis', [MethodInfoFill]
mifs', String -> String -> [StateVariable] -> [Func] -> [Func] -> Class
classDef String
n)
        genCI (Implements String
intn [MethodInfo]
mis') (ImplementsF [MethodInfoFill]
mifs') = ([MethodInfo]
mis', [MethodInfoFill]
mifs',
          String
-> String -> String -> [StateVariable] -> [Func] -> [Func] -> Class
classImplements String
n String
intn)
        genCI ClassInfo
_ ClassInfoFill
_ = String
-> ([MethodInfo], [MethodInfoFill],
    String -> [StateVariable] -> [Func] -> [Func] -> Class)
forall a. HasCallStack => String -> a
error String
classInfoMismatch

-- | Interprets a 'MethodInfo' and 'MethodInfoFill'. These are required when a
-- 'customObjArg' is needed for an external library call, so the 'CodeVarChunk'
-- parameter represents the object of the class. The 'CodeFuncChunk' represents
-- the class's constructor.
genMethodInfo :: CodeVarChunk -> CodeFuncChunk -> MethodInfo ->
  MethodInfoFill -> State ExtLibState (Func, [String])
genMethodInfo :: CodeVarChunk
-> CodeFuncChunk
-> MethodInfo
-> MethodInfoFill
-> StateT ExtLibState Identity (Func, [String])
genMethodInfo CodeVarChunk
o CodeFuncChunk
c (CI String
desc [Parameter]
ps [Step]
ss) (CIF [ParameterFill]
pfs [Initializer]
is [StepFill]
sfs) = do
  let prms :: [ParameterChunk]
prms = [Parameter] -> [ParameterFill] -> [ParameterChunk]
genParameters [Parameter]
ps [ParameterFill]
pfs
  (fs, newS) <- StateT ExtLibState Identity [FuncStmt]
-> State ExtLibState ([FuncStmt], ExtLibState)
forall a. State ExtLibState a -> State ExtLibState (a, ExtLibState)
withLocalState (StateT ExtLibState Identity [FuncStmt]
 -> State ExtLibState ([FuncStmt], ExtLibState))
-> StateT ExtLibState Identity [FuncStmt]
-> State ExtLibState ([FuncStmt], ExtLibState)
forall a b. (a -> b) -> a -> b
$ (Step -> StepFill -> StateT ExtLibState Identity FuncStmt)
-> [Step] -> [StepFill] -> StateT ExtLibState Identity [FuncStmt]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Step -> StepFill -> StateT ExtLibState Identity FuncStmt
genStep [Step]
ss [StepFill]
sfs
  modify (addDef (new c (map sy prms)) o)
  return (ctorDef (codeName c) desc prms is (newS ^. defs ++ fs),
    newS ^. imports)
genMethodInfo CodeVarChunk
_ CodeFuncChunk
_ (MI CodeFuncChunk
m String
desc [Parameter]
ps Maybe String
rDesc NonEmpty Step
ss) (MIF [ParameterFill]
pfs NonEmpty StepFill
sfs) = do
  let prms :: [ParameterChunk]
prms = [Parameter] -> [ParameterFill] -> [ParameterChunk]
genParameters [Parameter]
ps [ParameterFill]
pfs
  (fs, newS) <- StateT ExtLibState Identity [FuncStmt]
-> State ExtLibState ([FuncStmt], ExtLibState)
forall a. State ExtLibState a -> State ExtLibState (a, ExtLibState)
withLocalState ((Step -> StepFill -> StateT ExtLibState Identity FuncStmt)
-> [Step] -> [StepFill] -> StateT ExtLibState Identity [FuncStmt]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Step -> StepFill -> StateT ExtLibState Identity FuncStmt
genStep (NonEmpty Step -> [Step]
forall a. NonEmpty a -> [a]
toList NonEmpty Step
ss) (NonEmpty StepFill -> [StepFill]
forall a. NonEmpty a -> [a]
toList NonEmpty StepFill
sfs))
  return (funcDefParams (codeName m) desc prms (m ^. typ) rDesc (
    newS ^. defs ++ fs), newS ^. imports)
genMethodInfo CodeVarChunk
_ CodeFuncChunk
_ MethodInfo
_ MethodInfoFill
_ = String -> StateT ExtLibState Identity (Func, [String])
forall a. HasCallStack => String -> a
error String
methodInfoMismatch

-- | Interprets a list of 'Parameter' and a list of 'ParameterFill', resulting in
-- 'ParameterChunk's.
genParameters :: [Parameter] -> [ParameterFill] -> [ParameterChunk]
genParameters :: [Parameter] -> [ParameterFill] -> [ParameterChunk]
genParameters (LockedParam ParameterChunk
c:[Parameter]
ps) [ParameterFill]
pfs = ParameterChunk
c ParameterChunk -> [ParameterChunk] -> [ParameterChunk]
forall a. a -> [a] -> [a]
: [Parameter] -> [ParameterFill] -> [ParameterChunk]
genParameters [Parameter]
ps [ParameterFill]
pfs
genParameters [Parameter]
ps (UserDefined ParameterChunk
c:[ParameterFill]
pfs) = ParameterChunk
c ParameterChunk -> [ParameterChunk] -> [ParameterChunk]
forall a. a -> [a] -> [a]
: [Parameter] -> [ParameterFill] -> [ParameterChunk]
genParameters [Parameter]
ps [ParameterFill]
pfs
genParameters (NameableParam Space
_:[Parameter]
ps) (NameableParamF ParameterChunk
c:[ParameterFill]
pfs) = ParameterChunk
c ParameterChunk -> [ParameterChunk] -> [ParameterChunk]
forall a. a -> [a] -> [a]
:
  [Parameter] -> [ParameterFill] -> [ParameterChunk]
genParameters [Parameter]
ps [ParameterFill]
pfs
genParameters [] [] = []
genParameters [Parameter]
_ [ParameterFill]
_ = String -> [ParameterChunk]
forall a. HasCallStack => String -> a
error String
paramMismatch

-- | Interprets a 'Result', which determines which 'FuncStmt' constructor should be
-- used for a defining statement. If no result, the statement is just the value
-- for the function call. If result is assigned, the statement is an
-- assignment. If the result is returned, the statement is a return statement.
maybeGenAssg :: Maybe Result -> (CodeExpr -> FuncStmt)
maybeGenAssg :: Maybe Result -> CodeExpr -> FuncStmt
maybeGenAssg Maybe Result
Nothing = CodeExpr -> FuncStmt
FVal
maybeGenAssg (Just (Assign CodeVarChunk
c)) = CodeVarChunk -> CodeExpr -> FuncStmt
FDecDef CodeVarChunk
c
maybeGenAssg (Just Result
Return)  = CodeExpr -> FuncStmt
FRet

-- Helpers

-- | Run a stateful value with refreshed local state, and return the resulting value and modified state. Reverts back to the original state before returning.
withLocalState :: State ExtLibState a -> State ExtLibState (a, ExtLibState)
withLocalState :: forall a. State ExtLibState a -> State ExtLibState (a, ExtLibState)
withLocalState State ExtLibState a
st = do
  s <- StateT ExtLibState Identity ExtLibState
forall s (m :: * -> *). MonadState s m => m s
get
  modify refreshLocal
  st' <- st
  newS <- get
  modify (returnLocal s)
  return (st', newS)

-- Error messages
-- | Various error messages.
elAndElc, stepNumberMismatch, stepTypeMismatch, argumentMismatch,
  paramMismatch, recordFieldsMismatch, ciAndCif, classInfoMismatch,
  methodInfoNumberMismatch, methodInfoMismatch :: String
elAndElc :: String
elAndElc = String
"ExternalLibrary and ExternalLibraryCall have different "
stepNumberMismatch :: String
stepNumberMismatch = String
elAndElc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"number of steps"
stepTypeMismatch :: String
stepTypeMismatch = String
elAndElc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"order of steps"
argumentMismatch :: String
argumentMismatch = String
"FunctionInterface and FunctionIntFill have different number or types of arguments"
paramMismatch :: String
paramMismatch = String
"Parameters mismatched with ParameterFills"
recordFieldsMismatch :: String
recordFieldsMismatch = String
"Different number of record fields than field values"
ciAndCif :: String
ciAndCif = String
"ClassInfo and ClassInfoFill have different "
classInfoMismatch :: String
classInfoMismatch = String
ciAndCif String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"class types"
methodInfoNumberMismatch :: String
methodInfoNumberMismatch = String
ciAndCif String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"number of MethodInfos/MethodInfoFills"
methodInfoMismatch :: String
methodInfoMismatch = String
"MethodInfo and MethodInfoFill have different method types"