{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FunctionalDependencies #-}

module Drasil.GOOL.InterfaceGOOL (
  -- Types
  Program, GSProgram, File, Module, Class, StateVar, CSStateVar, Initializers,
  -- Typeclasses
  OOProg, OOStatement, ProgramSym(..), FileSym(..), ModuleSym(..), ClassSym(..),
  OOTypeSym(..), OOVariableSym(..), ($->), SelfSym(..), instanceVarSelf,
  OOValueSym, OOVariableValue, OOValueExpression(..), selfMethodCall, newObj,
  extNewObj, libNewObj, OODeclStatement(..), objDecNewNoParams,
  extObjDecNewNoParams, OOFuncAppStatement(..), GetSet(..), InternalValueExp(..),
  objMethodCall, objMethodCallNamedArgs, objMethodCallMixedArgs,
  objMethodCallNoParams, classMethodCall, classMethodCallNamedArgs,
  classMethodCallMixedArgs, classMethodCallNoParams, OOMethodSym(..), privMethod,
  pubMethod, initializer, nonInitConstructor, StateVarSym(..), privDVar, pubDVar,
  pubSVar, AttachmentSym(..), OOFunctionSym(..), ($.), selfAccess,
  ObserverPattern(..), observerListName, initObserverList, addObserver,
  StrategyPattern(..), convTypeOO
  ) where

import Drasil.Shared.InterfaceCommon (
  -- Types
  Label, Library, Body, Block, SVariable, SValue, NamedArgs, MixedCtorCall,
  PosCall, PosCtorCall, InOutCall, InOutFunc, DocInOutFunc,
  -- Typeclasses
  SharedProg, SharedStatement, BodySym(body), TypeSym(..), FunctionSym,
  MethodSym(..), VariableSym(var), ValueSym(valueType), VariableValue(valueOf),
  ValueExpression, List(listSize, listAdd), listOf, StatementSym(..),
  DeclStatement(listDecDef), FuncAppStatement, VisibilitySym(..), convType)
import Drasil.Shared.CodeType (CodeType(..), ClassName)
import Drasil.Shared.Helpers (onStateValue)
import Drasil.Shared.State (GS, FS, CS, MS, VS)
import Drasil.Shared.AST (ScopeData, TypeData, ParamData, FileData, FuncData,
  ModData, ProgData)

import Text.PrettyPrint.HughesPJ (Doc)

class (SharedProg r vis smt md, OOStatement r smt,
  ProgramSym r vis smt md svr att prg, ObserverPattern r smt,
  StrategyPattern r smt
  ) => OOProg r vis smt md svr att prg

class (SharedStatement r smt, GetSet r, InternalValueExp r, OOFuncAppStatement r smt,
  OOVariableValue r, OODeclStatement r smt, OOFuncAppStatement r smt,
  OOFunctionSym r, OOValueExpression r
  ) => OOStatement r smt

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

class (FileSym r vis smt md svr att) => ProgramSym r vis smt md svr att prg | r -> prg where
  prog :: Label -> Label -> [FS (r File)] -> GSProgram r prg

type File = FileData

class (ModuleSym r vis smt md svr att) => FileSym r vis smt md svr att where
  fileDoc :: FS (r Module) -> FS (r File)

  -- Module description, watermark, list of author names, date as a String, file to comment
  docMod :: String -> String -> [String] -> String -> FS (r File) -> FS (r File)

type Module = ModData

class (ClassSym r vis smt md svr att) => ModuleSym r vis smt md svr att where
  -- Module name, import names, module functions, module classes
  buildModule :: Label -> [Label] -> [MS (r md)] -> [CS (r Class)] -> FS (r Module)

type Class = Doc

class (OOMethodSym r vis smt md att, StateVarSym r vis svr att) => ClassSym r vis smt md svr att where
  -- | Main external method for creating a class.
  --   Inputs: parent class, variables, constructor(s), methods
  buildClass :: Maybe Label -> [CSStateVar r svr] -> [MS (r md)] ->
    [MS (r md)] -> CS (r Class)
  -- | Creates an extra class.
  --   Inputs: class name, the rest are the same as buildClass.
  extraClass :: Label -> Maybe Label -> [CSStateVar r svr] -> [MS (r md)] ->
    [MS (r md)] -> CS (r Class)
  -- | Creates a class implementing interfaces.
  --   Inputs: class name, interface names, variables, constructor(s), methods
  implementingClass :: Label -> [Label] -> [CSStateVar r svr] -> [MS (r md)] ->
    [MS (r md)] -> CS (r Class)

  docClass :: String -> CS (r Class) -> CS (r Class)

type Initializers r = [(SVariable r, SValue r)]

class (MethodSym r vis smt md, AttachmentSym r att) => OOMethodSym r vis smt md att where
  method      :: Label -> r vis -> r att -> VS (r TypeData) ->
    [MS (r ParamData)] -> MS (r Body) -> MS (r md)
  getMethod   :: SVariable r -> MS (r md)
  setMethod   :: SVariable r -> MS (r md)
  constructor :: [MS (r ParamData)] -> Initializers r -> MS (r Body) -> MS (r md)

  -- inOutMethod and docInOutMethod both need AttachmentSym
  inOutMethod :: Label -> r vis -> r att -> InOutFunc r md
  docInOutMethod :: Label -> r vis -> r att -> DocInOutFunc r md

privMethod :: (OOMethodSym r vis smt md att) => Label -> VS (r TypeData) ->
  [MS (r ParamData)] -> MS (r Body) -> MS (r md)
privMethod :: forall (r :: * -> *) vis smt md att.
OOMethodSym r vis smt md att =>
Label
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r Body)
-> MS (r md)
privMethod Label
n = Label
-> r vis
-> r att
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r Body)
-> MS (r md)
forall (r :: * -> *) vis smt md att.
OOMethodSym r vis smt md att =>
Label
-> r vis
-> r att
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r Body)
-> MS (r md)
method Label
n r vis
forall (r :: * -> *) vis. VisibilitySym r vis => r vis
private r att
forall (r :: * -> *) att. AttachmentSym r att => r att
instanceLevel

