{-# LANGUAGE TypeFamilies #-}

module GOOL.Drasil.ClassInterface (
  -- Types
  Label, Library, GSProgram, SFile, MSBody, MSBlock, VSType, SVariable, SValue, 
  VSFunction, MSStatement, MSParameter, SMethod, CSStateVar, SClass, FSModule,
  NamedArgs, Initializers, MixedCall, MixedCtorCall, PosCall, PosCtorCall,
  -- Typeclasses
  OOProg, ProgramSym(..), FileSym(..), PermanenceSym(..), BodySym(..), 
  bodyStatements, oneLiner, BlockSym(..), TypeSym(..), TypeElim(..), 
  VariableSym(..), VariableElim(..), ($->), listOf, listVar, ValueSym(..), 
  Argument(..), Literal(..), MathConstant(..), VariableValue(..), 
  CommandLineArgs(..), NumericExpression(..), BooleanExpression(..), 
  Comparison(..), ValueExpression(..), funcApp, funcAppNamedArgs, selfFuncApp, 
  extFuncApp, libFuncApp, newObj, extNewObj, libNewObj, exists, 
  InternalValueExp(..), objMethodCall, objMethodCallNamedArgs, 
  objMethodCallMixedArgs, objMethodCallNoParams, FunctionSym(..), ($.),
  selfAccess, GetSet(..), List(..), InternalList(..), listSlice, 
  listIndexExists, at, StatementSym(..), AssignStatement(..), (&=), 
  assignToListIndex, DeclStatement(..), objDecNewNoParams, 
  extObjDecNewNoParams, IOStatement(..), StringStatement(..),
  FuncAppStatement(..), CommentStatement(..), ControlStatement(..), 
  StatePattern(..), initState, changeState, ObserverPattern(..), 
  observerListName, initObserverList, addObserver, StrategyPattern(..), 
  ifNoElse, switchAsIf, ScopeSym(..), ParameterSym(..), MethodSym(..), 
  privMethod, pubMethod, initializer, nonInitConstructor, StateVarSym(..), 
  privDVar, pubDVar, pubSVar, ClassSym(..), ModuleSym(..), convType
) where

import GOOL.Drasil.CodeType (CodeType(..), ClassName)
import GOOL.Drasil.Helpers (onStateValue)
import GOOL.Drasil.State (GS, FS, CS, MS, VS)

import Data.Bifunctor (first)

type Label = String
type Library = String

type GSProgram a = GS (a (Program a))

-- 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 (ProgramSym r, AssignStatement r, DeclStatement r, IOStatement r, 
  StringStatement 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, InternalValueExp r, GetSet r, List r, StatePattern r, 
  ObserverPattern r, StrategyPattern r, TypeElim r, VariableElim r) => OOProg r

class (FileSym r) => ProgramSym r where
  type Program r
  prog :: Label -> [SFile r] -> GSProgram r

type SFile a = FS (a (File a))

class (ModuleSym r) => FileSym r where 
  type File r
  fileDoc :: FSModule r -> SFile r

  -- Module description, list of author names, date as a String, file to comment
  docMod :: String -> [String] -> String -> SFile r -> SFile r

class PermanenceSym r where
  type Permanence r
  static  :: r (Permanence r)
  dynamic :: r (Permanence r)

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 :: [MSStatement r] -> MSBody r
bodyStatements sts :: [MSStatement r]
sts = [MSBlock r] -> MSBody 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 :: MSStatement r -> MSBody r
oneLiner s :: MSStatement r
s = [MSStatement r] -> MSBody 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
  float         :: VSType r
  double        :: VSType r
  char          :: VSType r
  string        :: VSType r
  infile        :: VSType r
  outfile       :: VSType r
  listType      :: VSType r -> VSType r
  arrayType     :: VSType r -> VSType r
  listInnerType :: VSType r -> VSType r
  obj           :: ClassName -> 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

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

class (TypeSym r) => VariableSym r where
  type Variable r
  var          :: Label -> VSType r -> SVariable r
  staticVar    :: Label -> VSType r -> SVariable r
  const        :: Label -> VSType r -> SVariable r
  extVar       :: Library -> Label -> VSType r -> SVariable r
  self         :: SVariable r
  classVar     :: VSType r -> SVariable r -> SVariable r
  extClassVar  :: VSType r -> SVariable r -> SVariable r
  objVar       :: SVariable r -> SVariable r -> SVariable r
  objVarSelf   :: SVariable 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)

