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

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

import Language.Drasil.Chunk.Code (CodeVarChunk, CodeFuncChunk, codeName,
  ccObjVar)
import Language.Drasil.Chunk.Parameter (ParameterChunk)
import Language.Drasil.Chunk.NamedArgument (NamedArgument)
import Language.Drasil.CodeExpr (CodeExpr, ($&&), applyWithNamedArgs,
  msgWithNamedArgs, new, newWithNamedArgs, sy)
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(..))
import Language.Drasil.Code.ExternalLibraryCall (ExternalLibraryCall,
  StepGroupFill(..), StepFill(..), FunctionIntFill(..), ArgumentFill(..),
  ParameterFill(..), ClassInfoFill(..), MethodInfoFill(..))

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 Prelude hiding ((!!))

-- | 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 = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' ExtLibState [Mod]
auxMods (Mod
mforall 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (ExtLibState
s forall s a. s -> Getting a s a -> a
^. Lens' ExtLibState [String]
defined)
               then ExtLibState
s
               else forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' ExtLibState [FuncStmt]
defs (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 = 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (ExtLibState
s forall s a. s -> Getting a s a -> a
^. Lens' ExtLibState [String]
defined) then ExtLibState
s else forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' ExtLibState [FuncStmt]
defs
  (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 = 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 = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' ExtLibState [FuncStmt]
defs (forall a. [a] -> [a] -> [a]
++ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith CodeVarChunk -> CodeExpr -> FuncStmt
FAsg (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 = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' ExtLibState [String]
defined (String
nforall a. a -> [a] -> [a]
:)

-- | Adds a list of imports to the 'ExtLibState'.
addImports :: [String] -> ExtLibState -> ExtLibState
addImports :: [String] -> ExtLibState -> ExtLibState
addImports [String]
is = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' ExtLibState [String]
imports (\[String]
l -> forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ [String]
l 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 = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' ExtLibState [(String, String)]
modExports ((String, String)
eforall 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 = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' ExtLibState [FuncStmt]
steps (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 :: [FuncStmt]
_defs = [], _defined :: [String]
_defined = [], _imports :: [String]
_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 :: [FuncStmt]
_defs = ExtLibState
oldS forall s a. s -> Getting a s a -> a
^. Lens' ExtLibState [FuncStmt]
defs,
                              _defined :: [String]
_defined = ExtLibState
oldS forall s a. s -> Getting a s a -> a
^. Lens' ExtLibState [String]
defined,
                              _imports :: [String]
_imports = ExtLibState
oldS forall s a. s -> Getting a s a -> a
^. Lens' ExtLibState [String]
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 = 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 [] [] = 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
sgforall a. NonEmpty a -> Int -> a
!!Int
n in
  if forall (t :: * -> *) a. Foldable t => t a -> Int
length [Step]
s forall a. Eq a => a -> a -> Bool
/= forall (t :: * -> *) a. Foldable t => t a -> Int
length [StepFill]
sgf then forall a. HasCallStack => String -> a
error String
stepNumberMismatch else do
    [FuncStmt]
fs <- forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Step -> StepFill -> State ExtLibState FuncStmt
genStep [Step]
s [StepFill]
sgf
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ([FuncStmt] -> ExtLibState -> ExtLibState
addSteps [FuncStmt]
fs)
    ExternalLibrary -> ExternalLibraryCall -> State ExtLibState ()
genExtLibCall ExternalLibrary
el ExternalLibraryCall
elc
genExtLibCall ExternalLibrary
_ ExternalLibraryCall
_ = 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 -> State ExtLibState FuncStmt
genStep (Call FunctionInterface
fi) (CallF FunctionIntFill
fif) = FunctionInterface -> FunctionIntFill -> State ExtLibState 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
  [CodeExpr]
es <- forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM FunctionInterface -> FunctionIntFill -> State ExtLibState CodeExpr
genFIVal (forall a. NonEmpty a -> [a]
toList NonEmpty FunctionInterface
fis) (forall a. NonEmpty a -> [a]
toList NonEmpty FunctionIntFill
fifs)
  [FuncStmt]
fs <- forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Step -> StepFill -> State ExtLibState FuncStmt
genStep (forall a. NonEmpty a -> [a]
toList NonEmpty Step
ss) (forall a. NonEmpty a -> [a]
toList NonEmpty StepFill
sfs)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CodeExpr -> [FuncStmt] -> FuncStmt
FWhile (forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 forall r. ExprC r => r -> r -> r
($&&) [CodeExpr]
es forall r. ExprC r => r -> r -> r
$&& [CodeExpr] -> CodeExpr
f [CodeExpr]
ccList) [FuncStmt]
fs
genStep (Statement [CodeVarChunk] -> [CodeExpr] -> FuncStmt
f) (StatementF [CodeVarChunk]
ccList [CodeExpr]
exList) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [CodeVarChunk] -> [CodeExpr] -> FuncStmt
f [CodeVarChunk]
ccList [CodeExpr]
exList
genStep Step
_ StepFill
_ = 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 -> State ExtLibState CodeExpr
genFIVal (FI (String
r:|[String]
rs) FuncType
ft CodeFuncChunk
f [Argument]
as Maybe Result
_) (FIF [ArgumentFill]
afs) = do
  [(Maybe NamedArgument, CodeExpr)]
args <- [Argument]
-> [ArgumentFill]
-> State ExtLibState [(Maybe NamedArgument, CodeExpr)]
genArguments [Argument]
as [ArgumentFill]
afs
  let isNamed :: (Maybe a, b) -> Bool
isNamed = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst
      ([(Maybe NamedArgument, CodeExpr)]
nas, [(Maybe NamedArgument, CodeExpr)]
ars) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition forall {a} {b}. (Maybe a, b) -> Bool
isNamed [(Maybe NamedArgument, CodeExpr)]
args
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ([String] -> ExtLibState -> ExtLibState
addImports [String]
rs forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> ExtLibState -> ExtLibState
addModExport (forall c. CodeIdea c => c -> String
codeName CodeFuncChunk
f, String
r))
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall {r} {f} {a}.
(CodeExprC r, HasUID f, HasUID a, IsArgumentName a, Callable f,
 CodeIdea f) =>
FuncType -> f -> [r] -> [(a, r)] -> r
getCallFunc FuncType
ft CodeFuncChunk
f (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Maybe NamedArgument, CodeExpr)]
ars) (forall a b. (a -> b) -> [a] -> [b]
map (\(Maybe NamedArgument
n, CodeExpr
e) ->
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => String -> a
error String
"defective isNamed") (,CodeExpr
e) Maybe NamedArgument
n) [(Maybe NamedArgument, CodeExpr)]
nas)
  where getCallFunc :: FuncType -> f -> [r] -> [(a, r)] -> r
getCallFunc FuncType
Function = forall r f a.
(CodeExprC r, HasUID f, HasSymbol f, HasUID a, IsArgumentName a) =>
f -> [r] -> [(a, r)] -> r
applyWithNamedArgs
        getCallFunc (Method CodeVarChunk
o) = forall r f c a.
(CodeExprC r, Callable f, HasUID f, CodeIdea f, HasUID c,
 HasSpace c, CodeIdea c, HasUID a, IsArgumentName a) =>
c -> f -> [r] -> [(a, r)] -> r
msgWithNamedArgs CodeVarChunk
o
        getCallFunc FuncType
Constructor = forall r f a.
(CodeExprC r, Callable f, HasUID f, CodeIdea f, HasUID 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 -> State ExtLibState FuncStmt
genFI fi :: FunctionInterface
fi@(FI NonEmpty String
_ FuncType
_ CodeFuncChunk
_ [Argument]
_ Maybe Result
r) FunctionIntFill
fif = do
  CodeExpr
fiEx <- FunctionInterface -> FunctionIntFill -> State ExtLibState CodeExpr
genFIVal FunctionInterface
fi FunctionIntFill
fif
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe Result -> CodeExpr -> FuncStmt
maybeGenAssg Maybe Result
r CodeExpr
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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe NamedArgument
n,CodeExpr
e)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) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe NamedArgument
n,CodeExpr
e)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) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe NamedArgument
n,CodeExpr
e)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
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (CodeExpr -> CodeVarChunk -> ExtLibState -> ExtLibState
addDef CodeExpr
e CodeVarChunk
v)
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe NamedArgument
n, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy CodeVarChunk
v)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
  FuncStmt