pubMethod :: (OOMethodSym r vis smt md att) => Label -> VS (r TypeData) ->
  [MS (r ParamData)] -> MS (r Body) -> MS (r md)
pubMethod :: forall (r :: * -> *) vis smt md att.
OOMethodSym r vis smt md att =>
Label
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r Body)
-> MS (r md)
pubMethod Label
n = Label
-> r vis
-> r att
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r Body)
-> MS (r md)
forall (r :: * -> *) vis smt md att.
OOMethodSym r vis smt md att =>
Label
-> r vis
-> r att
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r Body)
-> MS (r md)
method Label
n r vis
forall (r :: * -> *) vis. VisibilitySym r vis => r vis
public r att
forall (r :: * -> *) att. AttachmentSym r att => r att
instanceLevel

initializer :: (OOMethodSym r vis smt md att) => [MS (r ParamData)] ->
  Initializers r -> MS (r md)
initializer :: forall (r :: * -> *) vis smt md att.
OOMethodSym r vis smt md att =>
[MS (r ParamData)] -> Initializers r -> MS (r md)
initializer [MS (r ParamData)]
ps Initializers r
is = [MS (r ParamData)] -> Initializers r -> MS (r Body) -> MS (r md)
forall (r :: * -> *) vis smt md att.
OOMethodSym r vis smt md att =>
[MS (r ParamData)] -> Initializers r -> MS (r Body) -> MS (r md)
constructor [MS (r ParamData)]
ps Initializers r
is ([MS (r Body)] -> MS (r Body)
forall (r :: * -> *) smt.
BodySym r smt =>
[MS (r Body)] -> MS (r Body)
body [])

nonInitConstructor :: (OOMethodSym r vis smt md att) => [MS (r ParamData)] ->
  MS (r Body) -> MS (r md)
nonInitConstructor :: forall (r :: * -> *) vis smt md att.
OOMethodSym r vis smt md att =>
[MS (r ParamData)] -> MS (r Body) -> MS (r md)
nonInitConstructor [MS (r ParamData)]
ps = [MS (r ParamData)] -> Initializers r -> MS (r Body) -> MS (r md)
forall (r :: * -> *) vis smt md att.
OOMethodSym r vis smt md att =>
[MS (r ParamData)] -> Initializers r -> MS (r Body) -> MS (r md)
constructor [MS (r ParamData)]
ps []

type StateVar = Doc
type CSStateVar r svr = CS (r svr)

