{-# LANGUAGE PostfixOperators #-}

-- | Language-polymorphic functions that are defined by GOOL code
module GOOL.Drasil.LanguageRenderer.Macros (
  ifExists, decrement1, increment, increment1, runStrategy, 
  listSlice, stringListVals, stringListLists, forRange, notifyObservers,
  notifyObservers', checkState
) where

import GOOL.Drasil.CodeType (CodeType(..))
import GOOL.Drasil.ClassInterface (Label, MSBody, MSBlock, VSType, SVariable, 
  SValue, VSFunction, MSStatement, bodyStatements, oneLiner, TypeElim(getType),
  VariableElim(variableType), listOf, ValueSym(valueType), 
  NumericExpression((#+), (#*), (#/)), Comparison(..), at, ($.),
  StatementSym(multi), AssignStatement((&+=), (&-=), (&++)), (&=), 
  observerListName)
import qualified GOOL.Drasil.ClassInterface as S (BlockSym(block), 
  TypeSym(int, string, listInnerType), VariableSym(var), Literal(litInt), 
  VariableValue(valueOf), ValueExpression(notNull), 
  List(listSize, listAppend, listAccess), StatementSym(valStmt), 
  AssignStatement(assign), DeclStatement(varDecDef, listDec), 
  ControlStatement(ifCond, switch, for, forRange))
import GOOL.Drasil.RendererClasses (RenderSym, RenderValue(cast))
import qualified GOOL.Drasil.RendererClasses as S (
  RenderStatement(stmt, emptyStmt))
import qualified GOOL.Drasil.RendererClasses as RC (BodyElim(..),
  StatementElim(statement))
import GOOL.Drasil.Helpers (toCode, onStateValue, on2StateValues)
import GOOL.Drasil.State (MS, lensMStoVS, genVarName, genLoopIndex)

import Data.Maybe (fromMaybe)
import Control.Lens.Zoom (zoom)
import Text.PrettyPrint.HughesPJ (Doc, vcat)

ifExists :: (RenderSym r) => SValue r -> MSBody r -> MSBody r -> MSStatement r
ifExists :: forall (r :: * -> *).
RenderSym r =>
SValue r -> MSBody r -> MSBody r -> MSStatement r
ifExists SValue r
v MSBody r
ifBody = forall (r :: * -> *).
ControlStatement r =>
[(SValue r, MSBody r)] -> MSBody r -> MSStatement r
S.ifCond [(forall (r :: * -> *). ValueExpression r => SValue r -> SValue r
S.notNull SValue r
v, MSBody r
ifBody)]

decrement1 :: (RenderSym r) => SVariable r -> MSStatement r
decrement1 :: forall (r :: * -> *). RenderSym r => SVariable r -> MSStatement r
decrement1 SVariable r
v = SVariable r
v forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&-= forall (r :: * -> *). Literal r => Integer -> SValue r
S.litInt Integer
1

increment :: (RenderSym r) => SVariable r -> SValue r -> MSStatement r
increment :: forall (r :: * -> *).
RenderSym r =>
SVariable r -> SValue r -> MSStatement r
increment SVariable r
vr SValue r
vl = SVariable r
vr forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
S.valueOf SVariable r
vr forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
#+ SValue r
vl

increment1 :: (RenderSym r) => SVariable r -> MSStatement r
increment1 :: forall (r :: * -> *). RenderSym r => SVariable r -> MSStatement r
increment1 SVariable r
vr = SVariable r
vr forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&+= forall (r :: * -> *). Literal r => Integer -> SValue r
S.litInt Integer
1

strat :: (RenderSym r, Monad r) => MSStatement r -> MSBody r -> MS (r Doc)
strat :: forall (r :: * -> *).
(RenderSym r, Monad r) =>
MSStatement r -> MSBody r -> MS (r Doc)
strat = forall a b c s.
(a -> b -> c) -> State s a -> State s b -> State s c
on2StateValues (\r (Statement r)
result r (Body r)
b -> forall (r :: * -> *) a. Monad r => a -> r a
toCode forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat [forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body r (Body r)
b, 
  forall (r :: * -> *). StatementElim r => r (Statement r) -> Doc
RC.statement r (Statement r)
result])

runStrategy :: (RenderSym r, Monad r) => Label -> [(Label, MSBody r)] -> 
  Maybe (SValue r) -> Maybe (SVariable r) -> MS (r Doc)
runStrategy :: forall (r :: * -> *).
(RenderSym r, Monad r) =>
Label
-> [(Label, MSBody r)]
-> Maybe (SValue r)
-> Maybe (SVariable r)
-> MS (r Doc)
runStrategy Label
l [(Label, MSBody r)]
strats Maybe (SValue r)
rv Maybe (SVariable r)
av = forall b a. b -> (a -> b) -> Maybe a -> b
maybe
  (forall {a}. Label -> Label -> a
strError Label
l Label
"RunStrategy called on non-existent strategy") 
  (forall (r :: * -> *).
(RenderSym r, Monad r) =>
MSStatement r -> MSBody r -> MS (r Doc)
strat (forall (r :: * -> *).
RenderStatement r =>
MSStatement r -> MSStatement r
S.stmt MS (r (Statement r))
resultState)) (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Label
l [(Label, MSBody r)]
strats)
  where resultState :: MS (r (Statement r))
resultState = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (r :: * -> *). RenderStatement r => MSStatement r
S.emptyStmt SVariable r -> MS (r (Statement r))
asgState Maybe (SVariable r)
av
        asgState :: SVariable r -> MS (r (Statement r))
asgState SVariable r
v = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall {a}. Label -> Label -> a
strError Label
l 
          Label
"Attempt to assign null return to a Value") (SVariable r
v &=) Maybe (SValue r)
rv
        strError :: Label -> Label -> a
strError Label
n Label
s = forall a. HasCallStack => Label -> a
error forall a b. (a -> b) -> a -> b
$ Label
"Strategy '" forall a. [a] -> [a] -> [a]
++ Label
n forall a. [a] -> [a] -> [a]
++ Label
"': " forall a. [a] -> [a] -> [a]
++ Label
s forall a. [a] -> [a] -> [a]
++ Label
"."

listSlice :: (RenderSym r) => Maybe (SValue r) -> Maybe (SValue r) -> 
  Maybe (SValue r) -> SVariable r -> SValue r -> MSBlock r
listSlice :: forall (r :: * -> *).
RenderSym r =>
Maybe (SValue r)
-> Maybe (SValue r)
-> Maybe (SValue r)
-> SVariable r
-> SValue r
-> MSBlock r
listSlice Maybe (SValue r)
b Maybe (SValue r)
e Maybe (SValue r)
s SVariable r
vnew SValue r
vold = do
  Label
l_temp <- [Label] -> Label -> MS Label
genVarName [] Label
"temp"
  Label
l_i <- MS Label
genLoopIndex
  let
    var_temp :: SVariable r
var_temp = forall (r :: * -> *).
VariableSym r =>
Label -> VSType r -> SVariable r
S.var Label
l_temp (forall a b s. (a -> b) -> State s a -> State s b
onStateValue forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType SVariable r
vnew)
    v_temp :: SValue r
v_temp = forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
S.valueOf SVariable r
var_temp
    var_i :: SVariable r
var_i = forall (r :: * -> *).
VariableSym r =>
Label -> VSType r -> SVariable r
S.var Label
l_i forall (r :: * -> *). TypeSym r => VSType r
S.int
    v_i :: SValue r
v_i = forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
S.valueOf SVariable r
var_i
  forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
S.block [
    forall (r :: * -> *).
DeclStatement r =>
Integer -> SVariable r -> MSStatement r
S.listDec Integer
0 SVariable r
var_temp,
    forall (r :: * -> *).
ControlStatement r =>
MSStatement r
-> SValue r -> MSStatement r -> MSBody r -> MSStatement r
S.for (forall (r :: * -> *).
DeclStatement r =>
SVariable r -> SValue r -> MSStatement r
S.varDecDef SVariable r
var_i (forall a. a -> Maybe a -> a
fromMaybe (forall (r :: * -> *). Literal r => Integer -> SValue r
S.litInt Integer
0) Maybe (SValue r)
b))
      (SValue r
v_i forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
?< forall a. a -> Maybe a -> a
fromMaybe (forall (r :: * -> *). List r => SValue r -> SValue r
S.listSize SValue r
vold) Maybe (SValue r)
e) (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (SVariable r
var_i &++) (SVariable r
var_i &+=) Maybe (SValue r)
s)
      (forall (r :: * -> *). BodySym r => MSStatement r -> MSBody r
oneLiner forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *). StatementSym r => SValue r -> MSStatement r
S.valStmt forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *). List r => SValue r -> SValue r -> SValue r
S.listAppend SValue r
v_temp (forall (r :: * -> *). List r => SValue r -> SValue r -> SValue r
S.listAccess SValue r
vold SValue r
v_i)),
    SVariable r
vnew forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= SValue r
v_temp]
      
