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

module Drasil.GOOL.InterfaceGOOL (
  -- Types
  Program, GSProgram, Class, StateVar, CSStateVar, Initializers,
  -- Typeclasses
  OOProg, ProgramSym(..), FileSym(..), ModuleSym(..), ClassSym(..),
  OOTypeSym(..), OOVariableSym(..), ($->), SelfSym(..), instanceVarSelf,
  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, SVariable, SValue, NamedArgs, MixedCtorCall, PosCall,
  PosCtorCall, InOutCall, InOutFunc, DocInOutFunc,
  -- Typeclasses
  BodySym(body), BlockSym, TypeSym(..), FunctionSym, MethodSym(..), VariableSym(var),
  ValueSym(valueType), VariableValue(valueOf), ValueExpression, IndexTranslator,
  Array, List(listSize), ListStatement(listAdd), listOf, EmptyStatement,
  MultiStatement, ValueStatement, AssignStatement, DeclStatement(listDecDef),
  FuncAppStatement, VisibilitySym(..), Argument, BooleanExpression,
  CommandLineArgs, CommentStatement, Comparison, ControlStatement, PrintConsole,
  ReadConsole, FileHandling, PrintFile, ReadFile, Literal, MathConstant,
  NumericExpression, ParameterSym, Reference, Set, StringStatement, convType,
  UnRepr, ScopeSym, BinderSym, InternalList, TypeElim, VariableElim)

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, FuncData, ProgData)

import Text.PrettyPrint.HughesPJ (Doc)

-- | Wrapper typeclass that bundles everything essential
-- for generating an object-oriented program.
class (UnRepr r TypeData, Argument r, BodySym r bod block, BlockSym r block stmt,
  CommandLineArgs r, Literal r, MathConstant r, VariableValue r, VariableSym r,
  TypeSym r, OOTypeSym r, OOVariableSym r, SelfSym r, BooleanExpression r,
  Comparison r, NumericExpression r, ValueSym r, InternalValueExp r,
  ValueExpression r, OOValueExpression r, IndexTranslator r, Array r, List r,
  ListStatement r stmt, Reference r, Set r, FunctionSym r, OOFunctionSym r,
  ParameterSym r, ScopeSym r, BinderSym r, InternalList r block,
  MethodSym r vis mthd bod, OOMethodSym r vis mthd attch bod,
  AttachmentSym r attch, VisibilitySym r vis, StateVarSym r vis stvr attch,
  ClassSym r mthd stvr, TypeElim r, VariableElim r, EmptyStatement r stmt,
  MultiStatement r stmt, ValueStatement r stmt, CommentStatement r stmt,
  DeclStatement r stmt bod, OODeclStatement r stmt, AssignStatement r stmt,
  FuncAppStatement r stmt, OOFuncAppStatement r stmt,
  ControlStatement r stmt bod, StringStatement r stmt, PrintConsole r stmt,
  ReadConsole r stmt, FileHandling r stmt, PrintFile r stmt, ReadFile r stmt,
  ModuleSym r mod mthd, FileSym r file mod, ProgramSym r prg file
  ) => OOProg r vis stmt mthd stvr attch prg file mod bod block

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

-- | Class for representing a program.
-- Usually 'ProgData' is used for the representation.
class ProgramSym r prg file | r -> prg file where
  -- | Given program name, program purpose, and list of files,
  -- Generates a representation of a program.
  prog :: Label -> Label -> [FS (r file)] -> GSProgram r prg

-- | Class for representing a file.
class FileSym r file mod | r -> file mod where
  -- | Given a module, generates a representation of a file.
  -- (Implicit assumption: exactly one module per file)
  fileDoc :: FS (r mod) -> FS (r file)

  -- | Given module description, watermark, list of author names,
  -- date as a String, and file to comment, creates a __documented module__
  -- (i.e. module with a header comment)
  docMod :: String -> String -> [String] -> String -> FS (r file) -> FS (r file)

-- | Class for representing a module.
class ModuleSym r mod mthd | r -> mod mthd where
  -- | Given module name, list of import names, list of module functions,
  -- and list of module classes, generates a representation of a module.
  buildModule :: Label -> [Label] -> [MS (r mthd)] -> [CS (r Class)] -> FS (r mod)