class (VisibilitySym r vis, AttachmentSym r att, VariableSym r) => StateVarSym r vis svr att | r -> svr where
  stateVar :: r vis -> r att -> SVariable r -> CSStateVar r svr
  stateVarDef :: r vis -> r att -> SVariable r -> SValue r -> CSStateVar r svr
  constVar :: r vis ->  SVariable r -> SValue r -> CSStateVar r svr

privDVar :: (StateVarSym r vis svr att) => SVariable r -> CSStateVar r svr
privDVar :: forall (r :: * -> *) vis svr att.
StateVarSym r vis svr att =>
SVariable r -> CSStateVar r svr
privDVar = r vis -> r att -> SVariable r -> CSStateVar r svr
forall (r :: * -> *) vis svr att.
StateVarSym r vis svr att =>
r vis -> r att -> SVariable r -> CSStateVar r svr
stateVar r vis
forall (r :: * -> *) vis. VisibilitySym r vis => r vis
private r att
forall (r :: * -> *) att. AttachmentSym r att => r att
instanceLevel

pubDVar :: (StateVarSym r vis svr att) => SVariable r -> CSStateVar r svr
pubDVar :: forall (r :: * -> *) vis svr att.
StateVarSym r vis svr att =>
SVariable r -> CSStateVar r svr
pubDVar = r vis -> r att -> SVariable r -> CSStateVar r svr
forall (r :: * -> *) vis svr att.
StateVarSym r vis svr att =>
r vis -> r att -> SVariable r -> CSStateVar r svr
stateVar r vis
forall (r :: * -> *) vis. VisibilitySym r vis => r vis
public r att
forall (r :: * -> *) att. AttachmentSym r att => r att
instanceLevel

pubSVar :: (StateVarSym r vis svr att) => SVariable r -> CSStateVar r svr
pubSVar :: forall (r :: * -> *) vis svr att.
StateVarSym r vis svr att =>
SVariable r -> CSStateVar r svr
pubSVar = r vis -> r att -> SVariable r -> CSStateVar r svr
forall (r :: * -> *) vis svr att.
StateVarSym r vis svr att =>
r vis -> r att -> SVariable r -> CSStateVar r svr
stateVar r vis
forall (r :: * -> *) vis. VisibilitySym r vis => r vis
public r att
forall (r :: * -> *) att. AttachmentSym r att => r att
classLevel

-- | Used to differentiate whether a member is attached to the class or the instance
class AttachmentSym r att | r -> att where
  classLevel  :: r att
  instanceLevel :: r att

class (TypeSym r) => OOTypeSym r where
  obj :: ClassName -> VS (r TypeData)

class (ValueSym r, OOTypeSym r) => OOValueSym r

class (VariableSym r, OOTypeSym r) => OOVariableSym r where
  -- | A class-level variable, separate from its class (i.e. `v`, not `C.v`)
  classVar          :: Label -> VS (r TypeData) -> SVariable r
  -- | A class-level constant, separate from its class (i.e. `v`, not `C.v`)
  classConst        :: Label -> VS (r TypeData) -> SVariable r
  -- | Given a class `C` and a class-level variable `v`, creates `C.v`
  classVarAccess    :: VS (r TypeData) -> SVariable r -> SVariable r
  -- | Given a class `C` from an external module and a class-level variable `v`,
  -- performs any necessary imports and creates `C.v`
  extClassVarAccess :: VS (r TypeData) -> SVariable r -> SVariable r
  -- | Given an instance `i` and an instance-level variable `v`, creates `i.v`
  instanceVarAccess :: SValue r -> SVariable r -> SVariable r

($->) :: (OOVariableSym r) => SValue r -> SVariable r -> SVariable r
infixl 9 $->
$-> :: forall (r :: * -> *).
OOVariableSym r =>
SValue r -> SVariable r -> SVariable r
($->) = SValue r -> SVariable r -> SVariable r
forall (r :: * -> *).
OOVariableSym r =>
SValue r -> SVariable r -> SVariable r
instanceVarAccess

class (OOVariableSym r) => SelfSym r where
  -- | `self` keyword
  self              :: SVariable r

