-- | Implementations for C-like renderers are defined here.
module Drasil.Shared.LanguageRenderer.CLike (charRender, float, double, char,
  listType, setType, void, notOp, andOp, orOp, self, litTrue, litFalse, litFloat,
  inlineIf, libFuncAppMixedArgs, libNewObjMixedArgs, listSize, listSize',
  increment, increment1, decrement1, varDec, varDecDef, setDecDef, listDec,
  extObjDecNew, switch, for, while, multiAssignError, multiReturnError,
  multiTypeError
) where

import Drasil.FileHandling.Legacy (indent)

import Drasil.Shared.CodeType (CodeType(..))
import Drasil.Shared.InterfaceCommon (UnRepr(..), Library, TypeElim(..),
  SVariable, Value, SValue, MixedCall, MixedCtorCall, VariableSym(..),
  VariableValue(..), VariableElim(..), ValueSym(valueType), getCodeType,
  getTypeString)
import qualified Drasil.Shared.InterfaceCommon as IC
import Drasil.GOOL.InterfaceGOOL (extNewObj, objMethodCallNoParams, ($->))
import qualified Drasil.GOOL.InterfaceGOOL as IG
import Drasil.Shared.RendererClassesCommon (InternalVarElim(variableBind),
  RenderValue(valFromData), ValueElim(valuePrec), ScopeElim(scopeData))
import qualified Drasil.Shared.RendererClassesCommon as RC
import Drasil.GOOL.Renderers (renderType)
import qualified Drasil.GOOL.RendererClassesOO as RO
import Drasil.Shared.AST (AttachmentTag(..), Terminator(..), ScopeData,
  TypeData)
import Drasil.Shared.Helpers (angles, toState, onStateValue)
import Drasil.Shared.LanguageRenderer (forLabel, whileLabel, containing)
import qualified Drasil.Shared.LanguageRenderer as R
import Drasil.Shared.LanguageRenderer.Constructors (typeFromData, mkStmt,
  mkStmtNoEnd, mkStateVal, mkStateVar, VSOp, unOpPrec, andPrec, orPrec)
import Drasil.Shared.State (MS, VS, lensMStoVS, lensVStoMS, addLibImportVS,
  getClassName, useVarName, setVarScope)

import Prelude hiding (break,(<>))
import Control.Applicative ((<|>))
import Control.Monad.State (modify)
import Control.Lens.Zoom (zoom)
import Text.PrettyPrint.HughesPJ (Doc, text, (<>), (<+>), parens, vcat, semi,
  equals, empty)
import qualified Text.PrettyPrint.HughesPJ as D

-- Types --

floatRender, doubleRender, charRender, voidRender :: String
floatRender :: String
floatRender = String
"float"
doubleRender :: String
doubleRender = String
"double"
charRender :: String
charRender = String
"char"
voidRender :: String
voidRender = String
"void"

float :: (Monad r) => VS (r TypeData)
float :: forall (r :: * -> *). Monad r => VS (r TypeData)
float = CodeType -> String -> Doc -> VS (r TypeData)
forall (r :: * -> *).
Monad r =>
CodeType -> String -> Doc -> VS (r TypeData)
typeFromData CodeType
Float String
floatRender (String -> Doc
text String
floatRender)

double :: (Monad r) => VS (r TypeData)
double :: forall (r :: * -> *). Monad r => VS (r TypeData)
double = CodeType -> String -> Doc -> VS (r TypeData)
forall (r :: * -> *).
Monad r =>
CodeType -> String -> Doc -> VS (r TypeData)
typeFromData CodeType
Double String
doubleRender (String -> Doc
text String
doubleRender)

char :: (Monad r) => VS (r TypeData)
char :: forall (r :: * -> *). Monad r => VS (r TypeData)
char = CodeType -> String -> Doc -> VS (r TypeData)
forall (r :: * -> *).
Monad r =>
CodeType -> String -> Doc -> VS (r TypeData)
typeFromData CodeType
Char String
charRender (String -> Doc
text String
charRender)