type Class = Doc

-- | Class for representing an OO class.
class ClassSym r mthd stvr | r -> mthd stvr where
  -- | Main external method for creating a class.
  -- Inputs: parent class, variables, constructor(s), methods
  buildClass :: Maybe Label -> [CSStateVar r stvr] -> [MS (r mthd)] ->
    [MS (r mthd)] -> CS (r Class)
  -- | Creates an extra class, i.e. with a different name than the module name.
  -- Inputs: class name, the rest are the same as buildClass.
  extraClass :: Label -> Maybe Label -> [CSStateVar r stvr] -> [MS (r mthd)] ->
    [MS (r mthd)] -> CS (r Class)
  -- | Creates a class implementing a list of interfaces.
  -- Inputs: class name, interface names, variables, constructor(s), methods
  implementingClass :: Label -> [Label] -> [CSStateVar r stvr] -> [MS (r mthd)] ->
    [MS (r mthd)] -> CS (r Class)

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

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

class OOMethodSym r vis mthd attch bod | r -> vis mthd attch bod where
  method      :: Label -> r vis -> r attch -> VS (r TypeData) ->
    [MS (r ParamData)] -> MS (r bod) -> MS (r mthd)
  getMethod   :: SVariable r -> MS (r mthd)
  setMethod   :: SVariable r -> MS (r mthd)
  constructor :: [MS (r ParamData)] -> Initializers r -> MS (r bod) -> MS (r mthd)

  -- inOutMethod and docInOutMethod both need AttachmentSym
  inOutMethod :: Label -> r vis -> r attch -> InOutFunc r mthd bod
  docInOutMethod :: Label -> r vis -> r attch -> DocInOutFunc r mthd bod

privMethod
  ::
    ( OOMethodSym r vis mthd attch bod
    , AttachmentSym r attch
    , VisibilitySym r vis
    )
  => Label -> VS (r TypeData) -> [MS (r ParamData)] -> MS (r bod) -> MS (r mthd)
privMethod :: forall (r :: * -> *) vis mthd attch bod.
(OOMethodSym r vis mthd attch bod, AttachmentSym r attch,
 VisibilitySym r vis) =>
Label
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r bod)
-> MS (r mthd)
privMethod Label
n = Label
-> r vis
-> r attch
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r bod)
-> MS (r mthd)
forall (r :: * -> *) vis mthd attch bod.
OOMethodSym r vis mthd attch bod =>
Label
-> r vis
-> r attch
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r bod)
-> MS (r mthd)
method Label
n r vis
forall {k} (r :: k -> *) (vis :: k). VisibilitySym r vis => r vis
private r attch
forall {k} (r :: k -> *) (attch :: k).
AttachmentSym r attch =>
r attch
instanceLevel

pubMethod
  ::
    ( OOMethodSym r vis mthd attch bod
    , AttachmentSym r attch
    , VisibilitySym r vis
    )
  => Label -> VS (r TypeData) -> [MS (r ParamData)] -> MS (r bod) -> MS (r mthd)
pubMethod :: forall (r :: * -> *) vis mthd attch bod.
(OOMethodSym r vis mthd attch bod, AttachmentSym r attch,
 VisibilitySym r vis) =>
Label
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r bod)
-> MS (r mthd)
pubMethod Label
n = Label
-> r vis
-> r attch
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r bod)
-> MS (r mthd)
forall (r :: * -> *) vis mthd attch bod.
OOMethodSym r vis mthd attch bod =>
Label
-> r vis
-> r attch
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r bod)
-> MS (r mthd)
method Label
n r vis
forall {k} (r :: k -> *) (vis :: k). VisibilitySym r vis => r vis
public r attch
forall {k} (r :: k -> *) (attch :: k).
AttachmentSym r attch =>
r attch
instanceLevel

initializer
  :: (OOMethodSym r vis mthd attch bod, BodySym r bod block)
  => [MS (r ParamData)] -> Initializers r -> MS (r mthd)