-- | Given a variable `v`, creates `self.v`
instanceVarSelf   :: (SelfSym r, VariableValue r) => SVariable r -> SVariable r
instanceVarSelf :: forall (r :: * -> *).
(SelfSym r, VariableValue r) =>
SVariable r -> SVariable r
instanceVarSelf = SValue r -> SVariable r -> SVariable r
forall (r :: * -> *).
OOVariableSym r =>
SValue r -> SVariable r -> SVariable r
instanceVarAccess (SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable r
forall (r :: * -> *). SelfSym r => SVariable r
self)

class (VariableValue r, OOVariableSym r, SelfSym r) => OOVariableValue r

-- for values that can include expressions
class (ValueExpression r, OOVariableSym r, OOValueSym r) => OOValueExpression r where
  newObjMixedArgs         ::            MixedCtorCall r
  extNewObjMixedArgs      :: Library -> MixedCtorCall r
  libNewObjMixedArgs      :: Library -> MixedCtorCall r

selfMethodCall   :: (InternalValueExp r, VariableValue r, SelfSym r) => PosCall r
selfMethodCall :: forall (r :: * -> *).
(InternalValueExp r, VariableValue r, SelfSym r) =>
PosCall r
selfMethodCall Label
n VS (r TypeData)
t = VS (r TypeData) -> SValue r -> Label -> [SValue r] -> SValue r
forall (r :: * -> *).
InternalValueExp r =>
VS (r TypeData) -> SValue r -> Label -> [SValue r] -> SValue r
objMethodCall VS (r TypeData)
t (SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable r
forall (r :: * -> *). SelfSym r => SVariable r
self) Label
n

newObj           :: (OOValueExpression r) =>            PosCtorCall r
newObj :: forall (r :: * -> *). OOValueExpression r => PosCtorCall r
newObj VS (r TypeData)
t [SValue r]
vs = MixedCtorCall r
forall (r :: * -> *). OOValueExpression r => MixedCtorCall r
newObjMixedArgs VS (r TypeData)
t [SValue r]
vs []

extNewObj        :: (OOValueExpression r) => Library -> PosCtorCall r
extNewObj :: forall (r :: * -> *). OOValueExpression r => Label -> PosCtorCall r
extNewObj Label
l VS (r TypeData)
t [SValue r]
vs = Label -> MixedCtorCall r
forall (r :: * -> *).
OOValueExpression r =>
Label -> MixedCtorCall r
extNewObjMixedArgs Label
l VS (r TypeData)
t [SValue r]
vs []

libNewObj        :: (OOValueExpression r) => Library -> PosCtorCall r
libNewObj :: forall (r :: * -> *). OOValueExpression r => Label -> PosCtorCall r
libNewObj Label
l VS (r TypeData)
t [SValue r]
vs = Label -> MixedCtorCall r
forall (r :: * -> *).
OOValueExpression r =>
Label -> MixedCtorCall r
libNewObjMixedArgs Label
l VS (r TypeData)
t [SValue r]
vs []

class (ValueSym r) => InternalValueExp r where
  -- | Generic function for calling a method.
  --   Takes the function name, the return type, the object, a list of
  --   positional arguments, and a list of named arguments.
  objMethodCallMixedArgs' :: Label -> VS (r TypeData) -> SValue r -> [SValue r] ->
    NamedArgs r -> SValue r
  -- | Generic function for calling a class method.
  --   Takes the function name, the return type, the class type,
  --   a list of positional arguments, and a list of named arguments.
  classMethodCallMixedArgs' :: Label -> VS (r TypeData) -> VS (r TypeData) -> [SValue r] ->
    NamedArgs r -> SValue r

-- | Calling a method. t is the return type of the method, o is the
--   object, f is the method name, and ps is a list of positional arguments.
objMethodCall :: (InternalValueExp r) => VS (r TypeData) -> SValue r -> Label ->
  [SValue r] -> SValue r
objMethodCall :: forall (r :: * -> *).
InternalValueExp r =>
VS (r TypeData) -> SValue r -> Label -> [SValue r] -> SValue r
objMethodCall VS (r TypeData)
t SValue r
o Label
f [SValue r]
ps = Label
-> VS (r TypeData)
-> SValue r
-> [SValue r]
-> NamedArgs r
-> SValue r
forall (r :: * -> *).
InternalValueExp r =>
Label
-> VS (r TypeData)
-> SValue r
-> [SValue r]
-> NamedArgs r
-> SValue r
objMethodCallMixedArgs' Label
f VS (r TypeData)
t SValue r
o [SValue r]
ps []