listType :: (Monad r, TypeElim r, UnRepr r TypeData) => String ->
  VS (r TypeData) -> VS (r TypeData)
listType :: forall (r :: * -> *).
(Monad r, TypeElim r, UnRepr r TypeData) =>
String -> VS (r TypeData) -> VS (r TypeData)
listType String
lst VS (r TypeData)
t' = do
  t <- VS (r TypeData)
t'
  typeFromData (List (getCodeType t)) (lst
    `containing` getTypeString t) $ text lst <> angles (renderType t)

setType :: (Monad r, TypeElim r, UnRepr r TypeData) => String ->
  VS (r TypeData) -> VS (r TypeData)
setType :: forall (r :: * -> *).
(Monad r, TypeElim r, UnRepr r TypeData) =>
String -> VS (r TypeData) -> VS (r TypeData)
setType String
lst VS (r TypeData)
t' = do
  t <- VS (r TypeData)
t'
  typeFromData (Set (getCodeType t)) (lst
    `containing` getTypeString t) $ text lst <> angles (renderType t)

void :: (Monad r) => VS (r TypeData)
void :: forall (r :: * -> *). Monad r => VS (r TypeData)
void = CodeType -> String -> Doc -> VS (r TypeData)
forall (r :: * -> *).
Monad r =>
CodeType -> String -> Doc -> VS (r TypeData)
typeFromData CodeType
Void String
voidRender (String -> Doc
text String
voidRender)

-- Unary Operators --

notOp :: (Monad r) => VSOp r
notOp :: forall (r :: * -> *). Monad r => VSOp r
notOp = String -> VSOp r
forall (r :: * -> *). Monad r => String -> VSOp r
unOpPrec String
"!"

-- Binary Operators --

andOp :: (Monad r) => VSOp r
andOp :: forall (r :: * -> *). Monad r => VSOp r
andOp = String -> VSOp r
forall (r :: * -> *). Monad r => String -> VSOp r
andPrec String
"&&"

orOp :: (Monad r) => VSOp r
orOp :: forall (r :: * -> *). Monad r => VSOp r
orOp = String -> VSOp r
forall (r :: * -> *). Monad r => String -> VSOp r
orPrec String
"||"
-- Variables --

self :: (IG.OOTypeSym r, RC.RenderVariable r) => SVariable r
self :: forall (r :: * -> *).
(OOTypeSym r, RenderVariable r) =>
SVariable r
self = do
  l <- LensLike'
  (Zoomed (StateT MethodState Identity) String)
  ValueState
  MethodState
-> StateT MethodState Identity String
-> StateT ValueState Identity String
forall c.
LensLike'
  (Zoomed (StateT MethodState Identity) c) ValueState MethodState
-> StateT MethodState Identity c -> StateT ValueState 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 MethodState Identity) String)
  ValueState
  MethodState
(MethodState -> Focusing Identity String MethodState)
-> ValueState -> Focusing Identity String ValueState
Lens' ValueState MethodState
lensVStoMS StateT MethodState Identity String
getClassName
  mkStateVar R.this (IG.obj l) R.this'

-- Values --

litTrue :: (RenderValue r, IC.TypeSym r) => SValue r
litTrue :: forall (r :: * -> *). (RenderValue r, TypeSym r) => SValue r
litTrue = VS (r TypeData) -> Doc -> SValue r
forall (r :: * -> *).
RenderValue r =>
VS (r TypeData) -> Doc -> SValue r
mkStateVal VS (r TypeData)
forall (r :: * -> *). TypeSym r => VS (r TypeData)
IC.bool (String -> Doc
text String
"true")

litFalse :: (RenderValue r, IC.TypeSym r) => SValue r
litFalse :: forall (r :: * -> *). (RenderValue r, TypeSym r) => SValue r
litFalse = VS (r TypeData) -> Doc -> SValue r
forall (r :: * -> *).
RenderValue r =>
VS (r TypeData) -> Doc -> SValue r
mkStateVal VS (r TypeData)
forall (r :: * -> *). TypeSym r => VS (r TypeData)
IC.bool (String -> Doc
text String
"false")

