{-# LANGUAGE LambdaCase #-}
-- | Defines a language for specifying external library use scenarios
module Language.Drasil.Code.ExternalLibrary (ExternalLibrary, Step(..),
  FunctionInterface(..), Result(..), Argument(..), ArgumentInfo(..),
  Parameter(..), ClassInfo(..), MethodInfo(..), FuncType(..), externalLib,
  choiceSteps, choiceStep, mandatoryStep, mandatorySteps, callStep,
  libFunction, libMethod, libFunctionWithResult, libMethodWithResult,
  libConstructor, libConstructorMultiReqs, constructAndReturn, lockedArg,
  lockedNamedArg, inlineArg, inlineNamedArg, preDefinedArg, preDefinedNamedArg,
  functionArg, customObjArg, recordArg, lockedParam, unnamedParam, customClass,
  implementation, constructorInfo, methodInfo, methodInfoNoReturn,
  appendCurrSol, populateSolList, assignArrayIndex, assignSolFromObj,
  initSolListFromArray, initSolListWithVal, solveAndPopulateWhile,
  returnExprList, fixedReturn, fixedReturn', initSolWithVal
) where

import Language.Drasil (Space, HasSpace(typ))
import Language.Drasil.Chunk.Code (CodeVarChunk, CodeFuncChunk, codeName)
import Language.Drasil.Chunk.Parameter (ParameterChunk, pcAuto)
import Language.Drasil.Chunk.NamedArgument (NamedArgument)
import Language.Drasil.CodeExpr.Development
import Language.Drasil.CodeExpr
import Language.Drasil.Mod (FuncStmt(..), Description)

import Control.Lens ((^.))
import Data.List.NonEmpty (NonEmpty(..), fromList)

-- | Condition for loops.
type Condition = CodeExpr

-- | Function require
type Requires = String

-- | External library is a group of 'Step's
type ExternalLibrary = [StepGroup]

-- | Function steps.
type StepGroup = NonEmpty [Step]

-- | A step can be a call to an external library function or method.
data Step = Call FunctionInterface
  -- | A while loop.
  -- The function calls in the condition, other conditions, and steps for the body of the loop.
  | Loop (NonEmpty FunctionInterface) ([CodeExpr] -> Condition) (NonEmpty Step)
  -- For when a statement is needed, but does not interface with the external library.
  | Statement ([CodeVarChunk] -> [CodeExpr] -> FuncStmt)

-- | The first item in the 'Requires' list should be where the function being called is defined.
data FunctionInterface = FI (NonEmpty Requires) FuncType CodeFuncChunk [Argument] (Maybe Result)

-- | The result of a function call can be assigned to a variable or returned.
data Result = Assign CodeVarChunk | Return

-- | An argument may contain a named argument and argument information.
data Argument = Arg (Maybe NamedArgument) ArgumentInfo -- Maybe named argument

-- | Determines the context needed for an argument to work.
data ArgumentInfo =
  -- | An argument not dependent on use case.
  LockedArg CodeExpr
  -- | An argument dependent on the use case. Maybe is the variable if it needs
  --   to be declared and defined prior to calling.
  | Basic Space (Maybe CodeVarChunk)
  -- | A function-type argument, with a single 'Step' for the body.
  | Fn CodeFuncChunk [Parameter] Step
  -- | An argument that is an object of a class that must be implemented in the
  --   calling program.
  --   Parameters: Requires, description, object, constructor, class info.
  | Class [Requires] Description CodeVarChunk CodeFuncChunk ClassInfo
  -- | An argument that is an object of a record class defined by the external
  --   library, where some fields need to be set by the calling program.
  --   Parameters: Requires, constructor, object, fields.
  --   First Require should be where the record type is defined.
  | Record (NonEmpty Requires) CodeFuncChunk CodeVarChunk [CodeVarChunk]

-- | Function parameter may or may not be dependent on use case.
data Parameter = LockedParam ParameterChunk | NameableParam Space

-- | For classes that need to be generated in the calling program. May be a
--   regular class or a class that implements an interface from the external
--   library.
data ClassInfo = Regular [MethodInfo] | Implements String [MethodInfo]

-- | Constructor: description, known parameters, body. (CodeFuncChunk for constructor is not here because it is higher up in the AST, at the 'Class' node).
data MethodInfo = CI Description [Parameter] [Step]
  -- | Method, description, known parameters, maybe return description, body.
  | MI CodeFuncChunk Description [Parameter] (Maybe Description) (NonEmpty Step)

-- | Function type may be a function, a method, or a constructor.
data FuncType = Function | Method CodeVarChunk | Constructor

-- | Specifies an external library.
externalLib :: [StepGroup] -> ExternalLibrary
externalLib :: [StepGroup] -> [StepGroup]
externalLib = forall a. a -> a
id

-- | To be used when there are multiple options for a group of consecutive steps,
--   where a single use-case-specific factor decides which step group to use.
choiceSteps :: [[Step]] -> StepGroup
choiceSteps :: [[Step]] -> StepGroup
choiceSteps [] = forall a. HasCallStack => [Char] -> a
error [Char]
"choiceSteps should be called with a non-empty list"
choiceSteps [[Step]]
sg = forall a. [a] -> NonEmpty a
fromList [[Step]]
sg

-- | To be used when there are multiple options for a single step, where a
--   use-case-specific factor decides which step to use.
choiceStep :: [Step] -> StepGroup
choiceStep :: [Step] -> StepGroup
choiceStep [] = forall a. HasCallStack => [Char] -> a
error [Char]
"choiceStep should be called with a non-empty list"
choiceStep [Step]
ss = forall a. [a] -> NonEmpty a
fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> [a] -> [a]
: []) [Step]
ss