-- | Calling a method with named arguments.
objMethodCallNamedArgs :: (InternalValueExp r) => VS (r TypeData) -> SValue r ->
  Label -> NamedArgs r -> SValue r
objMethodCallNamedArgs :: forall (r :: * -> *).
InternalValueExp r =>
VS (r TypeData) -> SValue r -> Label -> NamedArgs r -> SValue r
objMethodCallNamedArgs VS (r TypeData)
t SValue r
o Label
f = Label
-> VS (r TypeData)
-> SValue r
-> [SValue r]
-> NamedArgs r
-> SValue r
forall (r :: * -> *).
InternalValueExp r =>
Label
-> VS (r TypeData)
-> SValue r
-> [SValue r]
-> NamedArgs r
-> SValue r
objMethodCallMixedArgs' Label
f VS (r TypeData)
t SValue r
o []

-- | Calling a method with a mix of positional and named arguments.
objMethodCallMixedArgs :: (InternalValueExp r) => VS (r TypeData) -> SValue r ->
  Label -> [SValue r] -> NamedArgs r -> SValue r
objMethodCallMixedArgs :: forall (r :: * -> *).
InternalValueExp r =>
VS (r TypeData)
-> SValue r -> Label -> [SValue r] -> NamedArgs r -> SValue r
objMethodCallMixedArgs VS (r TypeData)
t SValue r
o Label
f = Label
-> VS (r TypeData)
-> SValue r
-> [SValue r]
-> NamedArgs r
-> SValue r
forall (r :: * -> *).
InternalValueExp r =>
Label
-> VS (r TypeData)
-> SValue r
-> [SValue r]
-> NamedArgs r
-> SValue r
objMethodCallMixedArgs' Label
f VS (r TypeData)
t SValue r
o

-- | Calling a method with no parameters.
objMethodCallNoParams :: (InternalValueExp r) => VS (r TypeData) -> SValue r ->
  Label -> SValue r
objMethodCallNoParams :: forall (r :: * -> *).
InternalValueExp r =>
VS (r TypeData) -> SValue r -> Label -> SValue r
objMethodCallNoParams VS (r TypeData)
t SValue r
o Label
f = VS (r TypeData) -> SValue r -> Label -> [SValue r] -> SValue r
forall (r :: * -> *).
InternalValueExp r =>
VS (r TypeData) -> SValue r -> Label -> [SValue r] -> SValue r
objMethodCall VS (r TypeData)
t SValue r
o Label
f []

-- | Calling a class method. t is the return type of the method, c is the
--   class, f is the method name, and ps is a list of positional arguments.
classMethodCall :: (InternalValueExp r) => VS (r TypeData) -> VS (r TypeData) -> Label ->
  [SValue r] -> SValue r
classMethodCall :: forall (r :: * -> *).
InternalValueExp r =>
VS (r TypeData)
-> VS (r TypeData) -> Label -> [SValue r] -> SValue r
classMethodCall VS (r TypeData)
t VS (r TypeData)
c Label
f [SValue r]
ps = Label
-> VS (r TypeData)
-> VS (r TypeData)
-> [SValue r]
-> NamedArgs r
-> SValue r
forall (r :: * -> *).
InternalValueExp r =>
Label
-> VS (r TypeData)
-> VS (r TypeData)
-> [SValue r]
-> NamedArgs r
-> SValue r
classMethodCallMixedArgs' Label
f VS (r TypeData)
t VS (r TypeData)
c [SValue r]
ps []

-- | Calling a class method with named arguments.
classMethodCallNamedArgs :: (InternalValueExp r) => VS (r TypeData) -> VS (r TypeData) ->
  Label -> NamedArgs r -> SValue r
classMethodCallNamedArgs :: forall (r :: * -> *).
InternalValueExp r =>
VS (r TypeData)
-> VS (r TypeData) -> Label -> NamedArgs r -> SValue r
classMethodCallNamedArgs VS (r TypeData)
t VS (r TypeData)
c Label
f = Label
-> VS (r TypeData)
-> VS (r TypeData)
-> [SValue r]
-> NamedArgs r
-> SValue r
forall (r :: * -> *).
InternalValueExp r =>
Label
-> VS (r TypeData)
-> VS (r TypeData)
-> [SValue r]
-> NamedArgs r
-> SValue r
classMethodCallMixedArgs' Label
f VS (r TypeData)
t VS (r TypeData)
c []

