{-# LANGUAGE TemplateHaskell, TupleSections #-}
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 ((!!))
data ExtLibState = ELS {
ExtLibState -> [Mod]
_auxMods :: [Mod],
ExtLibState -> [FuncStmt]
_defs :: [FuncStmt],
ExtLibState -> [String]
_defined :: [Name],
ExtLibState -> [FuncStmt]
_steps :: [FuncStmt],
ExtLibState -> [String]
_imports :: [String],
ExtLibState -> [(String, String)]
_modExports :: [(Name, Name)]
}
makeLenses ''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 = []
}
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]
:)
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
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
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)
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]
:)
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)
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]
:)
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)
refreshLocal :: ExtLibState -> ExtLibState
refreshLocal :: ExtLibState -> ExtLibState
refreshLocal ExtLibState
s = ExtLibState
s {_defs = [], _defined = [], _imports = []}
returnLocal :: ExtLibState -> ExtLibState -> ExtLibState
returnLocal :: ExtLibState -> ExtLibState -> ExtLibState
returnLocal ExtLibState
oldS ExtLibState
newS = ExtLibState
newS {_defs = oldS ^. defs,
_defined = oldS ^. defined,
_imports = oldS ^. imports}
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
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
[FuncStmt]
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
(ExtLibState -> ExtLibState) -> State ExtLibState ()
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
_ = String -> State ExtLibState ()
forall a. HasCallStack => String -> a
error String
stepNumberMismatch
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
[CodeExpr]
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)
[FuncStmt]
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 (NonEmpty Step -> [Step]
forall a. NonEmpty a -> [a]
toList NonEmpty Step
ss) (NonEmpty StepFill -> [StepFill]
forall a. NonEmpty a -> [a]
toList NonEmpty StepFill
sfs)
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
$ CodeExpr -> [FuncStmt] -> FuncStmt
FWhile ((CodeExpr -> CodeExpr -> CodeExpr) -> [CodeExpr] -> CodeExpr
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 CodeExpr -> CodeExpr -> CodeExpr
forall r. ExprC r => r -> r -> r
($&&) [CodeExpr]
es CodeExpr -> CodeExpr -> CodeExpr
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) = 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
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
[(Maybe NamedArgument, CodeExpr)]
args <- [Argument]
-> [ArgumentFill]
-> State ExtLibState [(Maybe NamedArgument, CodeExpr)]
genArguments [Argument]
as [ArgumentFill]
afs
let isNamed :: (Maybe a, b) -> Bool
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
([(Maybe NamedArgument, CodeExpr)]
nas, [(Maybe NamedArgument, CodeExpr)]
ars) = ((Maybe NamedArgument, CodeExpr) -> Bool)
-> [(Maybe NamedArgument, CodeExpr)]
-> ([(Maybe NamedArgument, CodeExpr)],
[(Maybe NamedArgument, CodeExpr)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Maybe NamedArgument, CodeExpr) -> Bool
forall {a} {b}. (Maybe a, b) -> Bool
isNamed [(Maybe NamedArgument, CodeExpr)]
args
(ExtLibState -> ExtLibState) -> State ExtLibState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ([String] -> ExtLibState -> ExtLibState
addImports [String]
rs (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
f, String
r))
CodeExpr -> StateT ExtLibState Identity CodeExpr
forall a. a -> StateT ExtLibState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (CodeExpr -> StateT ExtLibState Identity CodeExpr)
-> CodeExpr -> StateT ExtLibState Identity CodeExpr
forall a b. (a -> b) -> a -> b
$ FuncType
-> CodeFuncChunk
-> [CodeExpr]
-> [(NamedArgument, CodeExpr)]
-> CodeExpr
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 (((Maybe NamedArgument, CodeExpr) -> CodeExpr)
-> [(Maybe NamedArgument, CodeExpr)] -> [CodeExpr]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe NamedArgument, CodeExpr) -> CodeExpr
forall a b. (a, b) -> b
snd [(Maybe NamedArgument, CodeExpr)]
ars) (((Maybe NamedArgument, CodeExpr) -> (NamedArgument, CodeExpr))
-> [(Maybe NamedArgument, CodeExpr)] -> [(NamedArgument, CodeExpr)]
forall a b. (a -> b) -> [a] -> [b]
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) [(Maybe NamedArgument, CodeExpr)]
nas)
where getCallFunc :: FuncType -> f -> [r] -> [(a, r)] -> r
getCallFunc FuncType
Function = f -> [r] -> [(a, r)] -> r
forall r f a.
(CodeExprC r, HasUID f, HasSymbol f, HasUID a, IsArgumentName a) =>
f -> [r] -> [(a, r)] -> r
forall f a.
(HasUID f, HasSymbol f, HasUID 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, HasUID f, CodeIdea f, HasUID c,
HasSpace c, CodeIdea c, HasUID a, IsArgumentName a) =>
c -> f -> [r] -> [(a, r)] -> r
forall f c a.
(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 = f -> [r] -> [(a, r)] -> r
forall r f a.
(CodeExprC r, Callable f, HasUID f, CodeIdea f, HasUID a,
IsArgumentName a) =>
f -> [r] -> [(a, r)] -> r
forall f a.
(Callable f, HasUID f, CodeIdea f, HasUID a, IsArgumentName a) =>
f -> [r] -> [(a, r)] -> r
newWithNamedArgs
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
CodeExpr
fiEx <- FunctionInterface
-> FunctionIntFill -> StateT ExtLibState Identity CodeExpr
genFIVal FunctionInterface
fi FunctionIntFill
fif
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
$ Maybe Result -> CodeExpr -> FuncStmt
maybeGenAssg Maybe Result
r CodeExpr
fiEx
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. (HasUID c, HasSymbol c) => c -> CodeExpr
forall r c. (ExprC r, HasUID 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
FuncStmt
st <- Step -> StepFill -> StateT ExtLibState Identity FuncStmt
genStep Step
s StepFill
sf
(ExtLibState -> ExtLibState) -> State ExtLibState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (CodeFuncChunk
-> [ParameterChunk] -> [FuncStmt] -> ExtLibState -> ExtLibState
addFuncDef CodeFuncChunk
c [ParameterChunk]
prms [FuncStmt
st])
([(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, CodeFuncChunk -> CodeExpr
forall c. (HasUID c, HasSymbol c) => c -> CodeExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy CodeFuncChunk
c)(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 (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
(ExtLibState -> ExtLibState) -> State ExtLibState ()
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 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
is) [Class
c] []))
([(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. (HasUID c, HasSymbol c) => c -> CodeExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy CodeVarChunk
o)(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)
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, HasUID f, CodeIdea f) =>
f -> [CodeExpr] -> CodeExpr
forall r f.
(CodeExprC r, Callable f, HasUID 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. (HasUID c, HasSymbol c) => c -> CodeExpr
forall r c. (ExprC r, HasUID 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
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
[(Func, [String])]
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
[(Func, [String])]
ms <- (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]
mthIs [MethodInfoFill]
mthIFs
(ExtLibState -> ExtLibState) -> State ExtLibState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (if (MethodInfo -> Bool) -> [MethodInfo] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any MethodInfo -> Bool
isConstructor [MethodInfo]
mis then ExtLibState -> ExtLibState
forall a. a -> a
id else CodeExpr -> CodeVarChunk -> ExtLibState -> ExtLibState
addDef (CodeFuncChunk -> [CodeExpr] -> CodeExpr
forall f.
(Callable f, HasUID f, CodeIdea f) =>
f -> [CodeExpr] -> CodeExpr
forall r f.
(CodeExprC r, Callable f, HasUID f, CodeIdea f) =>
f -> [r] -> r
new CodeFuncChunk
c []) CodeVarChunk
o)
(Class, [String]) -> State ExtLibState (Class, [String])
forall a. a -> StateT ExtLibState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> [StateVariable] -> [Func] -> [Func] -> Class
f String
desc [StateVariable]
svs (((Func, [String]) -> Func) -> [(Func, [String])] -> [Func]
forall a b. (a -> b) -> [a] -> [b]
map (Func, [String]) -> Func
forall a b. (a, b) -> a
fst [(Func, [String])]
cs) (((Func, [String]) -> Func) -> [(Func, [String])] -> [Func]
forall a b. (a -> b) -> [a] -> [b]
map (Func, [String]) -> Func
forall a b. (a, b) -> a
fst [(Func, [String])]
ms), ((Func, [String]) -> [String]) -> [(Func, [String])] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Func, [String]) -> [String]
forall a b. (a, b) -> b
snd [(Func, [String])]
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
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
([FuncStmt]
fs, ExtLibState
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
(ExtLibState -> ExtLibState) -> State ExtLibState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (CodeExpr -> CodeVarChunk -> ExtLibState -> ExtLibState
addDef (CodeFuncChunk -> [CodeExpr] -> CodeExpr
forall f.
(Callable f, HasUID f, CodeIdea f) =>
f -> [CodeExpr] -> CodeExpr
forall r f.
(CodeExprC r, Callable f, HasUID f, CodeIdea f) =>
f -> [r] -> r
new CodeFuncChunk
c ((ParameterChunk -> CodeExpr) -> [ParameterChunk] -> [CodeExpr]
forall a b. (a -> b) -> [a] -> [b]
map ParameterChunk -> CodeExpr
forall c. (HasUID c, HasSymbol c) => c -> CodeExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy [ParameterChunk]
prms)) CodeVarChunk
o)
(Func, [String]) -> StateT ExtLibState Identity (Func, [String])
forall a. a -> StateT ExtLibState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
-> String
-> [ParameterChunk]
-> [Initializer]
-> [FuncStmt]
-> Func
ctorDef (CodeFuncChunk -> String
forall c. CodeIdea c => c -> String
codeName CodeFuncChunk
c) String
desc [ParameterChunk]
prms [Initializer]
is (ExtLibState
newS ExtLibState
-> Getting [FuncStmt] ExtLibState [FuncStmt] -> [FuncStmt]
forall s a. s -> Getting a s a -> a
^. Getting [FuncStmt] ExtLibState [FuncStmt]
Lens' ExtLibState [FuncStmt]
defs [FuncStmt] -> [FuncStmt] -> [FuncStmt]
forall a. [a] -> [a] -> [a]
++ [FuncStmt]
fs),
ExtLibState
newS ExtLibState -> Getting [String] ExtLibState [String] -> [String]
forall s a. s -> Getting a s a -> a
^. Getting [String] ExtLibState [String]
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) <- 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))
(Func, [String]) -> StateT ExtLibState Identity (Func, [String])
forall a. a -> StateT ExtLibState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
-> String
-> [ParameterChunk]
-> Space
-> Maybe String
-> [FuncStmt]
-> Func
funcDefParams (CodeFuncChunk -> String
forall c. CodeIdea c => c -> String
codeName CodeFuncChunk
m) String
desc [ParameterChunk]
prms (CodeFuncChunk
m CodeFuncChunk -> Getting Space CodeFuncChunk Space -> Space
forall s a. s -> Getting a s a -> a
^. Getting Space CodeFuncChunk Space
forall c. HasSpace c => Getter c Space
Getter CodeFuncChunk Space
typ) Maybe String
rDesc (
ExtLibState
newS ExtLibState
-> Getting [FuncStmt] ExtLibState [FuncStmt] -> [FuncStmt]
forall s a. s -> Getting a s a -> a
^. Getting [FuncStmt] ExtLibState [FuncStmt]
Lens' ExtLibState [FuncStmt]
defs [FuncStmt] -> [FuncStmt] -> [FuncStmt]
forall a. [a] -> [a] -> [a]
++ [FuncStmt]
fs), ExtLibState
newS ExtLibState -> Getting [String] ExtLibState [String] -> [String]
forall s a. s -> Getting a s a -> a
^. Getting [String] ExtLibState [String]
Lens' ExtLibState [String]
imports)
genMethodInfo CodeVarChunk
_ CodeFuncChunk
_ MethodInfo
_ MethodInfoFill
_ = String -> StateT ExtLibState Identity (Func, [String])
forall a. HasCallStack => String -> a
error String
methodInfoMismatch
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
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
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 <- StateT ExtLibState Identity ExtLibState
forall s (m :: * -> *). MonadState s m => m s
get
(ExtLibState -> ExtLibState) -> State ExtLibState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ExtLibState -> ExtLibState
refreshLocal
a
st' <- State ExtLibState a
st
ExtLibState
newS <- StateT ExtLibState Identity ExtLibState
forall s (m :: * -> *). MonadState s m => m s
get
(ExtLibState -> ExtLibState) -> State ExtLibState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ExtLibState -> ExtLibState -> ExtLibState
returnLocal ExtLibState
s)
(a, ExtLibState) -> State ExtLibState (a, ExtLibState)
forall a. a -> StateT ExtLibState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
st', ExtLibState
newS)
isConstructor :: MethodInfo -> Bool
isConstructor :: MethodInfo -> Bool
isConstructor CI{} = Bool
True
isConstructor MethodInfo
_ = Bool
False
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"