initializer :: forall (r :: * -> *) vis mthd attch bod block.
(OOMethodSym r vis mthd attch bod, BodySym r bod block) =>
[MS (r ParamData)] -> Initializers r -> MS (r mthd)
initializer [MS (r ParamData)]
ps Initializers r
is = [MS (r ParamData)] -> Initializers r -> MS (r bod) -> MS (r mthd)
forall (r :: * -> *) vis mthd attch bod.
OOMethodSym r vis mthd attch bod =>
[MS (r ParamData)] -> Initializers r -> MS (r bod) -> MS (r mthd)
constructor [MS (r ParamData)]
ps Initializers r
is ([MS (r block)] -> MS (r bod)
forall {k} (r :: k -> *) (bod :: k) (block :: k).
BodySym r bod block =>
[MS (r block)] -> MS (r bod)
body [])

nonInitConstructor
  :: (OOMethodSym r vis mthd attch bod)
  => [MS (r ParamData)] -> MS (r bod) -> MS (r mthd)
nonInitConstructor :: forall (r :: * -> *) vis mthd attch bod.
OOMethodSym r vis mthd attch bod =>
[MS (r ParamData)] -> MS (r bod) -> MS (r mthd)
nonInitConstructor [MS (r ParamData)]
ps = [MS (r ParamData)] -> Initializers r -> MS (r bod) -> MS (r mthd)
forall (r :: * -> *) vis mthd attch bod.
OOMethodSym r vis mthd attch bod =>
[MS (r ParamData)] -> Initializers r -> MS (r bod) -> MS (r mthd)
constructor [MS (r ParamData)]
ps []

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

-- | Class for representing class variables, both instance- and class-level.
-- Used when creating a class, to hold extra information about `Attachment`
-- and `Visibility`.
-- Usually 'Doc' is used for the representation.
class StateVarSym r vis stvr attch | r -> vis stvr attch where
  -- | Given a visibility, attachment, and variable, represent the declaration
  -- of a state variable with no initial value.
  stateVar :: r vis -> r attch -> SVariable r -> CSStateVar r stvr
  -- | Given a visibility, attachment, variable, and initial value,
  -- represent the declaration of a state variable with the given initial value.
  stateVarDef :: r vis -> r attch -> SVariable r -> SValue r -> CSStateVar r stvr
  -- | Given a visibility, variable, and value, represent the declaration of
  -- a state constant with the given value.
  constVar :: r vis ->  SVariable r -> SValue r -> CSStateVar r stvr

privDVar
  :: (AttachmentSym r attch, VisibilitySym r vis, StateVarSym r vis stvr attch)
  => SVariable r -> CSStateVar r stvr
privDVar :: forall (r :: * -> *) attch vis stvr.
(AttachmentSym r attch, VisibilitySym r vis,
 StateVarSym r vis stvr attch) =>
SVariable r -> CSStateVar r stvr
privDVar = r vis -> r attch -> SVariable r -> CSStateVar r stvr
forall (r :: * -> *) vis stvr attch.
StateVarSym r vis stvr attch =>
r vis -> r attch -> SVariable r -> CSStateVar r stvr
stateVar r vis
forall {k} (r :: k -> *) (vis :: k). VisibilitySym r vis => r vis
private r attch
forall {k} (r :: k -> *) (attch :: k).
AttachmentSym r attch =>
r attch
instanceLevel

pubDVar
  :: (AttachmentSym r attch, VisibilitySym r vis, StateVarSym r vis stvr attch)
  => SVariable r -> CSStateVar r stvr
pubDVar :: forall (r :: * -> *) attch vis stvr.
(AttachmentSym r attch, VisibilitySym r vis,
 StateVarSym r vis stvr attch) =>
SVariable r -> CSStateVar r stvr
pubDVar = r vis -> r attch -> SVariable r -> CSStateVar r stvr
forall (r :: * -> *) vis stvr attch.
StateVarSym r vis stvr attch =>
r vis -> r attch -> SVariable r -> CSStateVar r stvr
stateVar r vis
forall {k} (r :: k -> *) (vis :: k). VisibilitySym r vis => r vis
public r attch
forall {k} (r :: k -> *) (attch :: k).
AttachmentSym r attch =>
r attch
instanceLevel

pubSVar
  :: (AttachmentSym r attch, VisibilitySym r vis, StateVarSym r vis stvr attch)
  => SVariable r -> CSStateVar r stvr