-- | Specifies a step which must exist in some form in every use case.
mandatoryStep :: Step -> StepGroup
mandatoryStep :: Step -> StepGroup
mandatoryStep Step
f = [Step
f] forall a. a -> [a] -> NonEmpty a
:| []

-- | Specifies multiple consecutive steps that all must exist in some form in
--   every use case.
mandatorySteps :: [Step] -> StepGroup
mandatorySteps :: [Step] -> StepGroup
mandatorySteps [Step]
fs = [Step]
fs forall a. a -> [a] -> NonEmpty a
:| []

-- Specifies a step that includes a call to an external library function or method.
callStep :: FunctionInterface -> Step
callStep :: FunctionInterface -> Step
callStep = FunctionInterface -> Step
Call

-- | Specifies a step where an external library function or method is called in a
--   while-loop condition and in the loop body.
loopStep :: [FunctionInterface] -> ([CodeExpr] -> Condition) -> [Step] -> Step
loopStep :: [FunctionInterface] -> ([CodeExpr] -> CodeExpr) -> [Step] -> Step
loopStep [] [CodeExpr] -> CodeExpr
_ [Step]
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"loopStep should be called with a non-empty list of FunctionInterface"
loopStep [FunctionInterface]
_ [CodeExpr] -> CodeExpr
_ [] = forall a. HasCallStack => [Char] -> a
error [Char]
"loopStep should be called with a non-empty list of Step"
loopStep [FunctionInterface]
fis [CodeExpr] -> CodeExpr
c [Step]
ss = NonEmpty FunctionInterface
-> ([CodeExpr] -> CodeExpr) -> NonEmpty Step -> Step
Loop (forall a. [a] -> NonEmpty a
fromList [FunctionInterface]
fis) [CodeExpr] -> CodeExpr
c (forall a. [a] -> NonEmpty a
fromList [Step]
ss)

-- | Specifies a call to an external library function.
libFunction :: Requires -> CodeFuncChunk -> [Argument] -> FunctionInterface
libFunction :: [Char] -> CodeFuncChunk -> [Argument] -> FunctionInterface
libFunction [Char]
rq CodeFuncChunk
f [Argument]
ps = NonEmpty [Char]
-> FuncType
-> CodeFuncChunk
-> [Argument]
-> Maybe Result
-> FunctionInterface
FI ([Char]
rq forall a. a -> [a] -> NonEmpty a
:| []) FuncType
Function CodeFuncChunk
f [Argument]
ps forall a. Maybe a
Nothing

-- | Specifies a call to an external library method.
libMethod :: Requires -> CodeVarChunk -> CodeFuncChunk -> [Argument] ->
  FunctionInterface