st <- Step -> StepFill -> State ExtLibState FuncStmt
genStep Step
s StepFill
sf
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (CodeFuncChunk
-> [ParameterChunk] -> [FuncStmt] -> ExtLibState -> ExtLibState
addFuncDef CodeFuncChunk
c [ParameterChunk]
prms [FuncStmt
st])
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe NamedArgument
n, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy CodeFuncChunk
c)forall a. a -> [a] -> [a]
:) ([Argument]
-> [ArgumentFill]
-> State ExtLibState [(Maybe NamedArgument, CodeExpr)]
genArguments [Argument]
as [ArgumentFill]
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
  (Class
c, [String]
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
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Mod -> ExtLibState -> ExtLibState
addMod (String -> String -> [String] -> [Class] -> [Func] -> Mod
packmodRequires String
an String
desc ([String]
rs forall a. [a] -> [a] -> [a]
++ [String]
is) [Class
c] []))
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe NamedArgument
n, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy CodeVarChunk
o)forall a. a -> [a] -> [a]
:) ([Argument]
-> [ArgumentFill]
-> State ExtLibState [(Maybe NamedArgument, CodeExpr)]
genArguments [Argument]
as [ArgumentFill]
afs)
  where an :: String
an = Space -> String
getActorName (CodeVarChunk
o forall s a. s -> Getting a s a -> a
^. forall c. HasSpace c => Getter c 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 forall (t :: * -> *) a. Foldable t => t a -> Int
length [CodeVarChunk]
fs forall a. Eq a => a -> a -> Bool
/= forall (t :: * -> *) a. Foldable t => t a -> Int
length [CodeExpr]
es then forall a. HasCallStack => String -> a
error String
recordFieldsMismatch else do
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (CodeVarChunk
-> [CodeVarChunk] -> [CodeExpr] -> ExtLibState -> ExtLibState
addFieldAsgs CodeVarChunk
r [CodeVarChunk]
fs [CodeExpr]
es forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeExpr -> CodeVarChunk -> ExtLibState -> ExtLibState
addDef (forall r f.
(CodeExprC r, Callable f, HasUID f, CodeIdea f) =>
f -> [r] -> r
new CodeFuncChunk
rn []) CodeVarChunk
r forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      (String, String) -> ExtLibState -> ExtLibState
addModExport (forall c. CodeIdea c => c -> String
codeName CodeFuncChunk
rn, String
rq) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> ExtLibState -> ExtLibState
addImports [String]
rqs)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe NamedArgument
n, forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy CodeVarChunk
r)forall a. a -> [a] -> [a]
:) ([Argument]
-> [ArgumentFill]
-> State ExtLibState [(Maybe NamedArgument, CodeExpr)]
genArguments [Argument]
as [ArgumentFill]
afs)
genArguments [] [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
genArguments [Argument]
_ [ArgumentFill]
_ = 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] -> Class
f) = ClassInfo
-> ClassInfoFill
-> ([MethodInfo], [MethodInfoFill],
    String -> [StateVariable] -> [Func] -> Class)