($->) :: (VariableSym r) => SVariable r -> SVariable r -> SVariable r
infixl 9 $->
$-> :: SVariable r -> SVariable r -> SVariable r
($->) = SVariable r -> SVariable r -> SVariable r
forall (r :: * -> *).
VariableSym r =>
SVariable r -> SVariable r -> SVariable r
objVar

listVar :: (VariableSym r) => Label -> VSType r -> SVariable r
listVar :: Label -> VSType r -> SVariable r
listVar n :: Label
n t :: VSType r
t = Label -> VSType r -> SVariable 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 :: 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

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
  inlineIf     :: SValue r -> SValue r -> SValue r -> SValue r
  
  funcAppMixedArgs     ::            MixedCall r
  selfFuncAppMixedArgs ::            MixedCall r
  extFuncAppMixedArgs  :: Library -> MixedCall r
  libFuncAppMixedArgs  :: Library -> MixedCall r
  newObjMixedArgs      ::            MixedCtorCall r
  extNewObjMixedArgs   :: Library -> MixedCtorCall r
  libNewObjMixedArgs   :: Library -> MixedCtorCall r

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

  notNull :: SValue r -> SValue r

funcApp          :: (ValueExpression r) =>            PosCall r
funcApp :: PosCall r
funcApp n :: Label
n t :: VSType r
t vs :: [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 :: Label -> VSType r -> NamedArgs r -> SValue r
funcAppNamedArgs n :: Label
n t :: VSType r
t = MixedCall r
forall (r :: * -> *). ValueExpression r => MixedCall r
funcAppMixedArgs Label
n VSType r
t []

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

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

newObj           :: (ValueExpression r) =>            PosCtorCall r
newObj :: PosCtorCall r
newObj t :: VSType r
t vs :: [SValue r]
vs = MixedCtorCall r
forall (r :: * -> *). ValueExpression r => MixedCtorCall r
newObjMixedArgs VSType r
t [SValue r]
vs []

extNewObj        :: (ValueExpression r) => Library -> PosCtorCall r
extNewObj :: Label -> PosCtorCall r
extNewObj l :: Label
l t :: VSType r
t vs :: [SValue r]
vs = Label -> MixedCtorCall r
forall (r :: * -> *). ValueExpression r => MixedCall r
extNewObjMixedArgs Label
l VSType r
t [SValue r]
vs []

libNewObj        :: (ValueExpression r) => Library -> PosCtorCall r
libNewObj :: Label -> PosCtorCall r
libNewObj l :: Label
l t :: VSType r
t vs :: [SValue r]
vs = Label -> MixedCtorCall r
forall (r :: * -> *). ValueExpression r => MixedCall r
libNewObjMixedArgs Label
l VSType r
t [SValue r]
vs []

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

class (FunctionSym r) => InternalValueExp r where
  objMethodCallMixedArgs' :: Label -> VSType r -> SValue r -> [SValue r] -> 
    NamedArgs r -> SValue r

objMethodCall :: (InternalValueExp r) => VSType r -> SValue r -> Label -> 
  [SValue r] -> SValue r
objMethodCall :: VSType r -> SValue r -> Label -> [SValue r] -> SValue r
objMethodCall t :: VSType r
t o :: SValue r
o f :: Label
f ps :: [SValue r]
ps = Label
-> VSType r -> SValue r -> [SValue r] -> NamedArgs r -> SValue r
forall (r :: * -> *).
InternalValueExp r =>
Label
-> VSType r -> SValue r -> [SValue r] -> NamedArgs r -> SValue r
objMethodCallMixedArgs' Label
f VSType r
t SValue r
o [SValue r]
ps []

objMethodCallNamedArgs :: (InternalValueExp r) => VSType r -> SValue r -> Label 
  -> NamedArgs r -> SValue r
objMethodCallNamedArgs :: VSType r -> SValue r -> Label -> NamedArgs r -> SValue r
objMethodCallNamedArgs t :: VSType r
t o :: SValue r
o f :: Label
f = Label
-> VSType r -> SValue r -> [SValue r] -> NamedArgs r -> SValue r
forall (r :: * -> *).
InternalValueExp r =>
Label
-> VSType r -> SValue r -> [SValue r] -> NamedArgs r -> SValue r
objMethodCallMixedArgs' Label
f VSType r
t SValue r
o []

objMethodCallMixedArgs :: (InternalValueExp r) => VSType r -> SValue r -> Label 
  -> [SValue r] -> NamedArgs r -> SValue r
objMethodCallMixedArgs :: VSType r
-> SValue r -> Label -> [SValue r] -> NamedArgs r -> SValue r
objMethodCallMixedArgs t :: VSType r
t o :: SValue r
o f :: Label
f = Label
-> VSType r -> SValue r -> [SValue r] -> NamedArgs r -> SValue r
forall (r :: * -> *).
InternalValueExp r =>
Label
-> VSType r -> SValue r -> [SValue r] -> NamedArgs r -> SValue r
objMethodCallMixedArgs' Label
f VSType r
t SValue r
o

objMethodCallNoParams :: (InternalValueExp r) => VSType r -> SValue r -> Label 
  -> SValue r
objMethodCallNoParams :: VSType r -> SValue r -> Label -> SValue r
objMethodCallNoParams t :: VSType r
t o :: SValue r
o f :: Label
f = VSType r -> SValue r -> Label -> [SValue r] -> SValue r
forall (r :: * -> *).
InternalValueExp r =>
VSType r -> SValue r -> Label -> [SValue r] -> SValue r
objMethodCall VSType r
t SValue r
o Label
f []

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

class (ValueSym r) => FunctionSym r where
  type Function r
  func :: Label -> VSType r -> [SValue r] -> VSFunction r
  objAccess :: SValue r -> VSFunction r -> SValue r

($.) :: (FunctionSym r) => SValue r -> VSFunction r -> SValue r
infixl 9 $.
$. :: SValue r -> VSFunction r -> SValue r
($.) = SValue r -> VSFunction r -> SValue r
forall (r :: * -> *).
FunctionSym r =>
SValue r -> VSFunction r -> SValue r
objAccess

selfAccess :: (VariableValue r, FunctionSym r) => VSFunction r -> SValue r
selfAccess :: VSFunction r -> SValue r
selfAccess = SValue r -> VSFunction r -> SValue r
forall (r :: * -> *).
FunctionSym r =>
SValue r -> VSFunction r -> SValue r
objAccess (SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable r
forall (r :: * -> *). VariableSym r => SVariable r
self)

class (ValueSym r, VariableSym r) => GetSet r where
  get :: SValue r -> SVariable r -> SValue r
  set :: SValue r -> SVariable r -> SValue r -> SValue r

class (ValueSym r) => List r where
  listSize   :: SValue r -> SValue r
  listAdd    :: SValue r -> SValue r -> SValue r -> SValue r
  listAppend :: SValue r -> SValue r -> SValue r
  listAccess :: SValue r -> SValue r -> SValue r
  listSet    :: SValue r -> SValue r -> SValue r -> SValue r
  
  indexOf :: 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
  
listSlice :: (InternalList r) => SVariable r -> SValue r -> Maybe (SValue r) -> 
  Maybe (SValue r) -> Maybe (SValue r) -> MSBlock r
listSlice :: SVariable r
-> SValue r
-> Maybe (SValue r)
-> Maybe (SValue r)
-> Maybe (SValue r)
-> MSBlock r
listSlice vnew :: SVariable r
vnew vold :: SValue r
vold b :: Maybe (SValue r)
b e :: Maybe (SValue r)
e s :: Maybe (SValue r)
s = Maybe (SValue r)
-> Maybe (SValue r)
-> Maybe (SValue r)
-> SVariable r
-> SValue r
-> MSBlock 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 :: SValue r -> SValue r -> SValue r
listIndexExists lst :: SValue r
lst index :: 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 :: SValue r -> SValue r -> SValue r
at = SValue r -> SValue r -> SValue r
forall (r :: * -> *). List r => SValue r -> SValue r -> SValue r
listAccess

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
  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 &=
&= :: 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 :: SVariable r -> SValue r -> SValue r -> MSStatement r
assignToListIndex lst :: SVariable r
lst index :: SValue r
index v :: 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) => DeclStatement r where
  varDec       :: SVariable r -> MSStatement r
  varDecDef    :: SVariable r -> SValue r -> MSStatement r
  listDec      :: Integer -> SVariable r -> MSStatement r
  listDecDef   :: SVariable r -> [SValue r] -> MSStatement r
  arrayDec     :: Integer -> SVariable r -> MSStatement r
  arrayDecDef  :: SVariable r -> [SValue r] -> MSStatement r
  objDecDef    :: SVariable r -> SValue r -> MSStatement r
  objDecNew    :: SVariable r -> [SValue r] -> MSStatement r
  extObjDecNew :: Library -> SVariable r -> [SValue r] -> MSStatement r
  constDecDef  :: SVariable r -> SValue r -> MSStatement r
  funcDecDef   :: SVariable r -> [SVariable r] -> MSBody r -> MSStatement r
  
