{-# LANGUAGE TypeFamilies #-}

module Drasil.GOOL.InterfaceCommon (
  -- Types
  Label, Library, MSBody, MSBlock, VSFunction, VSType, SVariable, SValue,
  VSThunk, MSStatement, MSParameter, SMethod, NamedArgs, MixedCall,
  MixedCtorCall, PosCall, PosCtorCall, InOutCall, InOutFunc, DocInOutFunc,
  -- Typeclasses
  SharedProg, BodySym(..), bodyStatements, oneLiner, BlockSym(..), TypeSym(..),
  TypeElim(..), VariableSym(..), ScopeSym(..), convScope, VariableElim(..),
  listOf, listVar, ValueSym(..), Argument(..), Literal(..), litZero,
  MathConstant(..), VariableValue(..), CommandLineArgs(..),
  NumericExpression(..), BooleanExpression(..), Comparison(..),
  ValueExpression(..), funcApp, funcAppNamedArgs, extFuncApp, libFuncApp,
  exists, List(..), Set(..), InternalList(..), listSlice, listIndexExists, at,
  ThunkSym(..), VectorType(..), VectorDecl(..), VectorThunk(..),
  VectorExpression(..), ThunkAssign(..), StatementSym(..), AssignStatement(..),
  (&=), assignToListIndex, DeclStatement(..), IOStatement(..),
  StringStatement(..), FunctionSym(..), FuncAppStatement(..),
  CommentStatement(..), ControlStatement(..), ifNoElse, switchAsIf,
  VisibilitySym(..), ParameterSym(..), MethodSym(..), convType
  ) where

import Drasil.GOOL.CodeType (CodeType(..))
import Drasil.GOOL.State (MS, VS)

import qualified Data.Kind as K (Type)
import Data.Bifunctor (first)
import CodeLang.Drasil (Comment)
import Drasil.GOOL.AST (ScopeData(..), ScopeTag(..))

type Label = String
type Library = String

-- In relation to GOOL, the type variable r can be considered as short for "representation"

-- Functions in GOOL's interface beginning with "ext" are to be used to access items from other modules in the same program/project
-- Functions in GOOL's interface beginning with "lib" are to be used to access items from different libraries/projects

class (VectorType r, VectorDecl r, VectorThunk r,
  VectorExpression r, ThunkAssign r, AssignStatement r, DeclStatement r,
  IOStatement r, StringStatement r, FunctionSym r, FuncAppStatement r,
  CommentStatement r, ControlStatement r, InternalList r, Argument r, Literal r,
  MathConstant r, VariableValue r, CommandLineArgs r, NumericExpression r,
  BooleanExpression r, Comparison r, ValueExpression r, List r, Set r, TypeElim r,
  VariableElim r, MethodSym r, ScopeSym r
  ) => SharedProg r

-- Shared between OO and Procedural --

type MSBody a = MS (a (Body a))

class (BlockSym r) => BodySym r where
  type Body r
  body           :: [MSBlock r] -> MSBody r

  addComments :: Label -> MSBody r -> MSBody r

bodyStatements :: (BodySym r) => [MSStatement r] -> MSBody r
bodyStatements :: forall (r :: * -> *). BodySym r => [MSStatement r] -> MSBody r
bodyStatements [MSStatement r]
sts = [MSBlock r] -> StateT MethodState Identity (r (Body r))
forall (r :: * -> *). BodySym r => [MSBlock r] -> MSBody r
body [[MSStatement r] -> MSBlock r
forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block [MSStatement r]
sts]

oneLiner :: (BodySym r) => MSStatement r -> MSBody r
oneLiner :: forall (r :: * -> *). BodySym r => MSStatement r -> MSBody r
oneLiner MSStatement r
s = [MSStatement r] -> StateT MethodState Identity (r (Body r))
forall (r :: * -> *). BodySym r => [MSStatement r] -> MSBody r
bodyStatements [MSStatement r
s]

type MSBlock a = MS (a (Block a))

class (StatementSym r) => BlockSym r where
  type Block r
  block   :: [MSStatement r] -> MSBlock r

type VSType a = VS (a (Type a))

class TypeSym r where
  type Type r
  bool          :: VSType r
  int           :: VSType r -- This is 32-bit signed ints except in Python, 
                            -- which has unlimited precision ints; and Julia,
                            -- Which defaults to 64-bit signed ints
  float         :: VSType r
  double        :: VSType r
  char          :: VSType r
  string        :: VSType r
  infile        :: VSType r
  outfile       :: VSType r
  listType      :: VSType r -> VSType r
  setType       :: VSType r -> VSType r
  arrayType     :: VSType r -> VSType r
  listInnerType :: VSType r -> VSType r
  funcType      :: [VSType r] -> VSType r -> VSType r
  void          :: VSType r

class (TypeSym r) => TypeElim r where
  getType :: r (Type r) -> CodeType
  getTypeString :: r (Type r) -> String

class ScopeSym r where
  type Scope r
  global :: r (Scope r) -- Definite global scope
  mainFn :: r (Scope r) -- Main program - either main function or global scope
  local  :: r (Scope r) -- Definite local scope

type SVariable a = VS (a (Variable a))

class (TypeSym r) => VariableSym r where
  type Variable r
  var       :: Label -> VSType r -> SVariable r
  constant  :: Label -> VSType r -> SVariable r
  extVar    :: Library -> Label -> VSType r -> SVariable r
  arrayElem :: Integer -> SVariable r -> SVariable r

class (VariableSym r) => VariableElim r where
  variableName :: r (Variable r) -> String
  variableType :: r (Variable r) -> r (Type r)

listVar :: (VariableSym r) => Label -> VSType r -> SVariable r
listVar :: forall (r :: * -> *).
VariableSym r =>
Label -> VSType r -> SVariable r
listVar Label
n VSType r
t = Label -> VSType r -> StateT ValueState Identity (r (Variable r))
forall (r :: * -> *).
VariableSym r =>
Label -> VSType r -> SVariable r
var Label
n (VSType r -> VSType r
forall (r :: * -> *). TypeSym r => VSType r -> VSType r
listType VSType r
t)

listOf :: (VariableSym r) => Label -> VSType r -> SVariable r
listOf :: forall (r :: * -> *).
VariableSym r =>
Label -> VSType r -> SVariable r
listOf = Label -> VSType r -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Label -> VSType r -> SVariable r
listVar

type SValue a = VS (a (Value a))

class (TypeSym r) => ValueSym r where
  type Value r
  valueType :: r (Value r) -> r (Type r)

class (ValueSym r) => Argument r where
  pointerArg :: SValue r -> SValue r

class (ValueSym r) => Literal r where
  litTrue   :: SValue r
  litFalse  :: SValue r
  litChar   :: Char -> SValue r
  litDouble :: Double -> SValue r
  litFloat  :: Float -> SValue r
  litInt    :: Integer -> SValue r
  litString :: String -> SValue r
  litArray  :: VSType r -> [SValue r] -> SValue r
  litList   :: VSType r -> [SValue r] -> SValue r
  litSet    :: VSType r -> [SValue r] -> SValue r

litZero :: (TypeElim r, Literal r) => VSType r -> SValue r
litZero :: forall (r :: * -> *).
(TypeElim r, Literal r) =>
VSType r -> SValue r
litZero VSType r
t = do
  r (Type r)
t' <- VSType r
t
  case r (Type r) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType r (Type r)
t' of
    CodeType
Integer -> Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
litInt Integer
0
    CodeType
Float -> Float -> SValue r
forall (r :: * -> *). Literal r => Float -> SValue r
litFloat Float
0
    CodeType
Double -> Double -> SValue r
forall (r :: * -> *). Literal r => Double -> SValue r
litDouble Double
0
    CodeType
_ -> Label -> SValue r
forall a. HasCallStack => Label -> a
error Label
"litZero expects a numeric type"

class (ValueSym r) => MathConstant r where
  pi :: SValue r

class (VariableSym r, ValueSym r) => VariableValue r where
  valueOf       :: SVariable r -> SValue r

class (ValueSym r) => CommandLineArgs r where
  arg          :: Integer -> SValue r
  argsList     :: SValue r
  argExists    :: Integer -> SValue r

class (ValueSym r) => NumericExpression r where
  (#~)  :: SValue r -> SValue r
  infixl 8 #~ -- Negation
  (#/^) :: SValue r -> SValue r
  infixl 7 #/^ -- Square root
  (#|)  :: SValue r -> SValue r
  infixl 7 #| -- Absolute value
  (#+)  :: SValue r -> SValue r -> SValue r
  infixl 5 #+
  (#-)  :: SValue r -> SValue r -> SValue r
  infixl 5 #-
  (#*)  :: SValue r -> SValue r -> SValue r
  infixl 6 #*
  (#/)  :: SValue r -> SValue r -> SValue r
  infixl 6 #/
  (#%)  :: SValue r -> SValue r -> SValue r
  infixl 6 #% -- Modulo
  (#^)  :: SValue r -> SValue r -> SValue r
  infixl 7 #^ -- Exponentiation

  log    :: SValue r -> SValue r
  ln     :: SValue r -> SValue r
  exp    :: SValue r -> SValue r
  sin    :: SValue r -> SValue r
  cos    :: SValue r -> SValue r
  tan    :: SValue r -> SValue r
  csc    :: SValue r -> SValue r
  sec    :: SValue r -> SValue r
  cot    :: SValue r -> SValue r
  arcsin :: SValue r -> SValue r
  arccos :: SValue r -> SValue r
  arctan :: SValue r -> SValue r
  floor  :: SValue r -> SValue r
  ceil   :: SValue r -> SValue r

class (ValueSym r) => BooleanExpression r where
  (?!)  :: SValue r -> SValue r
  infixr 6 ?! -- Boolean 'not'
  (?&&) :: SValue r -> SValue r -> SValue r
  infixl 2 ?&&
  (?||) :: SValue r -> SValue r -> SValue r
  infixl 1 ?||

class (ValueSym r) => Comparison r where
  (?<)  :: SValue r -> SValue r -> SValue r
  infixl 4 ?<
  (?<=) :: SValue r -> SValue r -> SValue r
  infixl 4 ?<=
  (?>)  :: SValue r -> SValue r -> SValue r
  infixl 4 ?>
  (?>=) :: SValue r -> SValue r -> SValue r
  infixl 4 ?>=
  (?==) :: SValue r -> SValue r -> SValue r
  infixl 3 ?==
  (?!=) :: SValue r -> SValue r -> SValue r
  infixl 3 ?!=

type NamedArgs r = [(SVariable r, SValue r)]
-- Function call with both positional and named arguments
type MixedCall r = Label -> VSType r -> [SValue r] -> NamedArgs r -> SValue r
-- Constructor call with both positional and named arguments
type MixedCtorCall r = VSType r -> [SValue r] -> NamedArgs r -> SValue r
-- Function call with only positional arguments
type PosCall r = Label -> VSType r -> [SValue r] -> SValue r
-- Constructor call with only positional arguments
type PosCtorCall r = VSType r -> [SValue r] -> SValue r

-- for values that can include expressions
class (VariableSym r, ValueSym r) => ValueExpression r where
  -- An inline if-statement, aka the ternary operator.  Inputs:
  -- Condition, True-value, False-value
  inlineIf     :: SValue r -> SValue r -> SValue r -> SValue r
  
  funcAppMixedArgs     ::            MixedCall r
  extFuncAppMixedArgs  :: Library -> MixedCall r
  libFuncAppMixedArgs  :: Library -> MixedCall r

  lambda :: [SVariable r] -> SValue r -> SValue r

  notNull :: SValue r -> SValue r

funcApp          :: (ValueExpression r) =>            PosCall r
funcApp :: forall (r :: * -> *). ValueExpression r => PosCall r
funcApp Label
n VSType r
t [SValue r]
vs = MixedCall r
forall (r :: * -> *). ValueExpression r => MixedCall r
funcAppMixedArgs Label
n VSType r
t [SValue r]
vs []

funcAppNamedArgs :: (ValueExpression r) =>            Label -> VSType r ->
  NamedArgs r -> SValue r
funcAppNamedArgs :: forall (r :: * -> *).
ValueExpression r =>
Label -> VSType r -> NamedArgs r -> SValue r
funcAppNamedArgs Label
n VSType r
t = MixedCall r
forall (r :: * -> *). ValueExpression r => MixedCall r
funcAppMixedArgs Label
n VSType r
t []

extFuncApp       :: (ValueExpression r) => Library -> PosCall r
extFuncApp :: forall (r :: * -> *). ValueExpression r => Label -> PosCall r
extFuncApp Label
l Label
n VSType r
t [SValue r]
vs = Label -> MixedCall r
forall (r :: * -> *). ValueExpression r => Label -> MixedCall r
extFuncAppMixedArgs Label
l Label
n VSType r
t [SValue r]
vs []

libFuncApp       :: (ValueExpression r) => Library -> PosCall r
libFuncApp :: forall (r :: * -> *). ValueExpression r => Label -> PosCall r
libFuncApp Label
l Label
n VSType r
t [SValue r]
vs = Label -> MixedCall r
forall (r :: * -> *). ValueExpression r => Label -> MixedCall r
libFuncAppMixedArgs Label
l Label
n VSType r
t [SValue r]
vs []

exists :: (ValueExpression r) => SValue r -> SValue r
exists :: forall (r :: * -> *). ValueExpression r => SValue r -> SValue r
exists = SValue r -> SValue r
forall (r :: * -> *). ValueExpression r => SValue r -> SValue r
notNull

class (ValueSym r) => List r where
  -- | Does any necessary conversions from GOOL's zero-indexed assumptions to
  --   the target language's assumptions
  intToIndex :: SValue r -> SValue r
  -- | Does any necessary conversions from the target language's indexing
  --   assumptions assumptions to GOOL's zero-indexed assumptions
  indexToInt :: SValue r -> SValue r
  -- | Finds the size of a list.
  --   Arguments are: List
  listSize   :: SValue r -> SValue r
  -- | Inserts a value into a list.
  --   Arguments are: List, Index, Value
  listAdd    :: SValue r -> SValue r -> SValue r -> SValue r
  -- | Appens a value to a list.
  --   Arguments are: List, Value
  listAppend :: SValue r -> SValue r -> SValue r
  -- | Gets the value of an index of a list.
  --   Arguments are: List, Index
  listAccess :: SValue r -> SValue r -> SValue r
  -- | Sets the value of an index of a list.
  --   Arguments are: List, Index, Value
  listSet    :: SValue r -> SValue r -> SValue r -> SValue r
  -- | Finds the index of the first occurrence of a value in a list.
  --   Arguments are: List, Value
  indexOf :: SValue r -> SValue r -> SValue r

class (ValueSym r) => Set r where
  -- | Checks membership
  -- Arguments are: Set, Value
  contains :: SValue r -> SValue r -> SValue r
  -- | Inserts a value into a set
  -- Arguments are: Set, Value
  setAdd :: SValue r -> SValue r -> SValue r
  -- | Removes a value from a set
  -- Arguments are: Set, Value
  setRemove :: SValue r -> SValue r -> SValue r
  -- | Removes a value from a set
  -- Arguments are: Set, Set
  setUnion :: SValue r -> SValue r -> SValue r

class (ValueSym r) => InternalList r where
  listSlice'      :: Maybe (SValue r) -> Maybe (SValue r) -> Maybe (SValue r) 
    -> SVariable r -> SValue r -> MSBlock r

-- | Creates a slice of a list and assigns it to a variable.
--   Arguments are: 
--   Variable to assign
--   List to read from
--   (optional) Start index inclusive.
--      (if Nothing, then list start if step > 0, list end if step < 0)
--   (optional) End index exclusive.
--      (if Nothing, then list end if step > 0, list start if step > 0)
--   (optional) Step (if Nothing, then defaults to 1)
listSlice :: (InternalList r) => SVariable r -> SValue r -> Maybe (SValue r) -> 
  Maybe (SValue r) -> Maybe (SValue r) -> MSBlock r
listSlice :: forall (r :: * -> *).
InternalList r =>
SVariable r
-> SValue r
-> Maybe (SValue r)
-> Maybe (SValue r)
-> Maybe (SValue r)
-> MSBlock r
listSlice SVariable r
vnew SValue r
vold Maybe (SValue r)
b Maybe (SValue r)
e Maybe (SValue r)
s = Maybe (SValue r)
-> Maybe (SValue r)
-> Maybe (SValue r)
-> SVariable r
-> SValue r
-> StateT MethodState Identity (r (Block r))
forall (r :: * -> *).
InternalList r =>
Maybe (SValue r)
-> Maybe (SValue r)
-> Maybe (SValue r)
-> SVariable r
-> SValue r
-> MSBlock r
listSlice' Maybe (SValue r)
b Maybe (SValue r)
e Maybe (SValue r)
s SVariable r
vnew SValue r
vold

listIndexExists :: (List r, Comparison r) => SValue r -> SValue r -> SValue r
listIndexExists :: forall (r :: * -> *).
(List r, Comparison r) =>
SValue r -> SValue r -> SValue r
listIndexExists SValue r
lst SValue r
index = SValue r -> SValue r
forall (r :: * -> *). List r => SValue r -> SValue r
listSize SValue r
lst SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
?> SValue r
index

at :: (List r) => SValue r -> SValue r -> SValue r
at :: forall (r :: * -> *). List r => SValue r -> SValue r -> SValue r
at = SValue r -> SValue r -> SValue r
forall (r :: * -> *). List r => SValue r -> SValue r -> SValue r
listAccess

-- Vector Typeclasses --

type VSThunk a = VS (a (Thunk a))

class ThunkSym r where
  -- K.Type -> K.Type annotation needed because r is not applied here so its
  -- kind cannot be inferred (whereas for Value, r is applied in the type
  -- signature of valueType
  type Thunk (r :: K.Type -> K.Type)

class (VariableSym r, ThunkSym r, StatementSym r) => ThunkAssign r where
  thunkAssign :: SVariable r -> VSThunk r -> MSStatement r

class TypeSym r => VectorType r where
  vecType :: VSType r -> VSType r

class (DeclStatement r) => VectorDecl r where
  -- First argument is size of the vector
  vecDec :: Integer -> SVariable r -> r (Scope r) -> MSStatement r
  vecDecDef :: SVariable r -> r (Scope r) -> [SValue r] -> MSStatement r

class (VariableSym r, ThunkSym r) => VectorThunk r where
  vecThunk :: SVariable r -> VSThunk r

class (ThunkSym r, ValueSym r) => VectorExpression r where
  vecScale :: SValue r -> VSThunk r -> VSThunk r
  vecAdd :: VSThunk r -> VSThunk r -> VSThunk r
  vecIndex :: SValue r -> VSThunk r -> SValue r
  vecDot :: VSThunk r -> VSThunk r -> VSThunk r

type MSStatement a = MS (a (Statement a))

class (ValueSym r) => StatementSym r where
  type Statement r
  valStmt :: SValue r -> MSStatement r -- converts value to statement
  emptyStmt :: MSStatement r
  multi     :: [MSStatement r] -> MSStatement r

class (VariableSym r, StatementSym r) => AssignStatement r where
  (&-=)  :: SVariable r -> SValue r -> MSStatement r
  infixl 1 &-=
  (&+=)  :: SVariable r -> SValue r -> MSStatement r
  infixl 1 &+=
  (&++)  :: SVariable r -> MSStatement r
  infixl 8 &++
  (&--)  :: SVariable r -> MSStatement r
  infixl 8 &--

  assign :: SVariable r -> SValue r -> MSStatement r

(&=) :: (AssignStatement r) => SVariable r -> SValue r -> MSStatement r
infixr 1 &=
&= :: forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
(&=) = SVariable r -> SValue r -> MSStatement r
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
assign

assignToListIndex :: (StatementSym r, VariableValue r, List r) => SVariable r 
  -> SValue r -> SValue r -> MSStatement r
assignToListIndex :: forall (r :: * -> *).
(StatementSym r, VariableValue r, List r) =>
SVariable r -> SValue r -> SValue r -> MSStatement r
assignToListIndex SVariable r
lst SValue r
index SValue r
v = SValue r -> MSStatement r
forall (r :: * -> *). StatementSym r => SValue r -> MSStatement r
valStmt (SValue r -> MSStatement r) -> SValue r -> MSStatement r
forall a b. (a -> b) -> a -> b
$ SValue r -> SValue r -> SValue r -> SValue r
forall (r :: * -> *).
List r =>
SValue r -> SValue r -> SValue r -> SValue r
listSet (SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable r
lst) SValue r
index SValue r
v

class (VariableSym r, StatementSym r, ScopeSym r) => DeclStatement r where
  varDec       :: SVariable r -> r (Scope r) -> MSStatement r
  varDecDef    :: SVariable r -> r (Scope r) -> SValue r -> MSStatement r
  -- First argument is size of the list
  listDec      :: Integer -> SVariable r -> r (Scope r) -> MSStatement r
  listDecDef   :: SVariable r -> r (Scope r) -> [SValue r] -> MSStatement r
  setDec       :: SVariable r -> r (Scope r) -> MSStatement r
  setDecDef    :: SVariable r -> r (Scope r) -> SValue r -> MSStatement r
  -- First argument is size of the array
  arrayDec     :: Integer -> SVariable r -> r (Scope r) -> MSStatement r
  arrayDecDef  :: SVariable r -> r (Scope r) -> [SValue r] -> MSStatement r
  constDecDef  :: SVariable r -> r (Scope r) -> SValue r -> MSStatement r
  funcDecDef   :: SVariable r -> r (Scope r) -> [SVariable r] -> MSBody r
    -> MSStatement r


class (VariableSym r, StatementSym r) => IOStatement r where
  print      :: SValue r -> MSStatement r
  printLn    :: SValue r -> MSStatement r
  printStr   :: String -> MSStatement r
  printStrLn :: String -> MSStatement r

  -- First argument is file handle, second argument is value to print
  printFile      :: SValue r -> SValue r -> MSStatement r
  printFileLn    :: SValue r -> SValue r -> MSStatement r
  printFileStr   :: SValue r -> String -> MSStatement r
  printFileStrLn :: SValue r -> String -> MSStatement r

  getInput         :: SVariable r -> MSStatement r
  discardInput     :: MSStatement r
  getFileInput     :: SValue r -> SVariable r -> MSStatement r
  discardFileInput :: SValue r -> MSStatement r

  openFileR :: SVariable r -> SValue r -> MSStatement r
  openFileW :: SVariable r -> SValue r -> MSStatement r
  openFileA :: SVariable r -> SValue r -> MSStatement r
  closeFile :: SValue r -> MSStatement r

  getFileInputLine :: SValue r -> SVariable r -> MSStatement r
  discardFileLine  :: SValue r -> MSStatement r
  getFileInputAll  :: SValue r -> SVariable r -> MSStatement r

class (VariableSym r, StatementSym r) => StringStatement r where
  -- Parameters are: char to split on, variable to store result in, string to split
  stringSplit :: Char -> SVariable r -> SValue r -> MSStatement r

  stringListVals  :: [SVariable r] -> SValue r -> MSStatement r
  stringListLists :: [SVariable r] -> SValue r -> MSStatement r

type VSFunction a = VS (a (Function a))

class (ValueSym r) => FunctionSym r where
  type Function r

-- The three lists are inputs, outputs, and both, respectively
type InOutCall r = Label -> [SValue r] -> [SVariable r] -> [SVariable r] -> 
  MSStatement r

class (VariableSym r, StatementSym r) => FuncAppStatement r where
  inOutCall    ::            InOutCall r
  extInOutCall :: Library -> InOutCall r

class (StatementSym r) => CommentStatement r where
  comment :: Comment -> MSStatement r

class (BodySym r, VariableSym r) => ControlStatement r where
  break :: MSStatement r
  continue :: MSStatement r

  returnStmt :: SValue r -> MSStatement r

  throw :: Label -> MSStatement r

  -- | String of if-else statements.
  --   Arguments: List of predicates and bodies (if this then that),
  --   Body for else branch
  ifCond     :: [(SValue r, MSBody r)] -> MSBody r -> MSStatement r
  switch     :: SValue r -> [(SValue r, MSBody r)] -> MSBody r -> MSStatement r

  ifExists :: SValue r -> MSBody r -> MSBody r -> MSStatement r

  for      :: MSStatement r -> SValue r -> MSStatement r -> MSBody r -> 
    MSStatement r
  -- Iterator variable, start value, end value, step value, loop body
  forRange :: SVariable r -> SValue r -> SValue r -> SValue r -> MSBody r -> 
    MSStatement r
  forEach  :: SVariable r -> SValue r -> MSBody r -> MSStatement r
  while    :: SValue r -> MSBody r -> MSStatement r 

  tryCatch :: MSBody r -> MSBody r -> MSStatement r

  assert :: SValue r -> SValue r -> MSStatement r

ifNoElse :: (ControlStatement r) => [(SValue r, MSBody r)] -> MSStatement r
ifNoElse :: forall (r :: * -> *).
ControlStatement r =>
[(SValue r, MSBody r)] -> MSStatement r
ifNoElse [(SValue r, MSBody r)]
bs = [(SValue r, MSBody r)]
-> MSBody r -> StateT MethodState Identity (r (Statement r))
forall (r :: * -> *).
ControlStatement r =>
[(SValue r, MSBody r)] -> MSBody r -> MSStatement r
ifCond [(SValue r, MSBody r)]
bs (MSBody r -> StateT MethodState Identity (r (Statement r)))
-> MSBody r -> StateT MethodState Identity (r (Statement r))
forall a b. (a -> b) -> a -> b
$ [MSBlock r] -> MSBody r
forall (r :: * -> *). BodySym r => [MSBlock r] -> MSBody r
body []

switchAsIf :: (ControlStatement r, Comparison r) => SValue r -> 
  [(SValue r, MSBody r)] -> MSBody r -> MSStatement r
switchAsIf :: forall (r :: * -> *).
(ControlStatement r, Comparison r) =>
SValue r -> [(SValue r, MSBody r)] -> MSBody r -> MSStatement r
switchAsIf SValue r
v = [(SValue r, MS (r (Body r)))]
-> MS (r (Body r)) -> MS (r (Statement r))
forall (r :: * -> *).
ControlStatement r =>
[(SValue r, MSBody r)] -> MSBody r -> MSStatement r
ifCond ([(SValue r, MS (r (Body r)))]
 -> MS (r (Body r)) -> MS (r (Statement r)))
-> ([(SValue r, MS (r (Body r)))] -> [(SValue r, MS (r (Body r)))])
-> [(SValue r, MS (r (Body r)))]
-> MS (r (Body r))
-> MS (r (Statement r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SValue r, MS (r (Body r))) -> (SValue r, MS (r (Body r))))
-> [(SValue r, MS (r (Body r)))] -> [(SValue r, MS (r (Body r)))]
forall a b. (a -> b) -> [a] -> [b]
map ((SValue r -> SValue r)
-> (SValue r, MS (r (Body r))) -> (SValue r, MS (r (Body r)))
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (SValue r
v SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
?==))

class VisibilitySym r where
  type Visibility r
  private :: r (Visibility r)
  public  :: r (Visibility r)

type MSParameter a = MS (a (Parameter a))

class (VariableSym r) => ParameterSym r where
  type Parameter r
  param :: SVariable r -> MSParameter r
  pointerParam :: SVariable r -> MSParameter r

type SMethod a = MS (a (Method a))

-- The three lists are inputs, outputs, and both, respectively
type InOutFunc r = [SVariable r] -> [SVariable r] -> [SVariable r] -> 
  MSBody r -> SMethod r
-- Parameters are: brief description of function, input descriptions and 
-- variables, output descriptions and variables, descriptions and variables 
-- for parameters that are both input and output, function body
type DocInOutFunc r = String -> [(String, SVariable r)] -> 
  [(String, SVariable r)] -> [(String, SVariable r)] -> MSBody r -> SMethod r

class (BodySym r, ParameterSym r, VisibilitySym r) => MethodSym r
  where
  type Method r
  docMain :: MSBody r -> SMethod r

  function :: Label -> r (Visibility r) -> VSType r -> [MSParameter r] -> 
    MSBody r -> SMethod r
  mainFunction  :: MSBody r -> SMethod r
  -- Parameters are: function description, parameter descriptions, 
  --   return value description if applicable, function
  docFunc :: String -> [String] -> Maybe String -> SMethod r -> SMethod r

  inOutFunc :: Label -> r (Visibility r) -> InOutFunc r
  docInOutFunc :: Label -> r (Visibility r) -> DocInOutFunc r

-- Utility

convType :: (TypeSym r) => CodeType -> VSType r
convType :: forall (r :: * -> *). TypeSym r => CodeType -> VSType r
convType CodeType
Boolean = VSType r
forall (r :: * -> *). TypeSym r => VSType r
bool
convType CodeType
Integer = VSType r
forall (r :: * -> *). TypeSym r => VSType r
int
convType CodeType
Float = VSType r
forall (r :: * -> *). TypeSym r => VSType r
float
convType CodeType
Double = VSType r
forall (r :: * -> *). TypeSym r => VSType r
double
convType CodeType
Char = VSType r
forall (r :: * -> *). TypeSym r => VSType r
char
convType CodeType
String = VSType r
forall (r :: * -> *). TypeSym r => VSType r
string
convType (List CodeType
t) = VSType r -> VSType r
forall (r :: * -> *). TypeSym r => VSType r -> VSType r
listType (CodeType -> VSType r
forall (r :: * -> *). TypeSym r => CodeType -> VSType r
convType CodeType
t)
convType (Set CodeType
t) = VSType r -> VSType r
forall (r :: * -> *). TypeSym r => VSType r -> VSType r
setType (CodeType -> VSType r
forall (r :: * -> *). TypeSym r => CodeType -> VSType r
convType CodeType
t)
convType (Array CodeType
t) = VSType r -> VSType r
forall (r :: * -> *). TypeSym r => VSType r -> VSType r
arrayType (CodeType -> VSType r
forall (r :: * -> *). TypeSym r => CodeType -> VSType r
convType CodeType
t)
convType (Func [CodeType]
ps CodeType
r) = [VSType r] -> VSType r -> VSType r
forall (r :: * -> *).
TypeSym r =>
[VSType r] -> VSType r -> VSType r
funcType ((CodeType -> VSType r) -> [CodeType] -> [VSType r]
forall a b. (a -> b) -> [a] -> [b]
map CodeType -> VSType r
forall (r :: * -> *). TypeSym r => CodeType -> VSType r
convType [CodeType]
ps) (CodeType -> VSType r
forall (r :: * -> *). TypeSym r => CodeType -> VSType r
convType CodeType
r)
convType CodeType
Void = VSType r
forall (r :: * -> *). TypeSym r => VSType r
void
convType CodeType
InFile = VSType r
forall (r :: * -> *). TypeSym r => VSType r
infile
convType CodeType
OutFile = VSType r
forall (r :: * -> *). TypeSym r => VSType r
outfile
convType (Object Label
_) = Label -> VSType r
forall a. HasCallStack => Label -> a
error Label
"Objects not supported"

convScope :: (ScopeSym r) => ScopeData -> r (Scope r)
convScope :: forall (r :: * -> *). ScopeSym r => ScopeData -> r (Scope r)
convScope (SD {scopeTag :: ScopeData -> ScopeTag
scopeTag = ScopeTag
Global}) = r (Scope r)
forall (r :: * -> *). ScopeSym r => r (Scope r)
global
convScope (SD {scopeTag :: ScopeData -> ScopeTag
scopeTag = ScopeTag
Local}) = r (Scope r)
forall (r :: * -> *). ScopeSym r => r (Scope r)
local