stringListVals :: (RenderSym r) => [SVariable r] -> SValue r -> MSStatement r
stringListVals :: forall (r :: * -> *).
RenderSym r =>
[SVariable r] -> SValue r -> MSStatement r
stringListVals [SVariable r]
vars SValue r
sl = forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom Lens' MethodState ValueState
lensMStoVS SValue r
sl forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\r (Value r)
slst -> forall (r :: * -> *).
StatementSym r =>
[MSStatement r] -> MSStatement r
multi forall a b. (a -> b) -> a -> b
$ CodeType -> [StateT MethodState Identity (r (Statement r))]
checkList 
  (forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType r (Value r)
slst))
  where checkList :: CodeType -> [StateT MethodState Identity (r (Statement r))]
checkList (List CodeType
String) = [SVariable r]
-> Integer -> [StateT MethodState Identity (r (Statement r))]
assignVals [SVariable r]
vars Integer
0
        checkList CodeType
_ = forall a. HasCallStack => Label -> a
error 
          Label
"Value passed to stringListVals must be a list of strings"
        assignVals :: [SVariable r]
-> Integer -> [StateT MethodState Identity (r (Statement r))]
assignVals [] Integer
_ = []
        assignVals (SVariable r
v:[SVariable r]
vs) Integer
n = forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
S.assign SVariable r
v (forall (r :: * -> *).
RenderValue r =>
VSType r -> SValue r -> SValue r
cast (forall a b s. (a -> b) -> State s a -> State s b
onStateValue forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType SVariable r
v) 
          (forall (r :: * -> *). List r => SValue r -> SValue r -> SValue r
S.listAccess SValue r
sl (forall (r :: * -> *). Literal r => Integer -> SValue r
S.litInt Integer
n))) forall a. a -> [a] -> [a]
: [SVariable r]
-> Integer -> [StateT MethodState Identity (r (Statement r))]
assignVals [SVariable r]
vs (Integer
nforall a. Num a => a -> a -> a
+Integer
1)