libMethod :: [Char]
-> CodeVarChunk -> CodeFuncChunk -> [Argument] -> FunctionInterface
libMethod [Char]
rq CodeVarChunk
o CodeFuncChunk
m [Argument]
ps = NonEmpty [Char]
-> FuncType
-> CodeFuncChunk
-> [Argument]
-> Maybe Result
-> FunctionInterface
FI ([Char]
rq forall a. a -> [a] -> NonEmpty a
:| []) (CodeVarChunk -> FuncType
Method CodeVarChunk
o) CodeFuncChunk
m [Argument]
ps forall a. Maybe a
Nothing

-- | Specifies a call to an external library function, where the result is
--   assigned to a variable.
libFunctionWithResult :: Requires -> CodeFuncChunk -> [Argument] ->
  CodeVarChunk -> FunctionInterface
libFunctionWithResult :: [Char]
-> CodeFuncChunk -> [Argument] -> CodeVarChunk -> FunctionInterface
libFunctionWithResult [Char]
rq CodeFuncChunk
f [Argument]
ps CodeVarChunk
r = NonEmpty [Char]
-> FuncType
-> CodeFuncChunk
-> [Argument]
-> Maybe Result
-> FunctionInterface
FI ([Char]
rq forall a. a -> [a] -> NonEmpty a
:| []) FuncType
Function CodeFuncChunk
f [Argument]
ps (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ CodeVarChunk -> Result
Assign CodeVarChunk
r)

-- | Specifies a call to an external library method, where the result is
--   assigned to a variable.
libMethodWithResult :: Requires -> CodeVarChunk -> CodeFuncChunk -> [Argument]
  -> CodeVarChunk -> FunctionInterface
libMethodWithResult :: [Char]
-> CodeVarChunk
-> CodeFuncChunk
-> [Argument]
-> CodeVarChunk
-> FunctionInterface
libMethodWithResult [Char]
rq CodeVarChunk
o CodeFuncChunk
m [Argument]
ps CodeVarChunk
r = NonEmpty [Char]
-> FuncType
-> CodeFuncChunk
-> [Argument]
-> Maybe Result
-> FunctionInterface
FI ([Char]
rq forall a. a -> [a] -> NonEmpty a
:| []) (CodeVarChunk -> FuncType
Method CodeVarChunk
o) CodeFuncChunk
m [Argument]
ps (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ CodeVarChunk -> Result
Assign CodeVarChunk
r)

-- | Specifies a call to an external library constructor, where the result is
--   assigned to a variable.
libConstructor :: Requires -> CodeFuncChunk -> [Argument] -> CodeVarChunk ->
  FunctionInterface
libConstructor :: [Char]
-> CodeFuncChunk -> [Argument] -> CodeVarChunk -> FunctionInterface
libConstructor [Char]
rq CodeFuncChunk
c [Argument]
as CodeVarChunk
r = NonEmpty [Char]
-> FuncType
-> CodeFuncChunk
-> [Argument]
-> Maybe Result
-> FunctionInterface
FI ([Char]
rq forall a. a -> [a] -> NonEmpty a
:| []) FuncType
Constructor CodeFuncChunk
c [Argument]
as (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ CodeVarChunk -> Result
Assign CodeVarChunk
r)

-- | Specifies a call to an external library function, where multiple modules from
--   the external library are required, and the result is assigned to a variable.
libConstructorMultiReqs :: [Requires] -> CodeFuncChunk -> [Argument] ->
  CodeVarChunk -> FunctionInterface
libConstructorMultiReqs :: [[Char]]
-> CodeFuncChunk -> [Argument] -> CodeVarChunk -> FunctionInterface
libConstructorMultiReqs [] CodeFuncChunk
_ [Argument]
_ CodeVarChunk
_ = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"libConstructorMultiReqs should" forall a. [a] -> [a] -> [a]
++
  [Char]
" be called with a non-empty list of Requires"
libConstructorMultiReqs [[Char]]
rqs CodeFuncChunk
c [Argument]
as CodeVarChunk
r = NonEmpty [Char]
-> FuncType
-> CodeFuncChunk
-> [Argument]
-> Maybe Result
-> FunctionInterface
FI (forall a. [a] -> NonEmpty a
fromList [[Char]]
rqs) FuncType
Constructor CodeFuncChunk
c [Argument]
as
  (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ CodeVarChunk -> Result
Assign CodeVarChunk
r)

-- | Specifies a call to an external library constructor, where the result is returned.
constructAndReturn :: Requires -> CodeFuncChunk -> [Argument] ->
  FunctionInterface