litFloat :: (RenderValue r, IC.TypeSym r) => Float -> SValue r
litFloat :: forall (r :: * -> *).
(RenderValue r, TypeSym r) =>
Float -> SValue r
litFloat Float
f = VS (r TypeData) -> Doc -> SValue r
forall (r :: * -> *).
RenderValue r =>
VS (r TypeData) -> Doc -> SValue r
mkStateVal VS (r TypeData)
forall (r :: * -> *). TypeSym r => VS (r TypeData)
IC.float (Float -> Doc
D.float Float
f Doc -> Doc -> Doc
<> String -> Doc
text String
"f")

inlineIf
  :: (RenderValue r, ValueElim r, ValueSym r)
  => SValue r -> SValue r -> SValue r -> SValue r
inlineIf :: forall (r :: * -> *).
(RenderValue r, ValueElim r, ValueSym r) =>
SValue r -> SValue r -> SValue r -> SValue r
inlineIf SValue r
c' SValue r
v1' SValue r
v2' = do
  c <- SValue r
c'
  v1 <- v1'
  v2 <- v2'
  valFromData (prec c) Nothing (toState $ valueType v1)
    (RC.value c <+> text "?" <+> RC.value v1 <+> text ":" <+> RC.value v2)
  where prec :: r Value -> Maybe Int
prec r Value
cd = r Value -> Maybe Int
forall {r :: * -> *}. ValueElim r => r Value -> Maybe Int
valuePrec r Value
cd Maybe Int -> Maybe Int -> Maybe Int
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0

libFuncAppMixedArgs :: (IC.ValueExpression r) => Library -> MixedCall r
libFuncAppMixedArgs :: forall (r :: * -> *). ValueExpression r => String -> MixedCall r
libFuncAppMixedArgs String
l String
n VS (r TypeData)
t [SValue r]
vs NamedArgs r
ns = (ValueState -> ValueState) -> StateT ValueState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> ValueState -> ValueState
addLibImportVS String
l) StateT ValueState Identity () -> SValue r -> SValue r
forall a b.
StateT ValueState Identity a
-> StateT ValueState Identity b -> StateT ValueState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  MixedCall r
forall (r :: * -> *). ValueExpression r => MixedCall r
IC.funcAppMixedArgs String
n VS (r TypeData)
t [SValue r]
vs NamedArgs r
ns

libNewObjMixedArgs :: (IG.OOValueExpression r) => Library -> MixedCtorCall r
libNewObjMixedArgs :: forall (r :: * -> *).
OOValueExpression r =>
String -> MixedCtorCall r
libNewObjMixedArgs String
l VS (r TypeData)
tp [SValue r]
vs NamedArgs r
ns = (ValueState -> ValueState) -> StateT ValueState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (String -> ValueState -> ValueState
addLibImportVS String
l) StateT ValueState Identity () -> SValue r -> SValue r
forall a b.
StateT ValueState Identity a
-> StateT ValueState Identity b -> StateT ValueState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  MixedCtorCall r
forall (r :: * -> *). OOValueExpression r => MixedCtorCall r
IG.newObjMixedArgs VS (r TypeData)
tp [SValue r]
vs NamedArgs r
ns

-- Functions --

listSize :: (IG.InternalValueExp r) => String -> SValue r -> SValue r
listSize :: forall (r :: * -> *).
InternalValueExp r =>
String -> SValue r -> SValue r
listSize String
fnName SValue r
list = VS (r TypeData) -> SValue r -> String -> SValue r
forall (r :: * -> *).
InternalValueExp r =>
VS (r TypeData) -> SValue r -> String -> SValue r
objMethodCallNoParams VS (r TypeData)
forall (r :: * -> *). TypeSym r => VS (r TypeData)
IC.int SValue r
list String
fnName