stringListLists :: (RenderSym r) => [SVariable r] -> SValue r -> MSStatement r
stringListLists :: forall (r :: * -> *).
RenderSym r =>
[SVariable r] -> SValue r -> MSStatement r
stringListLists [SVariable r]
lsts SValue r
sl = do
  r (Value r)
slst <- forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom Lens' MethodState ValueState
lensMStoVS SValue r
sl
  Label
l_i <- MS Label
genLoopIndex
  let
    checkList :: CodeType -> MSStatement r
checkList (List CodeType
String) = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom Lens' MethodState ValueState
lensMStoVS) [SVariable r]
lsts forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [CodeType] -> MSStatement r
listVals forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      forall a b. (a -> b) -> [a] -> [b]
map (forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType)
    checkList CodeType
_ = forall a. HasCallStack => Label -> a
error
      Label
"Value passed to stringListLists must be a list of strings"
    listVals :: [CodeType] -> MSStatement r
listVals [] = MSStatement r
loop
    listVals (List CodeType
_:[CodeType]
vs) = [CodeType] -> MSStatement r
listVals [CodeType]
vs
    listVals [CodeType]
_ = forall a. HasCallStack => Label -> a
error
      Label
"All values passed to stringListLists must have list types"
    loop :: MSStatement r
loop = forall (r :: * -> *).
ControlStatement r =>
SVariable r
-> SValue r -> SValue r -> SValue r -> MSBody r -> MSStatement r
S.forRange SVariable r
var_i (forall (r :: * -> *). Literal r => Integer -> SValue r
S.litInt Integer
0) (forall (r :: * -> *). List r => SValue r -> SValue r
S.listSize SValue r
sl forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
#/ SValue r
numLists)
      (forall (r :: * -> *). Literal r => Integer -> SValue r
S.litInt Integer
1) (forall (r :: * -> *). BodySym r => [MSStatement r] -> MSBody r
bodyStatements forall a b. (a -> b) -> a -> b
$ [SValue r] -> Integer -> [MSStatement r]
appendLists (forall a b. (a -> b) -> [a] -> [b]
map forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
S.valueOf [SVariable r]
lsts) Integer
0)
    appendLists :: [SValue r] -> Integer -> [MSStatement r]