objDecNewNoParams :: (DeclStatement r) => SVariable r -> MSStatement r
objDecNewNoParams :: SVariable r -> MSStatement r
objDecNewNoParams v :: SVariable r
v = SVariable r -> [SValue r] -> MSStatement r
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> [SValue r] -> MSStatement r
objDecNew SVariable r
v []

extObjDecNewNoParams :: (DeclStatement r) => Library -> SVariable r -> 
  MSStatement r
extObjDecNewNoParams :: Label -> SVariable r -> MSStatement r
extObjDecNewNoParams l :: Label
l v :: SVariable r
v = Label -> SVariable r -> [SValue r] -> MSStatement r
forall (r :: * -> *).
DeclStatement r =>
Label -> SVariable r -> [SValue r] -> MSStatement r
extObjDecNew Label
l SVariable r
v []

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

  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
  stringSplit :: Char -> SVariable r -> SValue r -> MSStatement r

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

type InOutCall r = Label -> [SValue r] -> [SVariable r] -> [SVariable r] -> 
  MSStatement r

class (VariableSym r, StatementSym r) => FuncAppStatement r where
  -- The three lists are inputs, outputs, and both, respectively
  inOutCall     ::            InOutCall r
  selfInOutCall ::            InOutCall r
  extInOutCall  :: Library -> InOutCall r

