{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}

module Drasil.Shared.InterfaceCommon (
  -- Types
  Label, Library, MSBody, MSBlock, VSFunction, VSType, VSBinder,
  SVariable, SValue, VSThunk, MSStatement, MSParameter, SMethod, NamedArgs,
  MixedCall, MixedCtorCall, PosCall, PosCtorCall, InOutCall, InOutFunc,
  DocInOutFunc,
  -- Typeclasses
  SharedProg, UnRepr(..), BodySym(..), bodyStatements, oneLiner, BlockSym(..),
  TypeSym(..), getCodeType, getTypeString, VariableSym(..), ScopeSym(..),
  convScope, VariableElim(..), listOf, listVar, ValueSym(..), Argument(..),
  Literal(..), litZero, MathConstant(..), VariableValue(..), CommandLineArgs(..),
  NumericExpression(..), BooleanExpression(..), Comparison(..),
  ValueExpression(..), funcApp, funcAppNamedArgs, extFuncApp, libFuncApp, exists,
  IndexTranslator(..), Array(..), 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(..), BinderSym(..),
  BinderElim(..), convType
  ) where

import Data.Bifunctor (first)
import qualified Data.Kind as K (Type)

import Drasil.Shared.AST (ScopeData(..), ScopeTag(..), TypeData(..), BinderD)
import Drasil.Shared.CodeType (CodeType(..))
import Drasil.Shared.State (MS, VS)

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

-- TODO [Brandon Bosman, 06/09/2026]: UnRepr can be removed from SharedProg
-- if we can root out its use from drasil-code

class (UnRepr r TypeData, 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, IndexTranslator r,
  Array r, List r, Set r, VariableElim r, MethodSym r, ScopeSym r, BinderSym r
  ) => SharedProg r

-- Shared between OO and Procedural --

class UnRepr repr contents where
  unRepr :: repr contents -> contents

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 TypeData)

class TypeSym r where
  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

-- | A helper function for extracting the CodeType from an `r TypeData`
getCodeType :: (UnRepr r TypeData) => r TypeData -> CodeType
getCodeType :: forall (r :: * -> *). UnRepr r TypeData => r TypeData -> CodeType
getCodeType = TypeData -> CodeType
cType (TypeData -> CodeType)
-> (r TypeData -> TypeData) -> r TypeData -> CodeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r TypeData -> TypeData
forall (repr :: * -> *) contents.
UnRepr repr contents =>
repr contents -> contents
unRepr

-- TODO [Brandon Bosman, 06/09/2026]: Think about separating GOOL and GProc implementations of this
-- | A helper function for extracting the String representation from an `r TypeData`
getTypeString :: (UnRepr r TypeData) => r TypeData -> String
getTypeString :: forall (r :: * -> *). UnRepr r TypeData => r TypeData -> String
getTypeString = TypeData -> String
typeString (TypeData -> String)
-> (r TypeData -> TypeData) -> r TypeData -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r TypeData -> TypeData
forall (repr :: * -> *) contents.
UnRepr repr contents =>
repr contents -> contents
unRepr

class ScopeSym r where
  global :: r ScopeData -- Definite global scope
  mainFn :: r ScopeData -- Main program - either main function or global scope
  local  :: r ScopeData -- Definite local scope

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

class (TypeSym r) => VariableSym r where
  type Variable r
  -- | An instance- or function-level variable, separate from its instance (i.e. `v`, not `o.v`)
  var       :: Label -> VSType r -> SVariable r
  -- | An instance- or function-level constant, separate from its instance (i.e. `v`, not `o.v`)
  constant  :: Label -> VSType r -> SVariable r
  -- | An instance- or module-level variable from an external library.
  -- Given library `Lib`, variable name `v`, and variable type `t`,
  -- it performs the necessary imports and creates `Lib.v`
  extVar    :: Library -> Label -> VSType r -> SVariable r

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