-- | Calling a class method with a mix of positional and named arguments.
classMethodCallMixedArgs :: (InternalValueExp r) => VS (r TypeData) -> VS (r TypeData) ->
  Label -> [SValue r] -> NamedArgs r -> SValue r
classMethodCallMixedArgs :: forall (r :: * -> *).
InternalValueExp r =>
VS (r TypeData)
-> VS (r TypeData)
-> Label
-> [SValue r]
-> NamedArgs r
-> SValue r
classMethodCallMixedArgs VS (r TypeData)
t VS (r TypeData)
c Label
f = Label
-> VS (r TypeData)
-> VS (r TypeData)
-> [SValue r]
-> NamedArgs r
-> SValue r
forall (r :: * -> *).
InternalValueExp r =>
Label
-> VS (r TypeData)
-> VS (r TypeData)
-> [SValue r]
-> NamedArgs r
-> SValue r
classMethodCallMixedArgs' Label
f VS (r TypeData)
t VS (r TypeData)
c

-- | Calling a class method with no parameters.
classMethodCallNoParams :: (InternalValueExp r) => VS (r TypeData) -> VS (r TypeData) ->
  Label -> SValue r
classMethodCallNoParams :: forall (r :: * -> *).
InternalValueExp r =>
VS (r TypeData) -> VS (r TypeData) -> Label -> SValue r
classMethodCallNoParams VS (r TypeData)
t VS (r TypeData)
c Label
f = VS (r TypeData)
-> VS (r TypeData) -> Label -> [SValue r] -> SValue r
forall (r :: * -> *).
InternalValueExp r =>
VS (r TypeData)
-> VS (r TypeData) -> Label -> [SValue r] -> SValue r
classMethodCall VS (r TypeData)
t VS (r TypeData)
c Label
f []

class (DeclStatement r smt, OOVariableSym r) => OODeclStatement r smt where
  objDecDef    :: SVariable r -> r ScopeData -> SValue r -> MS (r smt)
  -- Parameters: variable to store the object, scope of the variable,
  --             constructor arguments.  Object type is not needed,
  --             as it is inferred from the variable's type.
  objDecNew    :: SVariable r -> r ScopeData -> [SValue r] -> MS (r smt)
  extObjDecNew :: Library -> SVariable r -> r ScopeData -> [SValue r]
    -> MS (r smt)

objDecNewNoParams :: (OODeclStatement r smt) => SVariable r -> r ScopeData
  -> MS (r smt)
objDecNewNoParams :: forall (r :: * -> *) smt.
OODeclStatement r smt =>
SVariable r -> r ScopeData -> MS (r smt)
objDecNewNoParams SVariable r
v r ScopeData
tp = SVariable r -> r ScopeData -> [SValue r] -> MS (r smt)
forall (r :: * -> *) smt.
OODeclStatement r smt =>
SVariable r -> r ScopeData -> [SValue r] -> MS (r smt)
objDecNew SVariable r
v r ScopeData
tp []

extObjDecNewNoParams :: (OODeclStatement r smt) => Library -> SVariable r ->
  r ScopeData -> MS (r smt)
extObjDecNewNoParams :: forall (r :: * -> *) smt.
OODeclStatement r smt =>
Label -> SVariable r -> r ScopeData -> MS (r smt)
extObjDecNewNoParams Label
l SVariable r
v r ScopeData
tp = Label -> SVariable r -> r ScopeData -> [SValue r] -> MS (r smt)
forall (r :: * -> *) smt.
OODeclStatement r smt =>
Label -> SVariable r -> r ScopeData -> [SValue r] -> MS (r smt)
extObjDecNew Label
l SVariable r
v r ScopeData
tp []

class (FuncAppStatement r smt, OOVariableSym r) => OOFuncAppStatement r smt where
  selfInOutCall :: InOutCall r smt

class (StatementSym r smt, OOFunctionSym r) => ObserverPattern r smt where
  notifyObservers :: VS (r FuncData) -> VS (r TypeData) -> MS (r smt)

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