listSize' :: (IG.OOVariableSym r, VariableValue r) => String -> SValue r -> SValue r
listSize' :: forall (r :: * -> *).
(OOVariableSym r, VariableValue r) =>
String -> SValue r -> SValue r
listSize' String
lengthName SValue r
list = 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
$ SValue r
list SValue r -> SVariable r -> SVariable r
forall (r :: * -> *).
OOVariableSym r =>
SValue r -> SVariable r -> SVariable r
$-> String -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
String -> VS (r TypeData) -> SVariable r
var String
lengthName VS (r TypeData)
forall (r :: * -> *). TypeSym r => VS (r TypeData)
IC.int

-- Statements --

increment
  :: (InternalVarElim r, RC.RenderStatement r stmt, ValueElim r)
  => SVariable r -> SValue r -> MS (r stmt)
increment :: forall (r :: * -> *) stmt.
(InternalVarElim r, RenderStatement r stmt, ValueElim r) =>
SVariable r -> SValue r -> MS (r stmt)
increment SVariable r
vr' 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'
  mkStmt $ R.addAssign vr v

increment1 :: (InternalVarElim r, RC.RenderStatement r stmt) => SVariable r -> MS (r stmt)
increment1 :: forall (r :: * -> *) stmt.
(InternalVarElim r, RenderStatement r stmt) =>
SVariable r -> MS (r stmt)
increment1 SVariable r
vr' = 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'
  (mkStmt . R.increment) vr

decrement1 :: (InternalVarElim r, RC.RenderStatement r stmt) => SVariable r -> MS (r stmt)
decrement1 :: forall (r :: * -> *) stmt.
(InternalVarElim r, RenderStatement r stmt) =>
SVariable r -> MS (r stmt)
decrement1 SVariable r
vr' = 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'
  (mkStmt . R.decrement) vr

varDec
  :: ( InternalVarElim r
     , RO.PermElim r attch
     , RC.RenderStatement r stmt
     , ScopeElim r
     , UnRepr r TypeData
     , TypeElim r
     , VariableElim r
     )
  => r attch -> r attch -> Doc -> SVariable r -> r ScopeData -> MS (r stmt)
varDec :: forall (r :: * -> *) attch stmt.
(InternalVarElim r, PermElim r attch, RenderStatement r stmt,
 ScopeElim r, UnRepr r TypeData, TypeElim r, VariableElim r) =>
r attch
-> r attch -> Doc -> SVariable r -> r ScopeData -> MS (r stmt)
varDec r attch
s r attch
d Doc
pdoc SVariable r
v' r ScopeData
scp = do
  v <- 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
v'
  modify $ useVarName (variableName v)
  modify $ setVarScope (variableName v) (scopeData scp)
  mkStmt (RO.perm (bind $ variableBind v)
    <+> renderType (variableType v) <+> (ptrdoc (getCodeType (variableType v)) <>
    RC.variable v))
  where bind :: AttachmentTag -> r attch
bind AttachmentTag
ClassLevel = r attch
s
        bind AttachmentTag
InstanceLevel = r attch
d
        ptrdoc :: CodeType -> Doc
ptrdoc (List CodeType
_) = Doc
pdoc
        ptrdoc (Set CodeType
_) = Doc
pdoc
        ptrdoc CodeType
_ = Doc
empty

varDecDef
  :: ( IC.DeclStatement r stmt bod
     , RC.RenderStatement r stmt
     , RC.StatementElim r stmt
     , ValueElim r
     )
  => Terminator -> SVariable r -> r ScopeData -> SValue r -> MS (r stmt)
varDecDef :: forall (r :: * -> *) stmt bod.
(DeclStatement r stmt bod, RenderStatement r stmt,
 StatementElim r stmt, ValueElim r) =>
Terminator -> SVariable r -> r ScopeData -> SValue r -> MS (r stmt)
varDecDef Terminator
t SVariable r
vr r ScopeData
scp SValue r
vl' = do
  vd <- SVariable r -> r ScopeData -> MS (r stmt)
forall (r :: * -> *) stmt bod.
DeclStatement r stmt bod =>
SVariable r -> r ScopeData -> MS (r stmt)
IC.varDec SVariable r
vr r ScopeData
scp
  vl <- zoom lensMStoVS vl'
  let stmtCtor Terminator