genCI ClassInfo
ci ClassInfoFill
cif in
  if forall (t :: * -> *) a. Foldable t => t a -> Int
length [MethodInfo]
mis forall a. Eq a => a -> a -> Bool
/= forall (t :: * -> *) a. Foldable t => t a -> Int
length [MethodInfoFill]
mifs then forall a. HasCallStack => String -> a
error String
methodInfoNumberMismatch else do
    [(Func, [String])]
ms <- forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (CodeVarChunk
-> CodeFuncChunk
-> MethodInfo
-> MethodInfoFill
-> State ExtLibState (Func, [String])
genMethodInfo CodeVarChunk
o CodeFuncChunk
c) [MethodInfo]
mis [MethodInfoFill]
mifs
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any MethodInfo -> Bool
isConstructor [MethodInfo]
mis then forall a. a -> a
id else CodeExpr -> CodeVarChunk -> ExtLibState -> ExtLibState
addDef (forall r f.
(CodeExprC r, Callable f, HasUID f, CodeIdea f) =>
f -> [r] -> r
new CodeFuncChunk
c []) CodeVarChunk
o)
    forall (m :: * -> *) a. Monad m => a -> m a
return (String -> [StateVariable] -> [Func] -> Class
f String
desc [StateVariable]
svs (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Func, [String])]
ms), forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd [(Func, [String])]
ms)
  where genCI :: ClassInfo
-> ClassInfoFill
-> ([MethodInfo], [MethodInfoFill],
    String -> [StateVariable] -> [Func] -> Class)
genCI (Regular [MethodInfo]
mis') (RegularF [MethodInfoFill]
mifs') = ([MethodInfo]
mis', [MethodInfoFill]
mifs', String -> String -> [StateVariable] -> [Func] -> Class
classDef String
n)
        genCI (Implements String
intn [MethodInfo]
mis') (ImplementsF [MethodInfoFill]
mifs') = ([MethodInfo]
mis', [MethodInfoFill]
mifs',
          String -> String -> String -> [StateVariable] -> [Func] -> Class
classImplements String
n String
intn)
        genCI ClassInfo