appendLists [] Integer
_ = []
    appendLists (SValue r
v:[SValue r]
vs) Integer
n = forall (r :: * -> *). StatementSym r => SValue r -> MSStatement r
S.valStmt (forall (r :: * -> *). List r => SValue r -> SValue r -> SValue r
S.listAppend SValue r
v (forall (r :: * -> *).
RenderValue r =>
VSType r -> SValue r -> SValue r
cast
      (forall (r :: * -> *). TypeSym r => VSType r -> VSType r
S.listInnerType forall a b. (a -> b) -> a -> b
$ forall a b s. (a -> b) -> State s a -> State s b
onStateValue forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType SValue r
v)
      (forall (r :: * -> *). List r => SValue r -> SValue r -> SValue r
S.listAccess SValue r
sl ((SValue r
v_i forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
#* SValue r
numLists) forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
#+ forall (r :: * -> *). Literal r => Integer -> SValue r
S.litInt Integer
n))))
      forall a. a -> [a] -> [a]
: [SValue r] -> Integer -> [MSStatement r]
appendLists [SValue r]
vs (Integer
nforall a. Num a => a -> a -> a
+Integer
1)
    numLists :: SValue r
numLists = forall (r :: * -> *). Literal r => Integer -> SValue r
S.litInt (forall a. Integral a => a -> Integer
toInteger forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [SVariable r]
lsts)
    var_i :: SVariable r
var_i = forall (r :: * -> *).
VariableSym r =>
Label -> VSType r -> SVariable r
S.var Label
l_i forall (r :: * -> *). TypeSym r => VSType r
S.int
    v_i :: SValue r
v_i = forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
S.valueOf SVariable r
var_i
  CodeType -> MSStatement r
checkList (forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType r (Value r)
slst)

forRange :: (RenderSym r) => SVariable r -> SValue r -> SValue r -> SValue r -> 
  MSBody r -> MSStatement r
forRange :: forall (r :: * -> *).
RenderSym r =>
SVariable r
-> SValue r -> SValue r -> SValue r -> MSBody r -> MSStatement r
forRange SVariable r
i SValue r
initv SValue r
finalv SValue r
stepv = forall (r :: * -> *).
ControlStatement r =>
MSStatement r
-> SValue r -> MSStatement r -> MSBody r -> MSStatement r
S.for (forall (r :: * -> *).
DeclStatement r =>
SVariable r -> SValue r -> MSStatement r
S.varDecDef SVariable r
i SValue r
initv) (forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
S.valueOf SVariable r
i forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
?< 
  SValue r
finalv) (SVariable r
i forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&+= SValue r
stepv)

observerIndex :: (RenderSym r) => SVariable r
observerIndex :: forall (r :: * -> *). RenderSym r => SVariable r
observerIndex = forall (r :: * -> *).
VariableSym r =>
Label -> VSType r -> SVariable r
S.var Label
"observerIndex" forall (r :: * -> *). TypeSym r => VSType r
S.int

observerIdxVal :: (RenderSym r) => SValue r
observerIdxVal :: forall (r :: * -> *). RenderSym r => SValue r
observerIdxVal = forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
S.valueOf forall (r :: * -> *). RenderSym r => SVariable r
observerIndex