type Comment = String  

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

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

ifNoElse :: (ControlStatement r) => [(SValue r, MSBody r)] -> MSStatement r
ifNoElse :: [(SValue r, MSBody r)] -> MSStatement r
ifNoElse bs :: [(SValue r, MSBody r)]
bs = [(SValue r, MSBody r)] -> MSBody r -> MSStatement r
forall (r :: * -> *).
ControlStatement r =>
[(SValue r, MSBody r)] -> MSBody r -> MSStatement r
ifCond [(SValue r, MSBody r)]
bs (MSBody r -> MSStatement r) -> MSBody r -> MSStatement 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 :: SValue r -> [(SValue r, MSBody r)] -> MSBody r -> MSStatement r
switchAsIf v :: SValue r
v = [(SValue r, MSBody r)] -> MSBody r -> MSStatement r
forall (r :: * -> *).
ControlStatement r =>
[(SValue r, MSBody r)] -> MSBody r -> MSStatement r
ifCond ([(SValue r, MSBody r)] -> MSBody r -> MSStatement r)
-> ([(SValue r, MSBody r)] -> [(SValue r, MSBody r)])
-> [(SValue r, MSBody r)]
-> MSBody r
-> MSStatement r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SValue r, MSBody r) -> (SValue r, MSBody r))
-> [(SValue r, MSBody r)] -> [(SValue r, MSBody r)]
forall a b. (a -> b) -> [a] -> [b]
map ((SValue r -> SValue r)
-> (SValue r, MSBody r) -> (SValue r, MSBody r)
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 (BodySym r) => StatePattern r where
  checkState      :: Label -> [(SValue r, MSBody r)] -> MSBody r -> 
    MSStatement r

initState :: (DeclStatement r, Literal r) => Label -> Label -> MSStatement r
initState :: Label -> Label -> MSStatement r
initState fsmName :: Label
fsmName initialState :: Label
initialState = SVariable r -> SValue r -> MSStatement r
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> SValue r -> MSStatement r
varDecDef (Label -> VSType r -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Label -> VSType r -> SVariable r
var Label
fsmName VSType r
forall (r :: * -> *). TypeSym r => VSType r
string) 
  (Label -> SValue r
forall (r :: * -> *). Literal r => Label -> SValue r
litString Label
initialState)

changeState :: (AssignStatement r, Literal r) => Label -> Label -> MSStatement r
changeState :: Label -> Label -> MSStatement r
changeState fsmName :: Label
fsmName toState :: Label
toState = Label -> VSType r -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Label -> VSType r -> SVariable r
var Label
fsmName VSType r
forall (r :: * -> *). TypeSym r => VSType r
string SVariable r -> SValue r -> MSStatement r
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= Label -> SValue r
forall (r :: * -> *). Literal r => Label -> SValue r
litString Label
toState

class (StatementSym r, FunctionSym r) => ObserverPattern r where
  notifyObservers :: VSFunction r -> VSType r -> MSStatement r

observerListName :: Label
observerListName :: Label
observerListName = "observerList"

initObserverList :: (DeclStatement r) => VSType r -> [SValue r] -> MSStatement r
initObserverList :: VSType r -> [SValue r] -> MSStatement r
initObserverList t :: VSType r
t = SVariable r -> [SValue r] -> MSStatement r
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> [SValue r] -> MSStatement r
listDecDef (Label -> VSType r -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Label -> VSType r -> SVariable r
var Label
observerListName (VSType r -> VSType r
forall (r :: * -> *). TypeSym r => VSType r -> VSType r
listType VSType r
t))

addObserver :: (StatementSym r, VariableValue r, List r) => SValue r -> 
  MSStatement r
addObserver :: SValue r -> MSStatement r
addObserver o :: SValue r
o = 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
listAdd SValue r
obsList SValue r
lastelem SValue r
o
  where obsList :: SValue r
obsList = SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf (SVariable r -> SValue r) -> SVariable r -> SValue r
forall a b. (a -> b) -> a -> b
$ Label
observerListName Label -> VSType r -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Label -> VSType r -> SVariable r
`listOf` (r (Value r) -> r (Type r)) -> SValue r -> VSType r
forall a b s. (a -> b) -> State s a -> State s b
onStateValue r (Value r) -> r (Type r)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType SValue r
o
        lastelem :: SValue r
lastelem = SValue r -> SValue r
forall (r :: * -> *). List r => SValue r -> SValue r
listSize SValue r
obsList

class (BodySym r, VariableSym r) => StrategyPattern r where
  runStrategy     :: Label -> [(Label, MSBody r)] -> Maybe (SValue r) -> 
    Maybe (SVariable r) -> MSBlock r

class ScopeSym r where
  type Scope r
  private :: r (Scope r)
  public  :: r (Scope 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))