_ ClassInfoFill
_ = 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
-> State ExtLibState (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
  ([FuncStmt]
fs, ExtLibState
newS) <- forall a. State ExtLibState a -> State ExtLibState (a, ExtLibState)
withLocalState forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Step -> StepFill -> State ExtLibState FuncStmt
genStep [Step]
ss [StepFill]
sfs
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (CodeExpr -> CodeVarChunk -> ExtLibState -> ExtLibState
addDef (forall r f.
(CodeExprC r, Callable f, HasUID f, CodeIdea f) =>
f -> [r] -> r
new CodeFuncChunk
c (forall a b. (a -> b) -> [a] -> [b]
map forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy [ParameterChunk]
prms)) CodeVarChunk
o)
  forall (m :: * -> *) a. Monad m => a -> m a
return (String
-> String
-> [ParameterChunk]
-> [Initializer]
-> [FuncStmt]
-> Func
ctorDef (forall c. CodeIdea c => c -> String
codeName CodeFuncChunk
c) String
desc [ParameterChunk]
prms [Initializer]
is (ExtLibState
newS forall s a. s -> Getting a s a -> a
^. Lens' ExtLibState [FuncStmt]
defs forall a. [a] -> [a] -> [a]
++ [FuncStmt]
fs),
    ExtLibState
newS forall s a. s -> Getting a s a -> a
^. Lens' ExtLibState [String]
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
  ([FuncStmt]
fs, ExtLibState
newS) <- forall a. State ExtLibState a -> State ExtLibState (a, ExtLibState)
withLocalState (forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Step -> StepFill -> State ExtLibState FuncStmt
genStep (forall a. NonEmpty a -> [a]
toList NonEmpty Step
ss) (forall a. NonEmpty a -> [a]
toList NonEmpty StepFill
sfs))
  forall (m :: * -> *) a. Monad m => a -> m a
return (String
-> String
-> [ParameterChunk]
-> Space
-> Maybe String
-> [FuncStmt]
-> Func
funcDefParams (forall c. CodeIdea c => c -> String
codeName CodeFuncChunk
m) String
desc [ParameterChunk]
prms (CodeFuncChunk
m forall s a. s -> Getting a s a -> a
^. forall c. HasSpace c => Getter c Space
typ) Maybe String
rDesc (
    ExtLibState
newS forall s a. s -> Getting a s a -> a
^. Lens' ExtLibState [FuncStmt]
defs forall a. [a] -> [a] -> [a]
++ [FuncStmt]
fs), ExtLibState
newS forall s a. s -> Getting a s a -> a
^. Lens' ExtLibState [String]
imports)
genMethodInfo CodeVarChunk
_ CodeFuncChunk
_ MethodInfo
_ MethodInfoFill
_ = 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 forall a. a -> [a] -> [a]
: [Parameter] -> [ParameterFill] -> [ParameterChunk]
genParameters [Parameter]
ps [ParameterFill]
pfs
genParameters [Parameter]
ps (UserDefined ParameterChunk
c:[ParameterFill]
pfs) = ParameterChunk
c 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 forall a. a -> [a] -> [a]
:
  [Parameter] -> [ParameterFill] -> [ParameterChunk]
genParameters [Parameter]
ps [ParameterFill]
pfs
genParameters [] [] = []
genParameters [Parameter]
_ [ParameterFill]
_ = 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
  ExtLibState
s <- forall s (m :: * -> *). MonadState s m => m s
get
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ExtLibState -> ExtLibState
refreshLocal
  a
st' <- State ExtLibState a
st
  ExtLibState
newS <- forall s (m :: * -> *). MonadState s m => m s
get
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ExtLibState -> ExtLibState -> ExtLibState
returnLocal ExtLibState
s)
  forall (m :: * -> *) a. Monad m => a -> m a
return (a
st', ExtLibState
newS)

-- | Predicate that is true only if then MethodInfo is a constructor.
isConstructor :: MethodInfo -> Bool
isConstructor :: MethodInfo -> Bool
isConstructor CI{} = Bool
True
isConstructor MethodInfo
_    = Bool
False

-- 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 forall a. [a] -> [a] -> [a]
++ String
"number of steps"
stepTypeMismatch :: String
stepTypeMismatch = String
elAndElc 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 forall a. [a] -> [a] -> [a]
++ String
"class types"
methodInfoNumberMismatch :: String
methodInfoNumberMismatch = String
ciAndCif forall a. [a] -> [a] -> [a]
++ String
"number of MethodInfos/MethodInfoFills"
methodInfoMismatch :: String
methodInfoMismatch = String
"MethodInfo and MethodInfoFill have different method types"