Empty = Doc -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k).
RenderStatement r stmt =>
Doc -> MS (r stmt)
mkStmtNoEnd
      stmtCtor Terminator
Semi = Doc -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k).
RenderStatement r stmt =>
Doc -> MS (r stmt)
mkStmt
  stmtCtor t (RC.statement vd <+> equals <+> RC.value vl)

setDecDef
  :: ( IC.DeclStatement r stmt bod
     , RC.RenderStatement r stmt
     , RC.StatementElim r stmt
     , ValueElim r
     )
  => Terminator -> SVariable r -> r ScopeData -> SValue r -> MS (r stmt)
setDecDef :: forall (r :: * -> *) stmt bod.
(DeclStatement r stmt bod, RenderStatement r stmt,
 StatementElim r stmt, ValueElim r) =>
Terminator -> SVariable r -> r ScopeData -> SValue r -> MS (r stmt)
setDecDef Terminator
t SVariable r
vr r ScopeData
scp SValue r
vl' = do
  vd <- SVariable r -> r ScopeData -> MS (r stmt)
forall (r :: * -> *) stmt bod.
DeclStatement r stmt bod =>
SVariable r -> r ScopeData -> MS (r stmt)
IC.setDec SVariable r
vr r ScopeData
scp
  vl <- zoom lensMStoVS vl'
  let stmtCtor Terminator
Empty = Doc -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k).
RenderStatement r stmt =>
Doc -> MS (r stmt)
mkStmtNoEnd
      stmtCtor Terminator
Semi = Doc -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k).
RenderStatement r stmt =>
Doc -> MS (r stmt)
mkStmt
  stmtCtor t (RC.statement vd <+> equals <+> RC.value vl)

listDec
  ::
    ( IC.DeclStatement r stmt bod
    , RC.RenderStatement r stmt
    , RC.StatementElim r stmt
    )
  => (r Value -> Doc) -> SValue r -> SVariable r -> r ScopeData -> MS (r stmt)
listDec :: forall (r :: * -> *) stmt bod.
(DeclStatement r stmt bod, RenderStatement r stmt,
 StatementElim r stmt) =>
(r Value -> Doc)
-> SValue r -> SVariable r -> r ScopeData -> MS (r stmt)
listDec r Value -> Doc
f SValue r
vl SVariable r
v r ScopeData
scp = do
  sz <- LensLike'
  (Zoomed (StateT ValueState Identity) (r Value))
  MethodState
  ValueState
-> SValue r -> StateT MethodState Identity (r Value)
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 Value))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r Value) ValueState)
-> MethodState -> Focusing Identity (r Value) MethodState
Lens' MethodState ValueState
lensMStoVS SValue r
vl
  vd <- IC.varDec v scp
  mkStmt (RC.statement vd <> f sz)

extObjDecNew
  :: (IC.DeclStatement r stmt bod, IG.OOValueExpression r, VariableElim r)
  => Library -> SVariable r -> r ScopeData -> [SValue r] -> MS (r stmt)
extObjDecNew :: forall (r :: * -> *) stmt bod.
(DeclStatement r stmt bod, OOValueExpression r, VariableElim r) =>
String -> SVariable r -> r ScopeData -> [SValue r] -> MS (r stmt)
extObjDecNew String
l SVariable r
v r ScopeData
scp [SValue r]
vs = 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)
IC.varDecDef SVariable r
v r ScopeData
scp
  (String -> PosCtorCall r
forall (r :: * -> *).
OOValueExpression r =>
String -> PosCtorCall r
extNewObj String
l ((r Variable -> r TypeData)
-> SVariable r -> State ValueState (r TypeData)
forall a b s. (a -> b) -> State s a -> State s b
onStateValue r Variable -> r TypeData
forall (r :: * -> *). VariableElim r => r Variable -> r TypeData
variableType SVariable r
v) [SValue r]
vs)

