{-# LANGUAGE TypeFamilies #-}

module Drasil.GOOL.InterfaceGOOL (
  -- Types
  GSProgram, SFile, FSModule, SClass, CSStateVar, Initializers,
  -- Typeclasses
  OOProg, ProgramSym(..), FileSym(..), ModuleSym(..), ClassSym(..),
  OOTypeSym(..), OOVariableSym(..), ($->), SelfSym(..), InstanceVarSelfSym(..),
  OOValueSym, OOVariableValue, OOValueExpression(..), selfFuncApp, 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, MSBody, MSBlock, VSFunction, VSType, SVariable, SValue,
  MSStatement, NamedArgs, MSParameter, SMethod, MixedCall, MixedCtorCall,
  PosCall, PosCtorCall, InOutCall, InOutFunc, DocInOutFunc,
  -- Typeclasses
  SharedProg, BodySym(body), TypeSym(listType), FunctionSym, MethodSym,
  VariableSym(var), ValueSym(valueType), VariableValue(valueOf),
  ValueExpression, List(listSize, listAdd), listOf, StatementSym(valStmt),
  DeclStatement(listDecDef), FuncAppStatement, VisibilitySym(..), convType)
import Drasil.Shared.CodeType (CodeType(..), ClassName)
import Drasil.Shared.Helpers (onStateValue)
import Drasil.Shared.State (GS, FS, CS)
import Drasil.Shared.AST (ScopeData)

class (SharedProg r, ProgramSym r, OOVariableValue r, OODeclStatement r,
  OOFuncAppStatement r, OOValueExpression r, InternalValueExp r, GetSet r,
  ObserverPattern r, StrategyPattern r
  ) => OOProg r

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

class (FileSym r) => ProgramSym r where
  type Program r
  prog :: Label -> 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, watermark, list of author names, date as a String, file to comment
  docMod :: String -> String -> [String] -> String -> SFile r -> SFile r

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

class (ClassSym r) => ModuleSym r where
  type Module r
  -- Module name, import names, module functions, module classes
  buildModule :: Label -> [Label] -> [SMethod r] -> [SClass r] -> FSModule r

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

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

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

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

class (MethodSym r, AttachmentSym r) => OOMethodSym r where
  method      :: Label -> r (Visibility r) -> r (Attachment 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

  -- inOutMethod and docInOutMethod both need the Attachment parameter
  inOutMethod :: Label -> r (Visibility r) -> r (Attachment r) -> InOutFunc r
  docInOutMethod :: Label -> r (Visibility r) -> r (Attachment r) -> DocInOutFunc r

privMethod :: (OOMethodSym r) => Label -> VSType r -> [MSParameter r] -> MSBody r
  -> SMethod r
privMethod :: forall (r :: * -> *).
OOMethodSym r =>
Label -> VSType r -> [MSParameter r] -> MSBody r -> SMethod r
privMethod Label
n = Label
-> r (Visibility r)
-> r (Attachment r)
-> StateT ValueState Identity (r TypeData)
-> [StateT MethodState Identity (r (Parameter r))]
-> StateT MethodState Identity (r (Body r))
-> StateT MethodState Identity (r (Method r))
forall (r :: * -> *).
OOMethodSym r =>
Label
-> r (Visibility r)
-> r (Attachment r)
-> VSType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
method Label
n r (Visibility r)
forall (r :: * -> *). VisibilitySym r => r (Visibility r)
private r (Attachment r)
forall (r :: * -> *). AttachmentSym r => r (Attachment r)
instanceLevel

pubMethod :: (OOMethodSym r) => Label -> VSType r -> [MSParameter r] -> MSBody r
  -> SMethod r
pubMethod :: forall (r :: * -> *).
OOMethodSym r =>
Label -> VSType r -> [MSParameter r] -> MSBody r -> SMethod r
pubMethod Label
n = Label
-> r (Visibility r)
-> r (Attachment r)
-> StateT ValueState Identity (r TypeData)
-> [StateT MethodState Identity (r (Parameter r))]
-> StateT MethodState Identity (r (Body r))
-> StateT MethodState Identity (r (Method r))
forall (r :: * -> *).
OOMethodSym r =>
Label
-> r (Visibility r)
-> r (Attachment r)
-> VSType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
method Label
n r (Visibility r)
forall (r :: * -> *). VisibilitySym r => r (Visibility r)
public r (Attachment r)
forall (r :: * -> *). AttachmentSym r => r (Attachment r)
instanceLevel

initializer :: (OOMethodSym r) => [MSParameter r] -> Initializers r -> SMethod r
initializer :: forall (r :: * -> *).
OOMethodSym r =>
[MSParameter r] -> Initializers r -> SMethod r
initializer [MSParameter r]
ps Initializers r
is = [MSParameter r]
-> Initializers r
-> MSBody r
-> StateT MethodState Identity (r (Method r))
forall (r :: * -> *).
OOMethodSym 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 :: (OOMethodSym r) => [MSParameter r] -> MSBody r -> SMethod r
nonInitConstructor :: forall (r :: * -> *).
OOMethodSym r =>
[MSParameter r] -> MSBody r -> SMethod r
nonInitConstructor [MSParameter r]
ps = [MSParameter r]
-> Initializers r
-> StateT MethodState Identity (r (Body r))
-> StateT MethodState Identity (r (Method r))
forall (r :: * -> *).
OOMethodSym r =>
[MSParameter r] -> Initializers r -> MSBody r -> SMethod r
constructor [MSParameter r]
ps []

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

class (VisibilitySym r, AttachmentSym r, VariableSym r) => StateVarSym r where
  type StateVar r
  stateVar :: r (Visibility r) -> r (Attachment r) -> SVariable r -> CSStateVar r
  stateVarDef :: r (Visibility r) -> r (Attachment r) -> SVariable r ->
    SValue r -> CSStateVar r
  constVar :: r (Visibility r) ->  SVariable r -> SValue r -> CSStateVar r

privDVar :: (StateVarSym r) => SVariable r -> CSStateVar r
privDVar :: forall (r :: * -> *). StateVarSym r => SVariable r -> CSStateVar r
privDVar = r (Visibility r)
-> r (Attachment r)
-> StateT ValueState Identity (r (Variable r))
-> StateT ClassState Identity (r (StateVar r))
forall (r :: * -> *).
StateVarSym r =>
r (Visibility r) -> r (Attachment r) -> SVariable r -> CSStateVar r
stateVar r (Visibility r)
forall (r :: * -> *). VisibilitySym r => r (Visibility r)
private r (Attachment r)
forall (r :: * -> *). AttachmentSym r => r (Attachment r)
instanceLevel

pubDVar :: (StateVarSym r) => SVariable r -> CSStateVar r
pubDVar :: forall (r :: * -> *). StateVarSym r => SVariable r -> CSStateVar r
pubDVar = r (Visibility r)
-> r (Attachment r)
-> StateT ValueState Identity (r (Variable r))
-> StateT ClassState Identity (r (StateVar r))
forall (r :: * -> *).
StateVarSym r =>
r (Visibility r) -> r (Attachment r) -> SVariable r -> CSStateVar r
stateVar r (Visibility r)
forall (r :: * -> *). VisibilitySym r => r (Visibility r)
public r (Attachment r)
forall (r :: * -> *). AttachmentSym r => r (Attachment r)
instanceLevel

pubSVar :: (StateVarSym r) => SVariable r -> CSStateVar r
pubSVar :: forall (r :: * -> *). StateVarSym r => SVariable r -> CSStateVar r
pubSVar = r (Visibility r)
-> r (Attachment r)
-> StateT ValueState Identity (r (Variable r))
-> StateT ClassState Identity (r (StateVar r))
forall (r :: * -> *).
StateVarSym r =>
r (Visibility r) -> r (Attachment r) -> SVariable r -> CSStateVar r
stateVar r (Visibility r)
forall (r :: * -> *). VisibilitySym r => r (Visibility r)
public r (Attachment r)
forall (r :: * -> *). AttachmentSym r => r (Attachment r)
classLevel

-- | Used to differentiate whether a member is attached to the class or the instance
class AttachmentSym r where
  type Attachment r
  classLevel  :: r (Attachment r)
  instanceLevel :: r (Attachment r)

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

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 -> VSType r -> SVariable r
  -- | A class-level constant, separate from its class (i.e. `v`, not `C.v`)
  classConst        :: Label -> VSType r -> SVariable r
  -- | Given a class `C` and a class-level variable `v`, creates `C.v`
  classVarAccess    :: VSType r -> 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 :: VSType r -> 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

class (OOVariableSym r) => InstanceVarSelfSym r where
  -- | Given a variable `v`, creates `self.v`
  instanceVarSelf   :: SVariable r -> SVariable r

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

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

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

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

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

libNewObj        :: (OOValueExpression r) => Library -> PosCtorCall r
libNewObj :: forall (r :: * -> *). OOValueExpression r => PosCall r
libNewObj Label
l VSType r
t [SValue r]
vs = Label -> MixedCtorCall r
forall (r :: * -> *). OOValueExpression r => MixedCall r
libNewObjMixedArgs Label
l VSType r
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 -> VSType r -> 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 -> VSType r -> VSType r -> [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) => VSType r -> SValue r -> Label ->
  [SValue r] -> SValue r
objMethodCall :: forall (r :: * -> *).
InternalValueExp r =>
VSType r -> SValue r -> Label -> [SValue r] -> SValue r
objMethodCall VSType r
t SValue r
o Label
f [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 []

-- | Calling a method with named arguments.
objMethodCallNamedArgs :: (InternalValueExp r) => VSType r -> SValue r -> Label
  -> NamedArgs r -> SValue r
objMethodCallNamedArgs :: forall (r :: * -> *).
InternalValueExp r =>
VSType r -> SValue r -> Label -> NamedArgs r -> SValue r
objMethodCallNamedArgs VSType r
t SValue r
o Label
f = Label
-> VSType r
-> SValue r
-> [SValue r]
-> [(StateT ValueState Identity (r (Variable r)), SValue 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 []

-- | Calling a method with a mix of positional and named arguments.
objMethodCallMixedArgs :: (InternalValueExp r) => VSType r -> SValue r -> Label
  -> [SValue r] -> NamedArgs r -> SValue r
objMethodCallMixedArgs :: forall (r :: * -> *).
InternalValueExp r =>
VSType r
-> SValue r -> Label -> [SValue r] -> NamedArgs r -> SValue r
objMethodCallMixedArgs VSType r
t SValue r
o Label
f = Label
-> VSType r
-> SValue r
-> [SValue r]
-> [(StateT ValueState Identity (r (Variable r)), SValue 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

-- | Calling a method with no parameters.
objMethodCallNoParams :: (InternalValueExp r) => VSType r -> SValue r -> Label
  -> SValue r
objMethodCallNoParams :: forall (r :: * -> *).
InternalValueExp r =>
VSType r -> SValue r -> Label -> SValue r
objMethodCallNoParams VSType r
t SValue r
o 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 []

-- | 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) => VSType r -> VSType r -> Label ->
  [SValue r] -> SValue r
classMethodCall :: forall (r :: * -> *).
InternalValueExp r =>
VSType r -> VSType r -> Label -> [SValue r] -> SValue r
classMethodCall VSType r
t VSType r
c Label
f [SValue r]
ps = Label
-> VSType r -> VSType r -> [SValue r] -> NamedArgs r -> SValue r
forall (r :: * -> *).
InternalValueExp r =>
Label
-> VSType r -> VSType r -> [SValue r] -> NamedArgs r -> SValue r
classMethodCallMixedArgs' Label
f VSType r
t VSType r
c [SValue r]
ps []

-- | Calling a class method with named arguments.
classMethodCallNamedArgs :: (InternalValueExp r) => VSType r -> VSType r -> Label
  -> NamedArgs r -> SValue r
classMethodCallNamedArgs :: forall (r :: * -> *).
InternalValueExp r =>
VSType r -> VSType r -> Label -> NamedArgs r -> SValue r
classMethodCallNamedArgs VSType r
t VSType r
c Label
f = Label
-> VSType r
-> VSType r
-> [StateT ValueState Identity (r (Value r))]
-> [(StateT ValueState Identity (r (Variable r)),
     StateT ValueState Identity (r (Value r)))]
-> StateT ValueState Identity (r (Value r))
forall (r :: * -> *).
InternalValueExp r =>
Label
-> VSType r -> VSType r -> [SValue r] -> NamedArgs r -> SValue r
classMethodCallMixedArgs' Label
f VSType r
t VSType r
c []

-- | Calling a class method with a mix of positional and named arguments.
classMethodCallMixedArgs :: (InternalValueExp r) => VSType r -> VSType r -> Label
  -> [SValue r] -> NamedArgs r -> SValue r
classMethodCallMixedArgs :: forall (r :: * -> *).
InternalValueExp r =>
VSType r
-> VSType r -> Label -> [SValue r] -> NamedArgs r -> SValue r
classMethodCallMixedArgs VSType r
t VSType r
c Label
f = Label
-> VSType r
-> VSType r
-> [StateT ValueState Identity (r (Value r))]
-> [(StateT ValueState Identity (r (Variable r)),
     StateT ValueState Identity (r (Value r)))]
-> StateT ValueState Identity (r (Value r))
forall (r :: * -> *).
InternalValueExp r =>
Label
-> VSType r -> VSType r -> [SValue r] -> NamedArgs r -> SValue r
classMethodCallMixedArgs' Label
f VSType r
t VSType r
c

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

class (DeclStatement r, OOVariableSym r) => OODeclStatement r where
  objDecDef    :: SVariable r -> r ScopeData -> SValue r -> MSStatement r
  -- 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] -> MSStatement r
  extObjDecNew :: Library -> SVariable r -> r ScopeData -> [SValue r]
    -> MSStatement r

objDecNewNoParams :: (OODeclStatement r) => SVariable r -> r ScopeData
  -> MSStatement r
objDecNewNoParams :: forall (r :: * -> *).
OODeclStatement r =>
SVariable r -> r ScopeData -> MSStatement r
objDecNewNoParams SVariable r
v r ScopeData
s = SVariable r
-> r ScopeData
-> [SValue r]
-> StateT MethodState Identity (r (Statement r))
forall (r :: * -> *).
OODeclStatement r =>
SVariable r -> r ScopeData -> [SValue r] -> MSStatement r
objDecNew SVariable r
v r ScopeData
s []

extObjDecNewNoParams :: (OODeclStatement r) => Library -> SVariable r ->
  r ScopeData -> MSStatement r
extObjDecNewNoParams :: forall (r :: * -> *).
OODeclStatement r =>
Label -> SVariable r -> r ScopeData -> MSStatement r
extObjDecNewNoParams Label
l SVariable r
v r ScopeData
s = Label
-> SVariable r
-> r ScopeData
-> [SValue r]
-> StateT MethodState Identity (r (Statement r))
forall (r :: * -> *).
OODeclStatement r =>
Label -> SVariable r -> r ScopeData -> [SValue r] -> MSStatement r
extObjDecNew Label
l SVariable r
v r ScopeData
s []

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

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

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

initObserverList :: (DeclStatement r) => VSType r -> [SValue r] -> r ScopeData
  -> MSStatement r
initObserverList :: forall (r :: * -> *).
DeclStatement r =>
VSType r -> [SValue r] -> r ScopeData -> MSStatement r
initObserverList VSType r
t [SValue r]
os r ScopeData
scp = SVariable r
-> r ScopeData
-> [SValue r]
-> StateT MethodState Identity (r (Statement r))
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r ScopeData -> [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)) r ScopeData
scp [SValue r]
os

addObserver :: (StatementSym r, OOVariableValue r, List r) => SValue r
  -> MSStatement r
addObserver :: forall (r :: * -> *).
(StatementSym r, OOVariableValue r, List r) =>
SValue r -> MSStatement r
addObserver 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 -> VSType r -> SVariable r
forall (r :: * -> *).
VariableSym r =>
Label -> VSType r -> SVariable r
listOf Label
observerListName ((r (Value r) -> r TypeData) -> SValue r -> VSType r
forall a b s. (a -> b) -> State s a -> State s b
onStateValue r (Value r) -> r TypeData
forall (r :: * -> *). ValueSym r => r (Value r) -> r TypeData
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 (FunctionSym r) => OOFunctionSym r where
  func :: Label -> VSType r -> [SValue r] -> VSFunction r
  objAccess :: SValue r -> VSFunction r -> SValue r

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

selfAccess :: (OOVariableValue r, OOFunctionSym r) => VSFunction r -> SValue r
selfAccess :: forall (r :: * -> *).
(OOVariableValue r, OOFunctionSym r) =>
VSFunction r -> SValue r
selfAccess = StateT ValueState Identity (r (Value r))
-> StateT ValueState Identity (r (Function r))
-> StateT ValueState Identity (r (Value r))
forall (r :: * -> *).
OOFunctionSym r =>
SValue r -> VSFunction r -> SValue r
objAccess (SVariable r -> StateT ValueState Identity (r (Value 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 -> VSType r
convTypeOO :: forall (r :: * -> *). OOTypeSym r => CodeType -> VSType r
convTypeOO (Object Label
n) = Label -> VSType r
forall (r :: * -> *). OOTypeSym r => Label -> VSType r
obj Label
n
convTypeOO CodeType
t = CodeType -> VSType r
forall (r :: * -> *). TypeSym r => CodeType -> VSType r
convType CodeType
t