constructAndReturn :: [Char] -> CodeFuncChunk -> [Argument] -> FunctionInterface
constructAndReturn [Char]
rq CodeFuncChunk
c [Argument]
as = NonEmpty [Char]
-> FuncType
-> CodeFuncChunk
-> [Argument]
-> Maybe Result
-> FunctionInterface
FI ([Char]
rq forall a. a -> [a] -> NonEmpty a
:| []) FuncType
Constructor CodeFuncChunk
c [Argument]
as (forall a. a -> Maybe a
Just Result
Return)

-- | Specifies an argument that is not use-case-dependent.
lockedArg :: CodeExpr -> Argument
lockedArg :: CodeExpr -> Argument
lockedArg = Maybe NamedArgument -> ArgumentInfo -> Argument
Arg forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeExpr -> ArgumentInfo
LockedArg

-- | Specifies a named argument that is not use-case-dependent.
lockedNamedArg :: NamedArgument -> CodeExpr -> Argument
lockedNamedArg :: NamedArgument -> CodeExpr -> Argument
lockedNamedArg NamedArgument
n = Maybe NamedArgument -> ArgumentInfo -> Argument
Arg (forall a. a -> Maybe a
Just NamedArgument
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeExpr -> ArgumentInfo
LockedArg

-- | Specifies a use-case-dependent argument whose value can be inlined in the
--   call.
inlineArg :: Space -> Argument
inlineArg :: Space -> Argument
inlineArg Space
t = Maybe NamedArgument -> ArgumentInfo -> Argument
Arg forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ Space -> Maybe CodeVarChunk -> ArgumentInfo
Basic Space
t forall a. Maybe a
Nothing

-- | Specifies a use-case-dependent named argument whose value can be inlined in
--   the call.
inlineNamedArg :: NamedArgument ->  Space -> Argument
inlineNamedArg :: NamedArgument -> Space -> Argument
inlineNamedArg NamedArgument
n Space
t = Maybe NamedArgument -> ArgumentInfo -> Argument
Arg (forall a. a -> Maybe a
Just NamedArgument
n) forall a b. (a -> b) -> a -> b
$ Space -> Maybe CodeVarChunk -> ArgumentInfo
Basic Space
t forall a. Maybe a
Nothing

-- | Specifies use-case-dependent argument whose value must be assigned to a
--   variable before being passed in the call.
preDefinedArg :: CodeVarChunk -> Argument
preDefinedArg :: CodeVarChunk -> Argument
preDefinedArg CodeVarChunk
v = Maybe NamedArgument -> ArgumentInfo -> Argument
Arg forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ Space -> Maybe CodeVarChunk -> ArgumentInfo
Basic (CodeVarChunk
v forall s a. s -> Getting a s a -> a
^. forall c. HasSpace c => Getter c Space
typ) (forall a. a -> Maybe a
Just CodeVarChunk
v)

-- | Specifies use-case-dependent named argument whose value must be assigned to
--   a variable before being passed in the call.
preDefinedNamedArg :: NamedArgument -> CodeVarChunk -> Argument
preDefinedNamedArg :: NamedArgument -> CodeVarChunk -> Argument
preDefinedNamedArg NamedArgument
n CodeVarChunk
v = Maybe NamedArgument -> ArgumentInfo -> Argument
Arg (forall a. a -> Maybe a
Just NamedArgument
n) forall a b. (a -> b) -> a -> b
$ Space -> Maybe CodeVarChunk -> ArgumentInfo
Basic (CodeVarChunk
v forall s a. s -> Getting a s a -> a
^. forall c. HasSpace c => Getter c Space
typ) (forall a. a -> Maybe a
Just CodeVarChunk
v)

-- | Specifies a function type argument, where the body consists of a single step.
functionArg :: CodeFuncChunk -> [Parameter] -> Step -> Argument
functionArg :: CodeFuncChunk -> [Parameter] -> Step -> Argument
functionArg CodeFuncChunk
f [Parameter]
ps Step
b = Maybe NamedArgument -> ArgumentInfo -> Argument
Arg forall a. Maybe a
Nothing (CodeFuncChunk -> [Parameter] -> Step -> ArgumentInfo
Fn CodeFuncChunk
f [Parameter]
ps Step
b)

-- | Specifies an argument that is an object of a class that must be defined in
--   the calling program.
customObjArg :: [Requires] -> Description -> CodeVarChunk -> CodeFuncChunk ->
  ClassInfo -> Argument
customObjArg :: [[Char]]
-> [Char] -> CodeVarChunk -> CodeFuncChunk -> ClassInfo -> Argument
customObjArg [[Char]]
rs [Char]
d CodeVarChunk
o CodeFuncChunk
c ClassInfo
ci = Maybe NamedArgument -> ArgumentInfo -> Argument
Arg forall a. Maybe a
Nothing ([[Char]]
-> [Char]
-> CodeVarChunk
-> CodeFuncChunk
-> ClassInfo
-> ArgumentInfo
Class [[Char]]
rs [Char]
d CodeVarChunk
o CodeFuncChunk
c ClassInfo
ci)

-- | Specifies an argument that is an object of a class from the external library.
--   The list of [CodeVarChunk] represents fields of the object that must be set
--   in the calling program.
recordArg :: Requires -> CodeFuncChunk -> CodeVarChunk -> [CodeVarChunk] ->
  Argument
recordArg :: [Char]
-> CodeFuncChunk -> CodeVarChunk -> [CodeVarChunk] -> Argument
recordArg [Char]
rq CodeFuncChunk
c CodeVarChunk
o [CodeVarChunk]
fs = Maybe NamedArgument -> ArgumentInfo -> Argument
Arg forall a. Maybe a
Nothing (NonEmpty [Char]
-> CodeFuncChunk -> CodeVarChunk -> [CodeVarChunk] -> ArgumentInfo
Record ([Char]
rq forall a. a -> [a] -> NonEmpty a
:| []) CodeFuncChunk
c CodeVarChunk
o [CodeVarChunk]
fs)

-- | Specifies a use-case-independent parameter.
lockedParam :: CodeVarChunk -> Parameter
lockedParam :: CodeVarChunk -> Parameter
lockedParam = ParameterChunk -> Parameter
LockedParam forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. CodeIdea c => c -> ParameterChunk
pcAuto

-- | Specifies a parameter whose name depends on the use case.
unnamedParam :: Space -> Parameter
unnamedParam :: Space -> Parameter
unnamedParam = Space -> Parameter
NameableParam

-- | Specifies a class that must be implemented in the calling program.
customClass :: [MethodInfo] -> ClassInfo
customClass :: [MethodInfo] -> ClassInfo
customClass = [MethodInfo] -> ClassInfo
Regular

-- | Specifies an implementation of an interface from the external library.
implementation :: String -> [MethodInfo] -> ClassInfo
implementation :: [Char] -> [MethodInfo] -> ClassInfo
implementation = [Char] -> [MethodInfo] -> ClassInfo
Implements

-- | Specifies a constructor.
constructorInfo :: CodeFuncChunk -> [Parameter] -> [Step] -> MethodInfo
constructorInfo :: CodeFuncChunk -> [Parameter] -> [Step] -> MethodInfo
constructorInfo CodeFuncChunk
c = [Char] -> [Parameter] -> [Step] -> MethodInfo
CI ([Char]
"Constructor for " forall a. [a] -> [a] -> [a]
++ forall c. CodeIdea c => c -> [Char]
codeName CodeFuncChunk
c forall a. [a] -> [a] -> [a]
++ [Char]
" objects")

-- | Specifies a method.
methodInfo :: CodeFuncChunk -> Description -> [Parameter] -> Description ->
  [Step] -> MethodInfo
methodInfo :: CodeFuncChunk
-> [Char] -> [Parameter] -> [Char] -> [Step] -> MethodInfo
methodInfo CodeFuncChunk
_ [Char]
_ [Parameter]
_ [Char]
_ [] = forall a. HasCallStack => [Char] -> a
error [Char]
"methodInfo should be called with a non-empty list of Step"
methodInfo CodeFuncChunk
m [Char]
d [Parameter]
ps [Char]
rd [Step]
ss = CodeFuncChunk
-> [Char]
-> [Parameter]
-> Maybe [Char]
-> NonEmpty Step
-> MethodInfo
MI CodeFuncChunk
m [Char]
d [Parameter]
ps (forall a. a -> Maybe a
Just [Char]
rd) (forall a. [a] -> NonEmpty a
fromList [Step]
ss)

-- | Specifies a method that does not return anything.
methodInfoNoReturn :: CodeFuncChunk -> Description -> [Parameter] -> [Step] ->
  MethodInfo
methodInfoNoReturn :: CodeFuncChunk -> [Char] -> [Parameter] -> [Step] -> MethodInfo
methodInfoNoReturn CodeFuncChunk
_ [Char]
_ [Parameter]
_ [] = forall a. HasCallStack => [Char] -> a
error [Char]
"methodInfoNoReturn should be called with a non-empty list of Step"
methodInfoNoReturn CodeFuncChunk
m [Char]
d [Parameter]
ps [Step]
ss = CodeFuncChunk
-> [Char]
-> [Parameter]
-> Maybe [Char]
-> NonEmpty Step
-> MethodInfo
MI CodeFuncChunk
m [Char]
d [Parameter]
ps forall a. Maybe a
Nothing (forall a. [a] -> NonEmpty a
fromList [Step]
ss)

-- | Specifies a statement where a current solution is appended to a solution list.
appendCurrSol :: CodeExpr -> Step
appendCurrSol :: CodeExpr -> Step
appendCurrSol CodeExpr
curr = ([CodeVarChunk] -> [CodeExpr] -> FuncStmt) -> Step
statementStep (\[CodeVarChunk]
cdchs [CodeExpr]
es -> case ([CodeVarChunk]
cdchs, [CodeExpr]
es) of
    ([CodeVarChunk
s], []) -> CodeExpr -> CodeVarChunk -> FuncStmt
appendCurrSolFS CodeExpr
curr CodeVarChunk
s
    ([CodeVarChunk]
_,[CodeExpr]
_) -> forall a. HasCallStack => [Char] -> a
error [Char]
"Fill for appendCurrSol should provide one CodeChunk and no Exprs")

-- | Specifies a statement where a solution list is populated by iterating
--   through a solution array.
populateSolList :: CodeVarChunk -> CodeVarChunk -> CodeVarChunk -> [Step]
populateSolList :: CodeVarChunk -> CodeVarChunk -> CodeVarChunk -> [Step]
populateSolList CodeVarChunk
arr CodeVarChunk
el CodeVarChunk
fld = [([CodeVarChunk] -> [CodeExpr] -> FuncStmt) -> Step
statementStep (\[CodeVarChunk]
cdchs [CodeExpr]
es -> case ([CodeVarChunk]
cdchs, [CodeExpr]
es) of
    ([CodeVarChunk
s], []) -> CodeVarChunk -> CodeExpr -> FuncStmt
FAsg CodeVarChunk
s ([[CodeExpr]] -> CodeExpr
Matrix [[]])
    ([CodeVarChunk]
_,[CodeExpr]
_) -> forall a. HasCallStack => [Char] -> a
error [Char]
popErr),
  ([CodeVarChunk] -> [CodeExpr] -> FuncStmt) -> Step
statementStep (\[CodeVarChunk]
cdchs [CodeExpr]
es -> case ([CodeVarChunk]
cdchs, [CodeExpr]
es) of
    ([CodeVarChunk
s], []) -> CodeVarChunk -> CodeExpr -> [FuncStmt] -> FuncStmt
FForEach CodeVarChunk
el (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy CodeVarChunk
arr) [CodeExpr -> CodeVarChunk -> FuncStmt
appendCurrSolFS (forall r. CodeExprC r => CodeVarChunk -> CodeVarChunk -> r
field CodeVarChunk
el CodeVarChunk
fld) CodeVarChunk
s]
    ([CodeVarChunk]
_,[CodeExpr]
_) -> forall a. HasCallStack => [Char] -> a
error [Char]
popErr)]
  where popErr :: [Char]
popErr = [Char]
"Fill for populateSolList should provide one CodeChunk and no Exprs"

-- | Specifies statements where every index of an array is assigned a value.
assignArrayIndex :: Step
assignArrayIndex :: Step
assignArrayIndex = ([CodeVarChunk] -> [CodeExpr] -> FuncStmt) -> Step
statementStep (\[CodeVarChunk]
cdchs [CodeExpr]
es -> case ([CodeVarChunk]
cdchs, [CodeExpr]
es) of
  ([CodeVarChunk
a],[CodeExpr]
vs) -> [FuncStmt] -> FuncStmt
FMulti forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (CodeVarChunk -> Integer -> CodeExpr -> FuncStmt
FAsgIndex CodeVarChunk
a) [Integer
0..] [CodeExpr]
vs
  ([CodeVarChunk]
_,[CodeExpr]
_) -> forall a. HasCallStack => [Char] -> a
error [Char]
"Fill for assignArrayIndex should provide one CodeChunk")

-- | Specifies a statement where a solution is assigned from the field of an
--   object.
assignSolFromObj :: CodeVarChunk -> Step
assignSolFromObj :: CodeVarChunk -> Step
assignSolFromObj CodeVarChunk
o = ([CodeVarChunk] -> [CodeExpr] -> FuncStmt) -> Step
statementStep (\[CodeVarChunk]
cdchs [CodeExpr]
es -> case ([CodeVarChunk]
cdchs, [CodeExpr]
es) of
  ([CodeVarChunk
s],[]) -> CodeVarChunk -> CodeExpr -> FuncStmt
FAsg CodeVarChunk
s (forall r. CodeExprC r => CodeVarChunk -> CodeVarChunk -> r
field CodeVarChunk
o CodeVarChunk
s)
  ([CodeVarChunk]
_,[CodeExpr]
_) -> forall a. HasCallStack => [Char] -> a
error [Char]
"Fill for assignSolFromObj should provide one CodeChunk and no Exprs")

-- | Specifies a statement where a solution list is initialized with the first
--   element of an array.
initSolListFromArray :: CodeVarChunk -> Step
initSolListFromArray :: CodeVarChunk -> Step
initSolListFromArray CodeVarChunk
a = ([CodeVarChunk] -> [CodeExpr] -> FuncStmt) -> Step
statementStep (\[CodeVarChunk]
cdchs [CodeExpr]
es -> case ([CodeVarChunk]
cdchs, [CodeExpr]
es) of
  ([CodeVarChunk
s],[]) -> CodeVarChunk -> CodeExpr -> FuncStmt
FAsg CodeVarChunk
s (forall r. ExprC r => [[r]] -> r
matrix [[forall r. ExprC r => r -> r -> r
idx (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy CodeVarChunk
a) (forall r. LiteralC r => Integer -> r
int Integer
0)]])
  ([CodeVarChunk]
_,[CodeExpr]
_) -> forall a. HasCallStack => [Char] -> a
error [Char]
"Fill for initSolListFromArray should provide one CodeChunk and no Exprs")

-- | Specifies a statement where a solution list is initialized with the first value.
initSolListWithVal :: Step
initSolListWithVal :: Step
initSolListWithVal = ([CodeVarChunk] -> [CodeExpr] -> FuncStmt) -> Step
statementStep (\[CodeVarChunk]
cdchs [CodeExpr]
es -> case ([CodeVarChunk]
cdchs, [CodeExpr]
es) of
  ([CodeVarChunk
s],[CodeExpr
v]) -> CodeVarChunk -> CodeExpr -> FuncStmt
FDecDef CodeVarChunk
s (forall r. ExprC r => [[r]] -> r
matrix [[forall r. ExprC r => r -> r -> r
idx CodeExpr
v (forall r. LiteralC r => Integer -> r
int Integer
0)]])
  ([CodeVarChunk]
_,[CodeExpr]
_) -> forall a. HasCallStack => [Char] -> a
error [Char]
"Fill for initSolListWithVal should provide one CodeChunk and one Expr")

-- | A solve and populate loop. 'FunctionInterface' for loop condition, 'CodeChunk' for solution object,
--   'CodeChunk' for independent var, 'FunctionInterface' for solving,
--   'CodeChunk' for soln array to populate with.
solveAndPopulateWhile :: FunctionInterface -> CodeVarChunk -> CodeVarChunk ->
  FunctionInterface -> CodeVarChunk -> Step
solveAndPopulateWhile :: FunctionInterface
-> CodeVarChunk
-> CodeVarChunk
-> FunctionInterface
-> CodeVarChunk
-> Step
solveAndPopulateWhile FunctionInterface
lc CodeVarChunk
ob CodeVarChunk
iv FunctionInterface
slv CodeVarChunk
popArr = [FunctionInterface] -> ([CodeExpr] -> CodeExpr) -> [Step] -> Step
loopStep [FunctionInterface
lc] (\case
  [CodeExpr
ub] -> forall r. CodeExprC r => CodeVarChunk -> CodeVarChunk -> r
field CodeVarChunk
ob CodeVarChunk
iv forall r. ExprC r => r -> r -> r
$< CodeExpr
ub
  [CodeExpr]
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"Fill for solveAndPopulateWhile should provide one Expr")
  [FunctionInterface -> Step
callStep FunctionInterface
slv, CodeExpr -> Step
appendCurrSol (forall r. CodeExprC r => CodeVarChunk -> CodeVarChunk -> r
field CodeVarChunk
ob CodeVarChunk
popArr)]

-- | Specifies a statement where a list is returned, where each value of the list
-- is explicitly defined.
returnExprList :: Step
returnExprList :: Step
returnExprList = ([CodeVarChunk] -> [CodeExpr] -> FuncStmt) -> Step
statementStep (\[CodeVarChunk]
cdchs [CodeExpr]
es -> case ([CodeVarChunk]
cdchs, [CodeExpr]
es) of
  ([], [CodeExpr]
_) -> CodeExpr -> FuncStmt
FRet forall a b. (a -> b) -> a -> b
$ [[CodeExpr]] -> CodeExpr
Matrix [[CodeExpr]
es]
  ([CodeVarChunk]
_,[CodeExpr]
_) -> forall a. HasCallStack => [Char] -> a
error [Char]
"Fill for returnExprList should provide no CodeChunks")

-- | A statement where a current solution is appended to a solution list.
appendCurrSolFS :: CodeExpr -> CodeVarChunk -> FuncStmt
appendCurrSolFS :: CodeExpr -> CodeVarChunk -> FuncStmt
appendCurrSolFS CodeExpr
cs CodeVarChunk
s = CodeExpr -> CodeExpr -> FuncStmt
FAppend (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy CodeVarChunk
s) (forall r. ExprC r => r -> r -> r
idx CodeExpr
cs (forall r. LiteralC r => Integer -> r
int Integer
0))

-- | Specifies a use-case-independent statement that returns a fixed value.
fixedReturn :: CodeExpr -> Step
fixedReturn :: CodeExpr -> Step
fixedReturn = FuncStmt -> Step
lockedStatement forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeExpr -> FuncStmt
FRet

-- | Specifies a use-case-dependent statement that returns a non-fixed value.
fixedReturn' :: Step
fixedReturn' :: Step
fixedReturn' = ([CodeVarChunk] -> [CodeExpr] -> FuncStmt) -> Step
statementStep forall {a}. [a] -> [CodeExpr] -> FuncStmt
go
  where
    go :: [a] -> [CodeExpr] -> FuncStmt
go [] [CodeExpr
e] = CodeExpr -> FuncStmt
FRet CodeExpr
e
    go [a]
_  [CodeExpr
_] = forall a. HasCallStack => [Char] -> a
error [Char]
"Fill for fixReturn' should provide no CodeChunk."
    go [a]
_  [CodeExpr]
_   = forall a. HasCallStack => [Char] -> a
error [Char]
"fixedReturn' does not yet handle multiple values."

-- | Specifies a statement step.
statementStep :: ([CodeVarChunk] -> [CodeExpr] -> FuncStmt) -> Step
statementStep :: ([CodeVarChunk] -> [CodeExpr] -> FuncStmt) -> Step
statementStep = ([CodeVarChunk] -> [CodeExpr] -> FuncStmt) -> Step
Statement

-- | Specifies a statement that is not use-case-dependent.
lockedStatement :: FuncStmt -> Step
lockedStatement :: FuncStmt -> Step
lockedStatement FuncStmt
s = ([CodeVarChunk] -> [CodeExpr] -> FuncStmt) -> Step
Statement (\[CodeVarChunk]
_ [CodeExpr]
_ -> FuncStmt
s)

-- | Specifies a statement where a single solution is initialized with a value.
initSolWithVal :: Step
initSolWithVal :: Step
initSolWithVal = ([CodeVarChunk] -> [CodeExpr] -> FuncStmt) -> Step
statementStep (\[CodeVarChunk]
cdchs [CodeExpr]
es -> case ([CodeVarChunk]
cdchs, [CodeExpr]
es) of
  ([CodeVarChunk
s],[CodeExpr
v]) -> CodeVarChunk -> CodeExpr -> FuncStmt
FDecDef CodeVarChunk
s CodeExpr
v
  ([CodeVarChunk]
_,[CodeExpr]
_) -> forall a. HasCallStack => [Char] -> a
error [Char]
"Fill for initSolWithVal should provide one CodeChunk and one Expr")