listVar :: (VariableSym r) => Label -> VSType r -> SVariable r
listVar :: forall (r :: * -> *).
VariableSym r =>
String -> VSType r -> SVariable r
listVar String
n VSType r
t = String -> VSType r -> StateT ValueState Identity (r (Variable r))
forall (r :: * -> *).
VariableSym r =>
String -> VSType r -> SVariable r
var String
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 =>
String -> VSType r -> SVariable r
listOf = String -> VSType r -> SVariable r
forall (r :: * -> *).
VariableSym r =>
String -> 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 TypeData

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 :: (Literal r, UnRepr r TypeData) => VSType r -> SValue r
litZero :: forall (r :: * -> *).
(Literal r, UnRepr r TypeData) =>
VSType r -> SValue r
litZero VSType r
t = do
  r TypeData
t' <- VSType r
t
  case r TypeData -> CodeType
forall (r :: * -> *). UnRepr r TypeData => r TypeData -> CodeType
getCodeType r TypeData
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
_ -> String -> SValue r
forall a. HasCallStack => String -> a
error String
"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

type VSBinder a = VS (a BinderD)

class (TypeSym r) => BinderSym r where
  binder :: Label -> VSType r -> VSBinder r

class (BinderSym r) => BinderElim r where
  binderName :: r BinderD -> String
  binderType :: r BinderD -> r TypeData

-- 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 :: [VSBinder r] -> SValue r -> SValue r

  notNull :: SValue r -> SValue r

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

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

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

libFuncApp       :: (ValueExpression r) => Library -> PosCall r
libFuncApp :: forall (r :: * -> *). ValueExpression r => String -> PosCall r
libFuncApp String
l String
n VSType r
t [SValue r]
vs = String -> MixedCall r
forall (r :: * -> *). ValueExpression r => String -> MixedCall r
libFuncAppMixedArgs String
l String
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) => IndexTranslator 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

class (IndexTranslator r) => Array r where
  -- TODO [Brandon Bosman, 05/19/2026]: Change return type to SValue
  -- | Given array `a` and index `i`, creates `a[i]`
  arrayElem :: SValue r -> SVariable r -> SVariable r
  -- TODO [Brandon Bosman, 06/03/2026]: Consider switching to a polymorphic `length`
  -- for Array, List, and Set
  -- | Given an array, return its length
  arrayLength :: SValue r -> SValue r
  -- TODO [Brandon Bosman, 05/21/2026]: Consider switching this to a polymorphic `copy`,
  -- more like how `print` currently works
  -- | Given a source array, create a (shallow) copy of it
  arrayCopy :: SValue r -> SValue r

class (IndexTranslator r) => List r where
  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 ScopeData -> MSStatement r
  vecDecDef :: SVariable r -> r ScopeData -> [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
  -- | Declare a variable without giving it a value.
  -- Not for use with arrays; use `arrayDec` instead.
  varDec       :: SVariable r -> r ScopeData -> MSStatement r
  -- | Declare a variable and give it a value.
  -- Not for use with arrays; use `arrayDecDef` instead.
  varDecDef    :: SVariable r -> r ScopeData -> SValue r -> MSStatement r
  -- First argument is size of the list
  listDec      :: Integer -> SVariable r -> r ScopeData -> MSStatement r
  listDecDef   :: SVariable r -> r ScopeData -> [SValue r] -> MSStatement r
  setDec       :: SVariable r -> r ScopeData -> MSStatement r
  setDecDef    :: SVariable r -> r ScopeData -> SValue r -> MSStatement r
  -- First argument is size of the array
  arrayDec     :: Integer -> SVariable r -> r ScopeData -> MSStatement r
  arrayDecDef  :: SVariable r -> r ScopeData -> [SValue r] -> MSStatement r
  constDecDef  :: SVariable r -> r ScopeData -> SValue r -> MSStatement r
  funcDecDef   :: SVariable r -> r ScopeData -> [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 :: String -> 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 String
_) = String -> VSType r
forall a. HasCallStack => String -> a
error String
"Objects not supported"

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