-- 1st parameter is a Doc function to apply to the render of the control value (i.e. parens)
-- 2nd parameter is a statement to end every case with
switch
  :: ( RC.BodyElim r bod
     , RC.RenderStatement r stmt
     , RC.StatementElim r stmt
     , ValueElim r
     )
  => (Doc -> Doc)
  -> MS (r stmt)
  -> SValue r
  -> [(SValue r, MS (r bod))]
  -> MS (r bod)
  -> MS (r stmt)
switch :: forall (r :: * -> *) bod stmt.
(BodyElim r bod, RenderStatement r stmt, StatementElim r stmt,
 ValueElim r) =>
(Doc -> Doc)
-> MS (r stmt)
-> SValue r
-> [(SValue r, MS (r bod))]
-> MS (r bod)
-> MS (r stmt)
switch Doc -> Doc
f MS (r stmt)
st SValue r
v [(SValue r, MS (r bod))]
cs MS (r bod)
bod = do
  s <- MS (r stmt) -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k).
RenderStatement r stmt =>
MS (r stmt) -> MS (r stmt)
RC.stmt MS (r stmt)
st
  val <- zoom lensMStoVS v
  vals <- mapM (zoom lensMStoVS . fst) cs
  bods <- mapM snd cs
  dflt <- bod
  mkStmt $ R.switch f s val dflt (zip vals bods)

for
  :: ( RC.BodyElim r bod
     , RC.RenderStatement r stmt
     , RC.StatementElim r stmt
     , ValueElim r
     )
  => Doc
  -> Doc
  -> MS (r stmt)
  -> SValue r
  -> MS (r stmt)
  -> MS (r bod)
  -> MS (r stmt)
for :: forall (r :: * -> *) bod stmt.
(BodyElim r bod, RenderStatement r stmt, StatementElim r stmt,
 ValueElim r) =>
Doc
-> Doc
-> MS (r stmt)
-> SValue r
-> MS (r stmt)
-> MS (r bod)
-> MS (r stmt)
for Doc
bStart Doc
bEnd MS (r stmt)
sInit SValue r
vGuard MS (r stmt)
sUpdate MS (r bod)
b = do
  initl <- MS (r stmt) -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k).
RenderStatement r stmt =>
MS (r stmt) -> MS (r stmt)
RC.loopStmt MS (r stmt)
sInit
  guard <- zoom lensMStoVS vGuard
  upd <- RC.loopStmt sUpdate
  bod <- b
  mkStmtNoEnd $ vcat [
    forLabel <+> parens (RC.statement initl <> semi <+> RC.value guard <>
      semi <+> RC.statement upd) <+> bStart,
    indent $ RC.body bod,
    bEnd]

-- Doc function parameter is applied to the render of the while-condition
while
  :: (RC.BodyElim r bod, RC.RenderStatement r stmt, ValueElim r)
  => (Doc -> Doc) -> Doc -> Doc -> SValue r -> MS (r bod) -> MS (r stmt)
while :: forall (r :: * -> *) bod stmt.
(BodyElim r bod, RenderStatement r stmt, ValueElim r) =>
(Doc -> Doc) -> Doc -> Doc -> SValue r -> MS (r bod) -> MS (r stmt)
while Doc -> Doc
f Doc
bStart Doc
bEnd SValue r
v' MS (r bod)
b'= do
  v <- LensLike'
  (Zoomed (StateT ValueState Identity) (r Value))
  MethodState
  ValueState
-> SValue r -> StateT MethodState Identity (r Value)
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 Value))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r Value) ValueState)
-> MethodState -> Focusing Identity (r Value) MethodState
Lens' MethodState ValueState
lensMStoVS SValue r
v'
  b <- b'
  mkStmtNoEnd (vcat [whileLabel <+> f (RC.value v) <+> bStart,
    indent $ RC.body b,
    bEnd])

-- Error Messages --

multiAssignError :: String -> String
multiAssignError :: String -> String
multiAssignError String
l = String
"No multiple assignment statements in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
l

multiReturnError :: String -> String
multiReturnError :: String -> String
multiReturnError String
l = String
"Cannot return multiple values in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
l

multiTypeError :: String -> String
multiTypeError :: String -> String
multiTypeError String
l = String
"Multi-types not supported in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
l