-- | Contains common implementations specific to GOOL
module Drasil.GOOL.LanguageRenderer.CommonGOOL (
  constDecDef, classMethodCall, listAppend, listAdd, innerType
) where

import Drasil.Shared.InterfaceCommon (UnRepr(..), TypeElim(..), NamedArgs,
  VariableElim(..), TypeSym(void), IndexTranslator(..), getCodeType,
  ValueStatement(valStmt))
import Drasil.GOOL.InterfaceGOOL (objMethodCall, convTypeOO, InternalValueExp,
  OOTypeSym)
import Drasil.Shared.RendererClassesCommon (ScopeElim(..), RenderValue(..),
  InternalVarElim, RenderStatement, ValueElim)
import Drasil.Shared.LanguageRenderer.Constructors (mkStmt)
import Drasil.Shared.LanguageRenderer (dot)
import Drasil.GOOL.Renderers (renderType, renderConstDecDef)
import Drasil.Shared.AST (TypeData, ScopeData)
import Drasil.Shared.State (MS, VS, lensMStoVS, useVarName, setVarScope)
import Drasil.Shared.Helpers (getInnerType)

import Control.Lens.Zoom (zoom)
import Control.Monad.State (modify)

constDecDef
  :: ( InternalVarElim r var
     , RenderStatement r stmt
     , ScopeElim r ScopeData
     , UnRepr r TypeData
     , ValueElim r val
     , VariableElim r var TypeData
     )
  => VS (r var) -> r ScopeData -> VS (r val) -> MS (r stmt)
constDecDef :: forall (r :: * -> *) var stmt val.
(InternalVarElim r var, RenderStatement r stmt,
 ScopeElim r ScopeData, UnRepr r TypeData, ValueElim r val,
 VariableElim r var TypeData) =>
VS (r var) -> r ScopeData -> VS (r val) -> MS (r stmt)
constDecDef VS (r var)
vr' r ScopeData
scp VS (r val)
v'= do
  vr <- LensLike'
  (Zoomed (StateT ValueState Identity) (r var))
  MethodState
  ValueState
-> VS (r var) -> StateT MethodState Identity (r var)
forall c.
LensLike'
  (Zoomed (StateT ValueState Identity) c) MethodState ValueState
-> StateT ValueState Identity c -> StateT MethodState Identity c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom LensLike'
  (Zoomed (StateT ValueState Identity) (r var))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r var) ValueState)
-> MethodState -> Focusing Identity (r var) MethodState
Lens' MethodState ValueState
lensMStoVS VS (r var)
vr'
  v <- zoom lensMStoVS v'
  modify $ useVarName $ variableName vr
  modify $ setVarScope (variableName vr) (scopeData scp)
  mkStmt (renderConstDecDef vr v)

classMethodCall
  :: (RenderValue r var val TypeData, UnRepr r TypeData)
  => String
  -> VS (r TypeData)
  -> VS (r TypeData)
  -> [VS (r val)]
  -> NamedArgs r var val
  -> VS (r val)
classMethodCall :: forall (r :: * -> *) var val.
(RenderValue r var val TypeData, UnRepr r TypeData) =>
String
-> VS (r TypeData)
-> VS (r TypeData)
-> [VS (r val)]
-> NamedArgs r var val
-> VS (r val)
classMethodCall String
f VS (r TypeData)
t VS (r TypeData)
cls [VS (r val)]
vs NamedArgs r var val
ns = do
  c <- VS (r TypeData)
cls
  call Nothing (Just $ renderType c <> dot) f t vs ns

listAppend
  :: (TypeSym r typ, InternalValueExp r var val typ, ValueStatement r stmt val)
  => String -> VS (r val) -> VS (r val) -> MS (r stmt)
listAppend :: forall {k} (r :: k -> *) (typ :: k) (var :: k) (val :: k)
       (stmt :: k).
(TypeSym r typ, InternalValueExp r var val typ,
 ValueStatement r stmt val) =>
String -> VS (r val) -> VS (r val) -> MS (r stmt)
listAppend String
fnName VS (r val)
list VS (r val)
val = VS (r val) -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k) (val :: k).
ValueStatement r stmt val =>
VS (r val) -> MS (r stmt)
valStmt (VS (r val) -> MS (r stmt)) -> VS (r val) -> MS (r stmt)
forall a b. (a -> b) -> a -> b
$ VS (r typ) -> VS (r val) -> String -> [VS (r val)] -> VS (r val)
forall {k} (r :: k -> *) (var :: k) (val :: k) (typ :: k).
InternalValueExp r var val typ =>
VS (r typ) -> VS (r val) -> String -> [VS (r val)] -> VS (r val)
objMethodCall VS (r typ)
forall {k} (r :: k -> *) (typ :: k). TypeSym r typ => VS (r typ)
void VS (r val)
list String
fnName [VS (r val)
val]

listAdd
  ::
    ( TypeSym r typ
    , IndexTranslator r val
    , InternalValueExp r var val typ
    , ValueStatement r stmt val
    )
  => String -> VS (r val) -> VS (r val) -> VS (r val) -> MS (r stmt)
listAdd :: forall {k} (r :: k -> *) (typ :: k) (val :: k) (var :: k)
       (stmt :: k).
(TypeSym r typ, IndexTranslator r val,
 InternalValueExp r var val typ, ValueStatement r stmt val) =>
String -> VS (r val) -> VS (r val) -> VS (r val) -> MS (r stmt)
listAdd String
fnName VS (r val)
list VS (r val)
idx VS (r val)
val = VS (r val) -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k) (val :: k).
ValueStatement r stmt val =>
VS (r val) -> MS (r stmt)
valStmt (VS (r val) -> MS (r stmt)) -> VS (r val) -> MS (r stmt)
forall a b. (a -> b) -> a -> b
$ VS (r typ) -> VS (r val) -> String -> [VS (r val)] -> VS (r val)
forall {k} (r :: k -> *) (var :: k) (val :: k) (typ :: k).
InternalValueExp r var val typ =>
VS (r typ) -> VS (r val) -> String -> [VS (r val)] -> VS (r val)
objMethodCall VS (r typ)
forall {k} (r :: k -> *) (typ :: k). TypeSym r typ => VS (r typ)
void VS (r val)
list String
fnName [VS (r val) -> VS (r val)
forall {k} (r :: k -> *) (val :: k).
IndexTranslator r val =>
VS (r val) -> VS (r val)
intToIndex VS (r val)
idx, VS (r val)
val]

innerType
  :: (TypeElim r typ, TypeSym r typ, OOTypeSym r typ)
  => VS (r typ) -> VS (r typ)
innerType :: forall {k} (r :: k -> *) (typ :: k).
(TypeElim r typ, TypeSym r typ, OOTypeSym r typ) =>
VS (r typ) -> VS (r typ)
innerType VS (r typ)
t = VS (r typ)
t VS (r typ) -> (r typ -> VS (r typ)) -> VS (r typ)
forall a b.
StateT ValueState Identity a
-> (a -> StateT ValueState Identity b)
-> StateT ValueState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CodeType -> VS (r typ)
forall {k} (r :: k -> *) (typ :: k).
(TypeSym r typ, OOTypeSym r typ) =>
CodeType -> VS (r typ)
convTypeOO (CodeType -> VS (r typ))
-> (r typ -> CodeType) -> r typ -> VS (r typ)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeType -> CodeType
getInnerType (CodeType -> CodeType) -> (r typ -> CodeType) -> r typ -> CodeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r typ -> CodeType
forall {k} (r :: k -> *) (typ :: k).
TypeElim r typ =>
r typ -> CodeType
getCodeType)