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

import Drasil.Shared.InterfaceCommon (UnRepr(..), TypeElim(..), SVariable,
  SValue, 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
     , RenderStatement r stmt
     , ScopeElim r
     , UnRepr r TypeData
     , ValueElim r
     , VariableElim r
     )
  => SVariable r -> r ScopeData -> SValue r -> MS (r stmt)
constDecDef :: forall (r :: * -> *) stmt.
(InternalVarElim r, RenderStatement r stmt, ScopeElim r,
 UnRepr r TypeData, ValueElim r, VariableElim r) =>
SVariable r -> r ScopeData -> SValue r -> MS (r stmt)
constDecDef SVariable r
vr' r ScopeData
scp SValue r
v'= do
  vr <- LensLike'
  (Zoomed (StateT ValueState Identity) (r Variable))
  MethodState
  ValueState
-> SVariable r -> StateT MethodState Identity (r Variable)
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 Variable))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r Variable) ValueState)
-> MethodState -> Focusing Identity (r Variable) MethodState
Lens' MethodState ValueState
lensMStoVS SVariable r
vr'
  v <- zoom lensMStoVS v'
  modify $ useVarName $ variableName vr
  modify $ setVarScope (variableName vr) (scopeData scp)
  mkStmt (renderConstDecDef vr v)

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

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

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

innerType
  :: (TypeElim r, OOTypeSym r)
  => VS (r TypeData) -> VS (r TypeData)
innerType :: forall (r :: * -> *).
(TypeElim r, OOTypeSym r) =>
VS (r TypeData) -> VS (r TypeData)
innerType VS (r TypeData)
t = VS (r TypeData)
t VS (r TypeData)
-> (r TypeData -> VS (r TypeData)) -> VS (r TypeData)
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 TypeData)
forall (r :: * -> *). OOTypeSym r => CodeType -> VS (r TypeData)
convTypeOO (CodeType -> VS (r TypeData))
-> (r TypeData -> CodeType) -> r TypeData -> VS (r TypeData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeType -> CodeType
getInnerType (CodeType -> CodeType)
-> (r TypeData -> CodeType) -> r TypeData -> CodeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r TypeData -> CodeType
forall (r :: * -> *). TypeElim r => r TypeData -> CodeType
getCodeType)