initObserverList :: (DeclStatement r smt) => VS (r TypeData) -> [SValue r] ->
  r ScopeData -> MS (r smt)
initObserverList :: forall (r :: * -> *) smt.
DeclStatement r smt =>
VS (r TypeData) -> [SValue r] -> r ScopeData -> MS (r smt)
initObserverList VS (r TypeData)
t [SValue r]
os r ScopeData
scp = SVariable r -> r ScopeData -> [SValue r] -> MS (r smt)
forall (r :: * -> *) smt.
DeclStatement r smt =>
SVariable r -> r ScopeData -> [SValue r] -> MS (r smt)
listDecDef (Label -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Label -> VS (r TypeData) -> SVariable r
var Label
observerListName (VS (r TypeData) -> VS (r TypeData)
forall (r :: * -> *).
TypeSym r =>
VS (r TypeData) -> VS (r TypeData)
listType VS (r TypeData)
t)) r ScopeData
scp [SValue r]
os

addObserver :: (OOVariableValue r, List r smt) => SValue r -> MS (r smt)
addObserver :: forall (r :: * -> *) smt.
(OOVariableValue r, List r smt) =>
SValue r -> MS (r smt)
addObserver SValue r
o = SValue r -> SValue r -> SValue r -> MS (r smt)
forall (r :: * -> *) smt.
List r smt =>
SValue r -> SValue r -> SValue r -> MS (r smt)
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 -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Label -> VS (r TypeData) -> SVariable r
listOf Label
observerListName ((r Value -> r TypeData) -> SValue r -> VS (r TypeData)
forall a b s. (a -> b) -> State s a -> State s b
onStateValue r Value -> r TypeData
forall (r :: * -> *). ValueSym r => r Value -> r TypeData
valueType SValue r
o)
        lastelem :: SValue r
lastelem = SValue r -> SValue r
forall (r :: * -> *) smt. List r smt => SValue r -> SValue r
listSize SValue r
obsList

class (BodySym r smt, VariableSym r) => StrategyPattern r smt where
  runStrategy :: Label -> [(Label, MS (r Body))] -> Maybe (SValue r) ->
    Maybe (SVariable r) -> MS (r Block)

class (FunctionSym r) => OOFunctionSym r where
  func :: Label -> VS (r TypeData) -> [SValue r] -> VS (r FuncData)
  objAccess :: SValue r -> VS (r FuncData) -> SValue r

($.) :: (OOFunctionSym r) => SValue r -> VS (r FuncData) -> SValue r
infixl 9 $.
$. :: forall (r :: * -> *).
OOFunctionSym r =>
SValue r -> VS (r FuncData) -> SValue r
($.) = SValue r -> VS (r FuncData) -> SValue r
forall (r :: * -> *).
OOFunctionSym r =>
SValue r -> VS (r FuncData) -> SValue r
objAccess

selfAccess :: (OOVariableValue r, OOFunctionSym r) => VS (r FuncData) -> SValue r
selfAccess :: forall (r :: * -> *).
(OOVariableValue r, OOFunctionSym r) =>
VS (r FuncData) -> SValue r
selfAccess = SValue r -> VS (r FuncData) -> SValue r
forall (r :: * -> *).
OOFunctionSym r =>
SValue r -> VS (r FuncData) -> SValue r
objAccess (SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable r
forall (r :: * -> *). SelfSym 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

convTypeOO :: (OOTypeSym r) => CodeType -> VS (r TypeData)
convTypeOO :: forall (r :: * -> *). OOTypeSym r => CodeType -> VS (r TypeData)
convTypeOO (Object Label
n) = Label -> VS (r TypeData)
forall (r :: * -> *). OOTypeSym r => Label -> VS (r TypeData)
obj Label
n
convTypeOO (Reference CodeType
t) = VS (r TypeData) -> VS (r TypeData)
forall (r :: * -> *).
TypeSym r =>
VS (r TypeData) -> VS (r TypeData)
referenceType (CodeType -> VS (r TypeData)
forall (r :: * -> *). OOTypeSym r => CodeType -> VS (r TypeData)
convTypeOO CodeType
t)
convTypeOO CodeType
t = CodeType -> VS (r TypeData)
forall (r :: * -> *). TypeSym r => CodeType -> VS (r TypeData)
convType CodeType
t