type Initializers r = [(SVariable r, SValue r)]

-- 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, ScopeSym r, PermanenceSym r) => MethodSym r 
  where
  type Method r
  method      :: Label -> r (Scope r) -> r (Permanence r) -> VSType r -> 
    [MSParameter r] -> MSBody r -> SMethod r
  getMethod   :: SVariable r -> SMethod r
  setMethod   :: SVariable r -> SMethod r 
  constructor :: [MSParameter r] -> Initializers r -> MSBody r -> SMethod r

  docMain :: MSBody r -> SMethod r

  function :: Label -> r (Scope 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

  -- inOutMethod and docInOutMethod both need the Permanence parameter
  inOutMethod :: Label -> r (Scope r) -> r (Permanence r) -> InOutFunc r
  docInOutMethod :: Label -> r (Scope r) -> r (Permanence r) -> DocInOutFunc r
  -- inOutFunc and docInOutFunc both do not need the Permanence parameter
  inOutFunc :: Label -> r (Scope r) -> InOutFunc r
  docInOutFunc :: Label -> r (Scope r) -> DocInOutFunc r

privMethod :: (MethodSym r) => Label -> VSType r -> [MSParameter r] -> MSBody r 
  -> SMethod r
privMethod :: Label -> VSType r -> [MSParameter r] -> MSBody r -> SMethod r
privMethod n :: Label
n = Label
-> r (Scope r)
-> r (Permanence r)
-> VSType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
forall (r :: * -> *).
MethodSym r =>
Label
-> r (Scope r)
-> r (Permanence r)
-> VSType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
method Label
n r (Scope r)
forall (r :: * -> *). ScopeSym r => r (Scope r)
private r (Permanence r)
forall (r :: * -> *). PermanenceSym r => r (Permanence r)
dynamic

pubMethod :: (MethodSym r) => Label -> VSType r -> [MSParameter r] -> MSBody r 
  -> SMethod r
pubMethod :: Label -> VSType r -> [MSParameter r] -> MSBody r -> SMethod r
pubMethod n :: Label
n = Label
-> r (Scope r)
-> r (Permanence r)
-> VSType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
forall (r :: * -> *).
MethodSym r =>
Label
-> r (Scope r)
-> r (Permanence r)
-> VSType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
method Label
n r (Scope r)
forall (r :: * -> *). ScopeSym r => r (Scope r)
public r (Permanence r)
forall (r :: * -> *). PermanenceSym r => r (Permanence r)
dynamic

initializer :: (MethodSym r) => [MSParameter r] -> Initializers r -> SMethod r
initializer :: [MSParameter r] -> Initializers r -> SMethod r
initializer ps :: [MSParameter r]
ps is :: Initializers r
is = [MSParameter r] -> Initializers r -> MSBody r -> SMethod r
forall (r :: * -> *).
MethodSym r =>
[MSParameter r] -> Initializers r -> MSBody r -> SMethod r
constructor [MSParameter r]
ps Initializers r
is ([MSBlock r] -> MSBody r
forall (r :: * -> *). BodySym r => [MSBlock r] -> MSBody r
body [])

nonInitConstructor :: (MethodSym r) => [MSParameter r] -> MSBody r -> SMethod r
nonInitConstructor :: [MSParameter r] -> MSBody r -> SMethod r
nonInitConstructor ps :: [MSParameter r]
ps = [MSParameter r] -> Initializers r -> MSBody r -> SMethod r
forall (r :: * -> *).
MethodSym r =>
[MSParameter r] -> Initializers r -> MSBody r -> SMethod r
constructor [MSParameter r]
ps []

type CSStateVar a = CS (a (StateVar a))

class (ScopeSym r, PermanenceSym r, VariableSym r) => StateVarSym r where
  type StateVar r
  stateVar :: r (Scope r) -> r (Permanence r) -> SVariable r -> CSStateVar r
  stateVarDef :: r (Scope r) -> r (Permanence r) -> SVariable r -> 
    SValue r -> CSStateVar r
  constVar :: r (Scope r) ->  SVariable r -> SValue r -> CSStateVar r

privDVar :: (StateVarSym r) => SVariable r -> CSStateVar r
privDVar :: SVariable r -> CSStateVar r
privDVar = r (Scope r) -> r (Permanence r) -> SVariable r -> CSStateVar r
forall (r :: * -> *).
StateVarSym r =>
r (Scope r) -> r (Permanence r) -> SVariable r -> CSStateVar r
stateVar r (Scope r)
forall (r :: * -> *). ScopeSym r => r (Scope r)
private r (Permanence r)
forall (r :: * -> *). PermanenceSym r => r (Permanence r)
dynamic

pubDVar :: (StateVarSym r) => SVariable r -> CSStateVar r
pubDVar :: SVariable r -> CSStateVar r
pubDVar = r (Scope r) -> r (Permanence r) -> SVariable r -> CSStateVar r
forall (r :: * -> *).
StateVarSym r =>
r (Scope r) -> r (Permanence r) -> SVariable r -> CSStateVar r
stateVar r (Scope r)
forall (r :: * -> *). ScopeSym r => r (Scope r)
public r (Permanence r)
forall (r :: * -> *). PermanenceSym r => r (Permanence r)
dynamic

pubSVar :: (StateVarSym r) => SVariable r -> CSStateVar r
pubSVar :: SVariable r -> CSStateVar r
pubSVar = r (Scope r) -> r (Permanence r) -> SVariable r -> CSStateVar r
forall (r :: * -> *).
StateVarSym r =>
r (Scope r) -> r (Permanence r) -> SVariable r -> CSStateVar r
stateVar r (Scope r)
forall (r :: * -> *). ScopeSym r => r (Scope r)
public r (Permanence r)
forall (r :: * -> *). PermanenceSym r => r (Permanence r)
static

type SClass a = CS (a (Class a))

class (MethodSym r, StateVarSym r) => ClassSym r where
  type Class r
  buildClass :: Maybe Label -> [CSStateVar r] -> [SMethod r] -> 
    SClass r
  extraClass :: Label -> Maybe Label -> [CSStateVar r] -> [SMethod r] -> 
    SClass r
  implementingClass :: Label -> [Label] -> [CSStateVar r] -> [SMethod r] -> 
    SClass r

  docClass :: String -> SClass r -> SClass r

type FSModule a = FS (a (Module a))

class (ClassSym r) => ModuleSym r where
  type Module r
  buildModule :: Label -> [Label] -> [SMethod r] -> [SClass r] -> FSModule r

-- Utility

convType :: (TypeSym r) => CodeType -> VSType r
convType :: CodeType -> VSType r
convType Boolean = VSType r
forall (r :: * -> *). TypeSym r => VSType r
bool
convType Integer = VSType r
forall (r :: * -> *). TypeSym r => VSType r
int
convType Float = VSType r
forall (r :: * -> *). TypeSym r => VSType r
float
convType Double = VSType r
forall (r :: * -> *). TypeSym r => VSType r
double
convType Char = VSType r
forall (r :: * -> *). TypeSym r => VSType r
char
convType String = VSType r
forall (r :: * -> *). TypeSym r => VSType r
string
convType (List t :: 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 (Array t :: 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 (Object n :: Label
n) = Label -> VSType r
forall (r :: * -> *). TypeSym r => Label -> VSType r
obj Label
n
convType (Func ps :: [CodeType]
ps r :: 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 Void = VSType r
forall (r :: * -> *). TypeSym r => VSType r
void
convType InFile = VSType r
forall (r :: * -> *). TypeSym r => VSType r
infile
convType OutFile = VSType r
forall (r :: * -> *). TypeSym r => VSType r
outfile