obsList :: (RenderSym r) => VSType r -> SValue r
obsList :: forall (r :: * -> *). RenderSym r => VSType r -> SValue r
obsList VSType r
t = forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
S.valueOf forall a b. (a -> b) -> a -> b
$ Label
observerListName forall (r :: * -> *).
VariableSym r =>
Label -> VSType r -> SVariable r
`listOf` VSType r
t

notify :: (RenderSym r) => VSType r -> VSFunction r -> MSBody r
notify :: forall (r :: * -> *).
RenderSym r =>
VSType r -> VSFunction r -> MSBody r
notify VSType r
t VSFunction r
f = forall (r :: * -> *). BodySym r => MSStatement r -> MSBody r
oneLiner forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *). StatementSym r => SValue r -> MSStatement r
S.valStmt forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *). List r => SValue r -> SValue r -> SValue r
at (forall (r :: * -> *). RenderSym r => VSType r -> SValue r
obsList VSType r
t) forall (r :: * -> *). RenderSym r => SValue r
observerIdxVal forall (r :: * -> *).
FunctionSym r =>
SValue r -> VSFunction r -> SValue r
$. VSFunction r
f

notifyObservers :: (RenderSym r) => VSFunction r -> VSType r -> MSStatement r
notifyObservers :: forall (r :: * -> *).
RenderSym r =>
VSFunction r -> VSType r -> MSStatement r
notifyObservers VSFunction r
f VSType r
t = forall (r :: * -> *).
ControlStatement r =>
MSStatement r
-> SValue r -> MSStatement r -> MSBody r -> MSStatement r
S.for MS (r (Statement r))
initv (forall (r :: * -> *). RenderSym r => SValue r
observerIdxVal forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
?< forall (r :: * -> *). List r => SValue r -> SValue r
S.listSize (forall (r :: * -> *). RenderSym r => VSType r -> SValue r
obsList VSType r
t)) 
  (forall (r :: * -> *). RenderSym r => SVariable r
observerIndex &++) (forall (r :: * -> *).
RenderSym r =>
VSType r -> VSFunction r -> MSBody r
notify VSType r
t VSFunction r
f)
  where initv :: MS (r (Statement r))
initv = forall (r :: * -> *).
DeclStatement r =>
SVariable r -> SValue r -> MSStatement r
S.varDecDef forall (r :: * -> *). RenderSym r => SVariable r
observerIndex forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *). Literal r => Integer -> SValue r
S.litInt Integer
0

notifyObservers' :: (RenderSym r) => VSFunction r -> VSType r -> MSStatement r
notifyObservers' :: forall (r :: * -> *).
RenderSym r =>
VSFunction r -> VSType r -> MSStatement r
notifyObservers' VSFunction r
f VSType r
t = forall (r :: * -> *).
ControlStatement r =>
SVariable r
-> SValue r -> SValue r -> SValue r -> MSBody r -> MSStatement r
S.forRange forall (r :: * -> *). RenderSym r => SVariable r
observerIndex VS (r (Value r))
initv (forall (r :: * -> *). List r => SValue r -> SValue r
S.listSize forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *). RenderSym r => VSType r -> SValue r
obsList VSType r
t) 
    (forall (r :: * -> *). Literal r => Integer -> SValue r
S.litInt Integer
1) (forall (r :: * -> *).
RenderSym r =>
VSType r -> VSFunction r -> MSBody r
notify VSType r
t VSFunction r
f)
    where initv :: VS (r (Value r))
initv = forall (r :: * -> *). Literal r => Integer -> SValue r
S.litInt Integer
0
        
checkState :: (RenderSym r) => Label -> [(SValue r, MSBody r)] -> MSBody r -> 
  MSStatement r
checkState :: forall (r :: * -> *).
RenderSym r =>
Label -> [(SValue r, MSBody r)] -> MSBody r -> MSStatement r
checkState Label
l = forall (r :: * -> *).
ControlStatement r =>
SValue r -> [(SValue r, MSBody r)] -> MSBody r -> MSStatement r
S.switch (forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
S.valueOf forall a b. (a -> b) -> a -> b
$ forall (r :: * -> *).
VariableSym r =>
Label -> VSType r -> SVariable r
S.var Label
l forall (r :: * -> *). TypeSym r => VSType r
S.string)