pubSVar :: forall (r :: * -> *) attch vis stvr.
(AttachmentSym r attch, VisibilitySym r vis,
 StateVarSym r vis stvr attch) =>
SVariable r -> CSStateVar r stvr
pubSVar = r vis -> r attch -> SVariable r -> CSStateVar r stvr
forall (r :: * -> *) vis stvr attch.
StateVarSym r vis stvr attch =>
r vis -> r attch -> SVariable r -> CSStateVar r stvr
stateVar r vis
forall {k} (r :: k -> *) (vis :: k). VisibilitySym r vis => r vis
public r attch
forall {k} (r :: k -> *) (attch :: k).
AttachmentSym r attch =>
r attch
classLevel

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

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

class 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 SelfSym r where
  -- | `self` keyword
  self              :: SVariable r

-- | Given a variable `v`, creates `self.v`
instanceVarSelf
  :: (OOVariableSym r, SelfSym r, VariableValue r) => SVariable r -> SVariable r
instanceVarSelf :: forall (r :: * -> *).
(OOVariableSym 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)

-- for values that can include expressions
class 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 []

-- TODO [Brandon Bosman, 07/22/2026]: Give this a better name
-- | A class for representing method calls, both instance- and class-level
class InternalValueExp r where
  -- TODO [Brandon Bosman, 07/22/2026]: rename this to `instanceMethodCallMixedArgs'`
  -- | 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 OODeclStatement r stmt | r -> stmt where
  objDecDef    :: SVariable r -> r ScopeData -> SValue r -> MS (r stmt)
  -- 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 stmt)
  extObjDecNew :: Library -> SVariable r -> r ScopeData -> [SValue r]
    -> MS (r stmt)

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

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

class OOFuncAppStatement r stmt | r -> stmt where
  selfInOutCall :: InOutCall r stmt

class ObserverPattern r stmt | r -> stmt where
  notifyObservers :: VS (r FuncData) -> VS (r TypeData) -> MS (r stmt)

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

initObserverList
  :: (VariableSym r, DeclStatement r stmt bod)
  => VS (r TypeData) -> [SValue r] -> r ScopeData -> MS (r stmt)
initObserverList :: forall (r :: * -> *) stmt bod.
(VariableSym r, DeclStatement r stmt bod) =>
VS (r TypeData) -> [SValue r] -> r ScopeData -> MS (r stmt)
initObserverList VS (r TypeData)
t [SValue r]
os r ScopeData
scp = SVariable r -> r ScopeData -> [SValue r] -> MS (r stmt)
forall (r :: * -> *) stmt bod.
DeclStatement r stmt bod =>
SVariable r -> r ScopeData -> [SValue r] -> MS (r stmt)
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
  :: (VariableSym r, VariableValue r, ValueSym r, List r, ListStatement r stmt)
  => SValue r -> MS (r stmt)
addObserver :: forall (r :: * -> *) stmt.
(VariableSym r, VariableValue r, ValueSym r, List r,
 ListStatement r stmt) =>
SValue r -> MS (r stmt)
addObserver SValue r
o = SValue r -> SValue r -> SValue r -> MS (r stmt)
forall (r :: * -> *) stmt.
ListStatement r stmt =>
SValue r -> SValue r -> SValue r -> MS (r stmt)
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 :: * -> *). List r => SValue r -> SValue r
listSize SValue r
obsList

class StrategyPattern r bod block | r -> bod block where
  runStrategy :: Label -> [(Label, MS (r bod))] -> Maybe (SValue r) ->
    Maybe (SVariable r) -> MS (r block)

class 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
  :: (VariableValue r, SelfSym r, OOFunctionSym r) => VS (r FuncData) -> SValue r
selfAccess :: forall (r :: * -> *).
(VariableValue r, SelfSym 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 GetSet r where
  get :: SValue r -> SVariable r -> SValue r
  set :: SValue r -> SVariable r -> SValue r -> SValue r

convTypeOO :: (TypeSym r, OOTypeSym r) => CodeType -> VS (r TypeData)
convTypeOO :: forall (r :: * -> *).
(TypeSym 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 :: * -> *).
(TypeSym 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