{-# LANGUAGE PostfixOperators #-}

-- | Implementations defined here are valid for any language renderer.
module GOOL.Drasil.LanguageRenderer.LanguagePolymorphic (fileFromData,
  multiBody, block, multiBlock, listInnerType, obj, negateOp, csc, sec, 
  cot, equalOp, notEqualOp, greaterOp, greaterEqualOp, lessOp, lessEqualOp, 
  plusOp, minusOp, multOp, divideOp, moduloOp, var, staticVar, objVar,
  classVarCheckStatic, arrayElem, litChar, litDouble, litInt, litString, 
  valueOf, arg, argsList, call, funcAppMixedArgs, selfFuncAppMixedArgs, 
  newObjMixedArgs, lambda, objAccess, objMethodCall, func, get, set, listAdd, 
  listAppend, listAccess, listSet, getFunc, setFunc, 
  listAppendFunc, stmt, loopStmt, emptyStmt, assign, subAssign, increment, 
  objDecNew, print, closeFile, returnStmt, valStmt, comment, throw, ifCond, 
  tryCatch, construct, param, method, getMethod, setMethod, initStmts, 
  function, docFuncRepr, docFunc, buildClass, implementingClass, 
  docClass, commentedClass, modFromData, fileDoc, docMod
) where

import Utils.Drasil (indent)

import GOOL.Drasil.CodeType (CodeType(..), ClassName)
import GOOL.Drasil.ClassInterface (Label, Library, SFile, MSBody, MSBlock, 
  VSType, SVariable, SValue, VSFunction, MSStatement, MSParameter, SMethod, 
  CSStateVar, SClass, FSModule, NamedArgs, Initializers, MixedCall, 
  MixedCtorCall, FileSym(File), BodySym(Body), bodyStatements, oneLiner, 
  BlockSym(Block), PermanenceSym(..), TypeSym(Type), 
  TypeElim(getType, getTypeString), VariableSym(Variable), 
  VariableElim(variableName, variableType), ValueSym(Value, valueType), 
  NumericExpression((#-), (#/), sin, cos, tan), Comparison(..), funcApp, 
  newObj, objMethodCallNoParams, ($.), StatementSym(multi), 
  AssignStatement((&++)), (&=), 
  IOStatement(printStr, printStrLn, printFile, printFileStr, printFileStrLn),
  ifNoElse, ScopeSym(..), ModuleSym(Module), convType)
import qualified GOOL.Drasil.ClassInterface as S (
  TypeSym(int, double, char, string, listType, arrayType, listInnerType, funcType, void), 
  VariableSym(var, objVarSelf), Literal(litInt, litFloat, litDouble, litString),
  VariableValue(valueOf), FunctionSym(func), List(listSize, listAccess), 
  StatementSym(valStmt), DeclStatement(varDecDef), IOStatement(print),
  ControlStatement(returnStmt, for), ParameterSym(param), MethodSym(method))
import GOOL.Drasil.RendererClasses (RenderSym, RenderFile(commentedMod),  
  RenderType(..), InternalVarElim(variableBind), RenderValue(valFromData),
  RenderFunction(funcFromData), FunctionElim(functionType), 
  RenderStatement(stmtFromData),  StatementElim(statementTerm), 
  MethodTypeSym(mType), RenderParam(paramFromData), 
  RenderMethod(intMethod, commentedFunc), RenderClass(inherit, implements), 
  RenderMod(updateModuleDoc), BlockCommentSym(..))
import qualified GOOL.Drasil.RendererClasses as S (RenderFile(fileFromData), 
  RenderValue(call), InternalGetSet(getFunc, setFunc),InternalListFunc
  (listAddFunc, listAppendFunc, listAccessFunc, listSetFunc),
  RenderStatement(stmt), InternalIOStmt(..), RenderMethod(intFunc), 
  RenderClass(intClass, commentedClass))
import qualified GOOL.Drasil.RendererClasses as RC (BodyElim(..), BlockElim(..),
  InternalVarElim(variable), ValueElim(value), FunctionElim(function), 
  StatementElim(statement), ClassElim(..), ModuleElim(..), BlockCommentElim(..))
import GOOL.Drasil.AST (Binding(..), Terminator(..), isSource)
import GOOL.Drasil.Helpers (doubleQuotedText, vibcat, emptyIfEmpty, toCode, 
  toState, onStateValue, on2StateValues, onStateList, getInnerType, getNestDegree,
  on2StateWrapped)
import GOOL.Drasil.LanguageRenderer (dot, ifLabel, elseLabel, access, addExt, 
  FuncDocRenderer, ClassDocRenderer, ModuleDocRenderer, getterName, setterName, 
  valueList, namedArgList)
import qualified GOOL.Drasil.LanguageRenderer as R (file, block, assign, 
  addAssign, subAssign, return', comment, getTerm, var, objVar, arg, func, 
  objAccess, commentedItem)
import GOOL.Drasil.LanguageRenderer.Constructors (mkStmt, mkStmtNoEnd, 
  mkStateVal, mkVal, mkStateVar, mkVar, mkStaticVar, VSOp, unOpPrec, 
  compEqualPrec, compPrec, addPrec, multPrec)
import GOOL.Drasil.State (FS, CS, MS, lensFStoGS, lensMStoVS, lensCStoFS, 
  currMain, currFileType, modifyReturnFunc, addFile, setMainMod, setModuleName, 
  getModuleName, addParameter, getParameters)

import Prelude hiding (print,sin,cos,tan,(<>))
import Data.Maybe (fromMaybe, maybeToList)
import Control.Monad.State (modify, join)
import Control.Lens ((^.), over)
import Control.Lens.Zoom (zoom)
import Text.PrettyPrint.HughesPJ (Doc, text, empty, render, (<>), (<+>), parens,
  brackets, integer, vcat, comma, isEmpty)
import qualified Text.PrettyPrint.HughesPJ as D (char, double)

-- Bodies --

multiBody :: (RenderSym r, Monad r) => [MSBody r] -> MS (r Doc)
multiBody :: [MSBody r] -> MS (r Doc)
multiBody bs :: [MSBody r]
bs = ([Doc] -> r Doc) -> [State MethodState Doc] -> MS (r Doc)
forall a b s. ([a] -> b) -> [State s a] -> State s b
onStateList (Doc -> r Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode (Doc -> r Doc) -> ([Doc] -> Doc) -> [Doc] -> r Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
vibcat) ([State MethodState Doc] -> MS (r Doc))
-> [State MethodState Doc] -> MS (r Doc)
forall a b. (a -> b) -> a -> b
$ (MSBody r -> State MethodState Doc)
-> [MSBody r] -> [State MethodState Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((r (Body r) -> Doc) -> MSBody r -> State MethodState Doc
forall a b s. (a -> b) -> State s a -> State s b
onStateValue r (Body r) -> Doc
forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body) [MSBody r]
bs

-- Blocks --

block :: (RenderSym r, Monad r) => [MSStatement r] -> MS (r Doc)
block :: [MSStatement r] -> MS (r Doc)
block sts :: [MSStatement r]
sts = ([r (Statement r)] -> r Doc) -> [MSStatement r] -> MS (r Doc)
forall a b s. ([a] -> b) -> [State s a] -> State s b
onStateList (Doc -> r Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode (Doc -> r Doc)
-> ([r (Statement r)] -> Doc) -> [r (Statement r)] -> r Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
R.block ([Doc] -> Doc)
-> ([r (Statement r)] -> [Doc]) -> [r (Statement r)] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r (Statement r) -> Doc) -> [r (Statement r)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map r (Statement r) -> Doc
forall (r :: * -> *). StatementElim r => r (Statement r) -> Doc
RC.statement) ((MSStatement r -> MSStatement r)
-> [MSStatement r] -> [MSStatement r]
forall a b. (a -> b) -> [a] -> [b]
map MSStatement r -> MSStatement r
forall (r :: * -> *).
RenderStatement r =>
MSStatement r -> MSStatement r
S.stmt [MSStatement r]
sts)

multiBlock :: (RenderSym r, Monad r) => [MSBlock r] -> MS (r Doc)
multiBlock :: [MSBlock r] -> MS (r Doc)
multiBlock bs :: [MSBlock r]
bs = ([Doc] -> r Doc) -> [State MethodState Doc] -> MS (r Doc)
forall a b s. ([a] -> b) -> [State s a] -> State s b
onStateList (Doc -> r Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode (Doc -> r Doc) -> ([Doc] -> Doc) -> [Doc] -> r Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
vibcat) ([State MethodState Doc] -> MS (r Doc))
-> [State MethodState Doc] -> MS (r Doc)
forall a b. (a -> b) -> a -> b
$ (MSBlock r -> State MethodState Doc)
-> [MSBlock r] -> [State MethodState Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((r (Block r) -> Doc) -> MSBlock r -> State MethodState Doc
forall a b s. (a -> b) -> State s a -> State s b
onStateValue r (Block r) -> Doc
forall (r :: * -> *). BlockElim r => r (Block r) -> Doc
RC.block) [MSBlock r]
bs

-- Types --

listInnerType :: (RenderSym r) => VSType r -> VSType r
listInnerType :: VSType r -> VSType r
listInnerType t :: VSType r
t = VSType r
t VSType r -> (r (Type r) -> VSType r) -> VSType r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CodeType -> VSType r
forall (r :: * -> *). TypeSym r => CodeType -> VSType r
convType (CodeType -> VSType r)
-> (r (Type r) -> CodeType) -> r (Type r) -> VSType r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeType -> CodeType
getInnerType (CodeType -> CodeType)
-> (r (Type r) -> CodeType) -> r (Type r) -> CodeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r (Type r) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType)

obj :: (RenderSym r) => ClassName -> VSType r
obj :: ClassName -> VSType r
obj n :: ClassName
n = CodeType -> ClassName -> Doc -> VSType r
forall (r :: * -> *).
RenderType r =>
CodeType -> ClassName -> Doc -> VSType r
typeFromData (ClassName -> CodeType
Object ClassName
n) ClassName
n (ClassName -> Doc
text ClassName
n)

-- Unary Operators --

negateOp :: (Monad r) => VSOp r
negateOp :: VSOp r
negateOp = ClassName -> VSOp r
forall (r :: * -> *). Monad r => ClassName -> VSOp r
unOpPrec "-"

csc :: (RenderSym r) => SValue r -> SValue r
csc :: SValue r -> SValue r
csc v :: SValue r
v = VSType r -> SValue r
forall (r :: * -> *). RenderSym r => VSType r -> SValue r
valOfOne ((r (Value r) -> r (Type r)) -> SValue r -> VSType r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap r (Value r) -> r (Type r)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType SValue r
v) SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
#/ SValue r -> SValue r
forall (r :: * -> *). NumericExpression r => SValue r -> SValue r
sin SValue r
v

sec :: (RenderSym r) => SValue r -> SValue r
sec :: SValue r -> SValue r
sec v :: SValue r
v = VSType r -> SValue r
forall (r :: * -> *). RenderSym r => VSType r -> SValue r
valOfOne ((r (Value r) -> r (Type r)) -> SValue r -> VSType r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap r (Value r) -> r (Type r)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType SValue r
v) SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
#/ SValue r -> SValue r
forall (r :: * -> *). NumericExpression r => SValue r -> SValue r
cos SValue r
v

cot :: (RenderSym r) => SValue r -> SValue r
cot :: SValue r -> SValue r
cot v :: SValue r
v = VSType r -> SValue r
forall (r :: * -> *). RenderSym r => VSType r -> SValue r
valOfOne ((r (Value r) -> r (Type r)) -> SValue r -> VSType r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap r (Value r) -> r (Type r)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType SValue r
v) SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
#/ SValue r -> SValue r
forall (r :: * -> *). NumericExpression r => SValue r -> SValue r
tan SValue r
v

valOfOne :: (RenderSym r) => VSType r -> SValue r
valOfOne :: VSType r -> SValue r
valOfOne t :: VSType r
t = VSType r
t VSType r -> (r (Type r) -> SValue r) -> SValue r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CodeType -> SValue r
forall (r :: * -> *).
Literal r =>
CodeType -> StateT ValueState Identity (r (Value r))
getVal (CodeType -> SValue r)
-> (r (Type r) -> CodeType) -> r (Type r) -> SValue r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r (Type r) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType)
  where getVal :: CodeType -> StateT ValueState Identity (r (Value r))
getVal Float = Float -> StateT ValueState Identity (r (Value r))
forall (r :: * -> *). Literal r => Float -> SValue r
S.litFloat 1.0
        getVal _ = Double -> StateT ValueState Identity (r (Value r))
forall (r :: * -> *). Literal r => Double -> SValue r
S.litDouble 1.0

-- Binary Operators --

equalOp :: (Monad r) => VSOp r
equalOp :: VSOp r
equalOp = ClassName -> VSOp r
forall (r :: * -> *). Monad r => ClassName -> VSOp r
compEqualPrec "=="

notEqualOp :: (Monad r) => VSOp r
notEqualOp :: VSOp r
notEqualOp = ClassName -> VSOp r
forall (r :: * -> *). Monad r => ClassName -> VSOp r
compEqualPrec "!="

greaterOp :: (Monad r) => VSOp r
greaterOp :: VSOp r
greaterOp = ClassName -> VSOp r
forall (r :: * -> *). Monad r => ClassName -> VSOp r
compPrec ">"

greaterEqualOp :: (Monad r) => VSOp r
greaterEqualOp :: VSOp r
greaterEqualOp = ClassName -> VSOp r
forall (r :: * -> *). Monad r => ClassName -> VSOp r
compPrec ">="

lessOp :: (Monad r) => VSOp r
lessOp :: VSOp r
lessOp = ClassName -> VSOp r
forall (r :: * -> *). Monad r => ClassName -> VSOp r
compPrec "<"

lessEqualOp :: (Monad r) => VSOp r
lessEqualOp :: VSOp r
lessEqualOp = ClassName -> VSOp r
forall (r :: * -> *). Monad r => ClassName -> VSOp r
compPrec "<="

plusOp :: (Monad r) => VSOp r
plusOp :: VSOp r
plusOp = ClassName -> VSOp r
forall (r :: * -> *). Monad r => ClassName -> VSOp r
addPrec "+"

minusOp :: (Monad r) => VSOp r
minusOp :: VSOp r
minusOp = ClassName -> VSOp r
forall (r :: * -> *). Monad r => ClassName -> VSOp r
addPrec "-"

multOp :: (Monad r) => VSOp r
multOp :: VSOp r
multOp = ClassName -> VSOp r
forall (r :: * -> *). Monad r => ClassName -> VSOp r
multPrec "*"

divideOp :: (Monad r) => VSOp r
divideOp :: VSOp r
divideOp = ClassName -> VSOp r
forall (r :: * -> *). Monad r => ClassName -> VSOp r
multPrec "/"

moduloOp :: (Monad r) => VSOp r
moduloOp :: VSOp r
moduloOp = ClassName -> VSOp r
forall (r :: * -> *). Monad r => ClassName -> VSOp r
multPrec "%"

-- Variables --

var :: (RenderSym r) => Label -> VSType r -> SVariable r
var :: ClassName -> VSType r -> SVariable r
var n :: ClassName
n t :: VSType r
t = ClassName -> VSType r -> Doc -> SVariable r
forall (r :: * -> *).
RenderSym r =>
ClassName -> VSType r -> Doc -> SVariable r
mkStateVar ClassName
n VSType r
t (ClassName -> Doc
R.var ClassName
n)

staticVar :: (RenderSym r) => Label -> VSType r -> SVariable r
staticVar :: ClassName -> VSType r -> SVariable r
staticVar n :: ClassName
n t :: VSType r
t = ClassName -> VSType r -> Doc -> SVariable r
forall (r :: * -> *).
RenderSym r =>
ClassName -> VSType r -> Doc -> SVariable r
mkStaticVar ClassName
n VSType r
t (ClassName -> Doc
R.var ClassName
n)

-- | To be used in classVar implementations. Throws an error if the variable is 
-- not static since classVar is for accessing static variables from a class
classVarCheckStatic :: (RenderSym r) => r (Variable r) -> r (Variable r)
classVarCheckStatic :: r (Variable r) -> r (Variable r)
classVarCheckStatic v :: r (Variable r)
v = Binding -> r (Variable r)
classVarCS (r (Variable r) -> Binding
forall (r :: * -> *).
InternalVarElim r =>
r (Variable r) -> Binding
variableBind r (Variable r)
v)
  where classVarCS :: Binding -> r (Variable r)
classVarCS Dynamic = ClassName -> r (Variable r)
forall a. HasCallStack => ClassName -> a
error
          "classVar can only be used to access static variables"
        classVarCS Static = r (Variable r)
v

objVar :: (RenderSym r) => SVariable r -> SVariable r -> SVariable r
objVar :: SVariable r -> SVariable r -> SVariable r
objVar o' :: SVariable r
o' v' :: SVariable r
v' = do
  r (Variable r)
o <- SVariable r
o'
  r (Variable r)
v <- SVariable r
v'
  let objVar' :: Binding -> SVariable r
objVar' Static = ClassName -> SVariable r
forall a. HasCallStack => ClassName -> a
error 
        "Cannot access static variables through an object, use classVar instead"
      objVar' Dynamic = ClassName -> r (Type r) -> Doc -> SVariable r
forall (r :: * -> *).
RenderSym r =>
ClassName -> r (Type r) -> Doc -> SVariable r
mkVar (r (Variable r) -> ClassName
forall (r :: * -> *). VariableElim r => r (Variable r) -> ClassName
variableName r (Variable r)
o ClassName -> ClassName -> ClassName
`access` r (Variable r) -> ClassName
forall (r :: * -> *). VariableElim r => r (Variable r) -> ClassName
variableName r (Variable r)
v) 
        (r (Variable r) -> r (Type r)
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType r (Variable r)
v) (Doc -> Doc -> Doc
R.objVar (r (Variable r) -> Doc
forall (r :: * -> *). InternalVarElim r => r (Variable r) -> Doc
RC.variable r (Variable r)
o) (r (Variable r) -> Doc
forall (r :: * -> *). InternalVarElim r => r (Variable r) -> Doc
RC.variable r (Variable r)
v))
  Binding -> SVariable r
objVar' (r (Variable r) -> Binding
forall (r :: * -> *).
InternalVarElim r =>
r (Variable r) -> Binding
variableBind r (Variable r)
v)

arrayElem :: (RenderSym r) => SValue r -> SVariable r -> SVariable r
arrayElem :: SValue r -> SVariable r -> SVariable r
arrayElem i' :: SValue r
i' v' :: SVariable r
v' = do
  r (Value r)
i <- SValue r
i'
  r (Variable r)
v <- SVariable r
v'
  let vName :: ClassName
vName = r (Variable r) -> ClassName
forall (r :: * -> *). VariableElim r => r (Variable r) -> ClassName
variableName r (Variable r)
v ClassName -> ClassName -> ClassName
forall a. [a] -> [a] -> [a]
++ "[" ClassName -> ClassName -> ClassName
forall a. [a] -> [a] -> [a]
++ Doc -> ClassName
render (r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
i) ClassName -> ClassName -> ClassName
forall a. [a] -> [a] -> [a]
++ "]"
      vType :: VSType r
vType = VSType r -> VSType r
forall (r :: * -> *). RenderSym r => VSType r -> VSType r
listInnerType (VSType r -> VSType r) -> VSType r -> VSType r
forall a b. (a -> b) -> a -> b
$ r (Type r) -> VSType r
forall (m :: * -> *) a. Monad m => a -> m a
return (r (Type r) -> VSType r) -> r (Type r) -> VSType r
forall a b. (a -> b) -> a -> b
$ r (Variable r) -> r (Type r)
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType r (Variable r)
v
      vRender :: Doc
vRender = r (Variable r) -> Doc
forall (r :: * -> *). InternalVarElim r => r (Variable r) -> Doc
RC.variable r (Variable r)
v Doc -> Doc -> Doc
<> Doc -> Doc
brackets (r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
i)
  ClassName -> VSType r -> Doc -> SVariable r
forall (r :: * -> *).
RenderSym r =>
ClassName -> VSType r -> Doc -> SVariable r
mkStateVar ClassName
vName VSType r
vType Doc
vRender

-- Values --

litChar :: (RenderSym r) => (Doc -> Doc) -> Char -> SValue r
litChar :: (Doc -> Doc) -> Char -> SValue r
litChar f :: Doc -> Doc
f c :: Char
c = VSType r -> Doc -> SValue r
forall (r :: * -> *). RenderSym r => VSType r -> Doc -> SValue r
mkStateVal VSType r
forall (r :: * -> *). TypeSym r => VSType r
S.char (Doc -> Doc
f (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\n' then ClassName -> Doc
text "\\n" else Char -> Doc
D.char Char
c)

litDouble :: (RenderSym r) => Double -> SValue r
litDouble :: Double -> SValue r
litDouble d :: Double
d = VSType r -> Doc -> SValue r
forall (r :: * -> *). RenderSym r => VSType r -> Doc -> SValue r
mkStateVal VSType r
forall (r :: * -> *). TypeSym r => VSType r
S.double (Double -> Doc
D.double Double
d)

litInt :: (RenderSym r) => Integer -> SValue r
litInt :: Integer -> SValue r
litInt i :: Integer
i = VSType r -> Doc -> SValue r
forall (r :: * -> *). RenderSym r => VSType r -> Doc -> SValue r
mkStateVal VSType r
forall (r :: * -> *). TypeSym r => VSType r
S.int (Integer -> Doc
integer Integer
i)

litString :: (RenderSym r) => String -> SValue r
litString :: ClassName -> SValue r
litString s :: ClassName
s = VSType r -> Doc -> SValue r
forall (r :: * -> *). RenderSym r => VSType r -> Doc -> SValue r
mkStateVal VSType r
forall (r :: * -> *). TypeSym r => VSType r
S.string (ClassName -> Doc
doubleQuotedText ClassName
s)

valueOf :: (RenderSym r) => SVariable r -> SValue r
valueOf :: SVariable r -> SValue r
valueOf v' :: SVariable r
v' = do 
  r (Variable r)
v <- SVariable r
v'
  r (Type r) -> Doc -> SValue r
forall (r :: * -> *). RenderSym r => r (Type r) -> Doc -> SValue r
mkVal (r (Variable r) -> r (Type r)
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType r (Variable r)
v) (r (Variable r) -> Doc
forall (r :: * -> *). InternalVarElim r => r (Variable r) -> Doc
RC.variable r (Variable r)
v)

arg :: (RenderSym r) => SValue r -> SValue r -> SValue r
arg :: SValue r -> SValue r -> SValue r
arg n' :: SValue r
n' args' :: SValue r
args' = do 
  r (Value r)
n <- SValue r
n'
  r (Value r)
args <- SValue r
args'
  r (Type r)
s <- VSType r
forall (r :: * -> *). TypeSym r => VSType r
S.string
  r (Type r) -> Doc -> SValue r
forall (r :: * -> *). RenderSym r => r (Type r) -> Doc -> SValue r
mkVal r (Type r)
s (r (Value r) -> r (Value r) -> Doc
forall (r :: * -> *).
RenderSym r =>
r (Value r) -> r (Value r) -> Doc
R.arg r (Value r)
n r (Value r)
args)

argsList :: (RenderSym r) => String -> SValue r
argsList :: ClassName -> SValue r
argsList l :: ClassName
l = VSType r -> Doc -> SValue r
forall (r :: * -> *). RenderSym r => VSType r -> Doc -> SValue r
mkStateVal (VSType r -> VSType r
forall (r :: * -> *). TypeSym r => VSType r -> VSType r
S.arrayType VSType r
forall (r :: * -> *). TypeSym r => VSType r
S.string) (ClassName -> Doc
text ClassName
l)

-- | First parameter is separator between name and value for named arguments, 
-- rest similar to call from ClassInterface
call :: (RenderSym r) => Doc -> Maybe Library -> Maybe Doc -> MixedCall r
call :: Doc -> Maybe ClassName -> Maybe Doc -> MixedCall r
call sep :: Doc
sep lib :: Maybe ClassName
lib o :: Maybe Doc
o n :: ClassName
n t :: VSType r
t pas :: [SValue r]
pas nas :: NamedArgs r
nas = do
  [r (Value r)]
pargs <- [SValue r] -> StateT ValueState Identity [r (Value r)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [SValue r]
pas
  [r (Variable r)]
nms <- ((StateT ValueState Identity (r (Variable r)), SValue r)
 -> StateT ValueState Identity (r (Variable r)))
-> NamedArgs r -> StateT ValueState Identity [r (Variable r)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (StateT ValueState Identity (r (Variable r)), SValue r)
-> StateT ValueState Identity (r (Variable r))
forall a b. (a, b) -> a
fst NamedArgs r
nas
  [r (Value r)]
nargs <- ((StateT ValueState Identity (r (Variable r)), SValue r)
 -> SValue r)
-> NamedArgs r -> StateT ValueState Identity [r (Value r)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (StateT ValueState Identity (r (Variable r)), SValue r) -> SValue r
forall a b. (a, b) -> b
snd NamedArgs r
nas
  let libDoc :: Doc
libDoc = Doc -> (ClassName -> Doc) -> Maybe ClassName -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ClassName -> Doc
text ClassName
n) (ClassName -> Doc
text (ClassName -> Doc) -> (ClassName -> ClassName) -> ClassName -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ClassName -> ClassName -> ClassName
`access` ClassName
n)) Maybe ClassName
lib
      obDoc :: Doc
obDoc = Doc -> Maybe Doc -> Doc
forall a. a -> Maybe a -> a
fromMaybe Doc
empty Maybe Doc
o
  VSType r -> Doc -> SValue r
forall (r :: * -> *). RenderSym r => VSType r -> Doc -> SValue r
mkStateVal VSType r
t (Doc -> SValue r) -> Doc -> SValue r
forall a b. (a -> b) -> a -> b
$ Doc
obDoc Doc -> Doc -> Doc
<> Doc
libDoc Doc -> Doc -> Doc
<> Doc -> Doc
parens ([r (Value r)] -> Doc
forall (r :: * -> *). RenderSym r => [r (Value r)] -> Doc
valueList [r (Value r)]
pargs Doc -> Doc -> Doc
<> 
    (if [SValue r] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SValue r]
pas Bool -> Bool -> Bool
|| NamedArgs r -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null NamedArgs r
nas then Doc
empty else Doc
comma) Doc -> Doc -> Doc
<+> Doc -> [(r (Variable r), r (Value r))] -> Doc
forall (r :: * -> *).
RenderSym r =>
Doc -> [(r (Variable r), r (Value r))] -> Doc
namedArgList Doc
sep 
    ([r (Variable r)]
-> [r (Value r)] -> [(r (Variable r), r (Value r))]
forall a b. [a] -> [b] -> [(a, b)]
zip [r (Variable r)]
nms [r (Value r)]
nargs))

funcAppMixedArgs :: (RenderSym r) => MixedCall r
funcAppMixedArgs :: MixedCall r
funcAppMixedArgs = Maybe ClassName -> Maybe Doc -> MixedCall r
forall (r :: * -> *).
RenderValue r =>
Maybe ClassName -> Maybe Doc -> MixedCall r
S.call Maybe ClassName
forall a. Maybe a
Nothing Maybe Doc
forall a. Maybe a
Nothing

selfFuncAppMixedArgs :: (RenderSym r) => Doc -> SVariable r -> MixedCall r
selfFuncAppMixedArgs :: Doc -> SVariable r -> MixedCall r
selfFuncAppMixedArgs d :: Doc
d slf :: SVariable r
slf n :: ClassName
n t :: VSType r
t vs :: [SValue r]
vs ns :: NamedArgs r
ns = do
  r (Variable r)
s <- SVariable r
slf 
  Maybe ClassName -> Maybe Doc -> MixedCall r
forall (r :: * -> *).
RenderValue r =>
Maybe ClassName -> Maybe Doc -> MixedCall r
S.call Maybe ClassName
forall a. Maybe a
Nothing (Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ r (Variable r) -> Doc
forall (r :: * -> *). InternalVarElim r => r (Variable r) -> Doc
RC.variable r (Variable r)
s Doc -> Doc -> Doc
<> Doc
d) ClassName
n VSType r
t [SValue r]
vs NamedArgs r
ns

newObjMixedArgs :: (RenderSym r) => String -> MixedCtorCall r
newObjMixedArgs :: ClassName -> MixedCtorCall r
newObjMixedArgs s :: ClassName
s tp :: VSType r
tp vs :: [SValue r]
vs ns :: NamedArgs r
ns = do
  r (Type r)
t <- VSType r
tp 
  Maybe ClassName -> Maybe Doc -> ClassName -> MixedCtorCall r
forall (r :: * -> *).
RenderValue r =>
Maybe ClassName -> Maybe Doc -> MixedCall r
S.call Maybe ClassName
forall a. Maybe a
Nothing Maybe Doc
forall a. Maybe a
Nothing (ClassName
s ClassName -> ClassName -> ClassName
forall a. [a] -> [a] -> [a]
++ r (Type r) -> ClassName
forall (r :: * -> *). TypeElim r => r (Type r) -> ClassName
getTypeString r (Type r)
t) (r (Type r) -> VSType r
forall (m :: * -> *) a. Monad m => a -> m a
return r (Type r)
t) [SValue r]
vs NamedArgs r
ns

lambda :: (RenderSym r) => ([r (Variable r)] -> r (Value r) -> Doc) -> 
  [SVariable r] -> SValue r -> SValue r
lambda :: ([r (Variable r)] -> r (Value r) -> Doc)
-> [SVariable r] -> SValue r -> SValue r
lambda f :: [r (Variable r)] -> r (Value r) -> Doc
f ps' :: [SVariable r]
ps' ex' :: SValue r
ex' = do
  [r (Variable r)]
ps <- [SVariable r] -> StateT ValueState Identity [r (Variable r)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [SVariable r]
ps'
  r (Value r)
ex <- SValue r
ex'
  let ft :: VSType r
ft = [VSType r] -> VSType r -> VSType r
forall (r :: * -> *).
TypeSym r =>
[VSType r] -> VSType r -> VSType r
S.funcType ((r (Variable r) -> VSType r) -> [r (Variable r)] -> [VSType r]
forall a b. (a -> b) -> [a] -> [b]
map (r (Type r) -> VSType r
forall (m :: * -> *) a. Monad m => a -> m a
return (r (Type r) -> VSType r)
-> (r (Variable r) -> r (Type r)) -> r (Variable r) -> VSType r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r (Variable r) -> r (Type r)
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType) [r (Variable r)]
ps) (r (Type r) -> VSType r
forall (m :: * -> *) a. Monad m => a -> m a
return (r (Type r) -> VSType r) -> r (Type r) -> VSType r
forall a b. (a -> b) -> a -> b
$ r (Value r) -> r (Type r)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType r (Value r)
ex)
  Maybe Int -> VSType r -> Doc -> SValue r
forall (r :: * -> *).
RenderValue r =>
Maybe Int -> VSType r -> Doc -> SValue r
valFromData (Int -> Maybe Int
forall a. a -> Maybe a
Just 0) VSType r
ft ([r (Variable r)] -> r (Value r) -> Doc
f [r (Variable r)]
ps r (Value r)
ex)

objAccess :: (RenderSym r) => SValue r -> VSFunction r -> SValue r
objAccess :: SValue r -> VSFunction r -> SValue r
objAccess = (r (Value r) -> r (Function r) -> SValue r)
-> SValue r -> VSFunction r -> SValue r
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> m a -> m b -> m c
on2StateWrapped (\v :: r (Value r)
v f :: r (Function r)
f-> r (Type r) -> Doc -> SValue r
forall (r :: * -> *). RenderSym r => r (Type r) -> Doc -> SValue r
mkVal (r (Function r) -> r (Type r)
forall (r :: * -> *).
FunctionElim r =>
r (Function r) -> r (Type r)
functionType r (Function r)
f) 
  (Doc -> Doc -> Doc
R.objAccess (r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
v) (r (Function r) -> Doc
forall (r :: * -> *). FunctionElim r => r (Function r) -> Doc
RC.function r (Function r)
f)))

objMethodCall :: (RenderSym r) => Label -> VSType r -> SValue r -> [SValue r] 
  -> NamedArgs r -> SValue r
objMethodCall :: ClassName
-> VSType r -> SValue r -> [SValue r] -> NamedArgs r -> SValue r
objMethodCall f :: ClassName
f t :: VSType r
t ob :: SValue r
ob vs :: [SValue r]
vs ns :: NamedArgs r
ns = SValue r
ob SValue r -> (r (Value r) -> SValue r) -> SValue r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\o :: r (Value r)
o -> Maybe ClassName -> Maybe Doc -> MixedCall r
forall (r :: * -> *).
RenderValue r =>
Maybe ClassName -> Maybe Doc -> MixedCall r
S.call Maybe ClassName
forall a. Maybe a
Nothing 
  (Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
o Doc -> Doc -> Doc
<> Doc
dot) ClassName
f VSType r
t [SValue r]
vs NamedArgs r
ns)

-- Functions --

func :: (RenderSym r) => Label -> VSType r -> [SValue r] -> VSFunction r
func :: ClassName -> VSType r -> [SValue r] -> VSFunction r
func l :: ClassName
l t :: VSType r
t vs :: [SValue r]
vs = PosCall r
forall (r :: * -> *). ValueExpression r => PosCall r
funcApp ClassName
l VSType r
t [SValue r]
vs SValue r -> (r (Value r) -> VSFunction r) -> VSFunction r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((Doc -> VSType r -> VSFunction r
forall (r :: * -> *).
RenderFunction r =>
Doc -> VSType r -> VSFunction r
`funcFromData` VSType r
t) (Doc -> VSFunction r)
-> (r (Value r) -> Doc) -> r (Value r) -> VSFunction r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
R.func (Doc -> Doc) -> (r (Value r) -> Doc) -> r (Value r) -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value)

get :: (RenderSym r) => SValue r -> SVariable r -> SValue r
get :: SValue r -> SVariable r -> SValue r
get v :: SValue r
v vToGet :: SVariable r
vToGet = SValue r
v SValue r -> VSFunction r -> SValue r
forall (r :: * -> *).
FunctionSym r =>
SValue r -> VSFunction r -> SValue r
$. SVariable r -> VSFunction r
forall (r :: * -> *).
InternalGetSet r =>
SVariable r -> VSFunction r
S.getFunc SVariable r
vToGet

set :: (RenderSym r) => SValue r -> SVariable r -> SValue r -> SValue r
set :: SValue r -> SVariable r -> SValue r -> SValue r
set v :: SValue r
v vToSet :: SVariable r
vToSet toVal :: SValue r
toVal = SValue r
v SValue r -> VSFunction r -> SValue r
forall (r :: * -> *).
FunctionSym r =>
SValue r -> VSFunction r -> SValue r
$. VSType r -> SVariable r -> SValue r -> VSFunction r
forall (r :: * -> *).
InternalGetSet r =>
VSType r -> SVariable r -> SValue r -> VSFunction r
S.setFunc ((r (Value r) -> r (Type r)) -> SValue r -> VSType r
forall a b s. (a -> b) -> State s a -> State s b
onStateValue r (Value r) -> r (Type r)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType SValue r
v) SVariable r
vToSet SValue r
toVal

listAdd :: (RenderSym r) => SValue r -> SValue r -> SValue r -> SValue r
listAdd :: SValue r -> SValue r -> SValue r -> SValue r
listAdd v :: SValue r
v i :: SValue r
i vToAdd :: SValue r
vToAdd = SValue r
v SValue r -> VSFunction r -> SValue r
forall (r :: * -> *).
FunctionSym r =>
SValue r -> VSFunction r -> SValue r
$. SValue r -> SValue r -> SValue r -> VSFunction r
forall (r :: * -> *).
InternalListFunc r =>
SValue r -> SValue r -> SValue r -> VSFunction r
S.listAddFunc SValue r
v SValue r
i SValue r
vToAdd

listAppend :: (RenderSym r) => SValue r -> SValue r -> SValue r
listAppend :: SValue r -> SValue r -> SValue r
listAppend v :: SValue r
v vToApp :: SValue r
vToApp = SValue r
v SValue r -> VSFunction r -> SValue r
forall (r :: * -> *).
FunctionSym r =>
SValue r -> VSFunction r -> SValue r
$. SValue r -> VSFunction r
forall (r :: * -> *).
InternalListFunc r =>
SValue r -> VSFunction r
S.listAppendFunc SValue r
vToApp

listAccess :: (RenderSym r) => SValue r -> SValue r -> SValue r
listAccess :: SValue r -> SValue r -> SValue r
listAccess v :: SValue r
v i :: SValue r
i = do
  r (Value r)
v' <- SValue r
v
  let checkType :: CodeType -> StateT ValueState Identity (r (Function r))
checkType (List _) = VSType r -> SValue r -> StateT ValueState Identity (r (Function r))
forall (r :: * -> *).
InternalListFunc r =>
VSType r -> SValue r -> VSFunction r
S.listAccessFunc (VSType r -> VSType r
forall (r :: * -> *). TypeSym r => VSType r -> VSType r
S.listInnerType (VSType r -> VSType r) -> VSType r -> VSType r
forall a b. (a -> b) -> a -> b
$ r (Type r) -> VSType r
forall (m :: * -> *) a. Monad m => a -> m a
return (r (Type r) -> VSType r) -> r (Type r) -> VSType r
forall a b. (a -> b) -> a -> b
$ 
        r (Value r) -> r (Type r)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType r (Value r)
v') SValue r
i
      checkType (Array _) = SValue r
i SValue r
-> (r (Value r) -> StateT ValueState Identity (r (Function r)))
-> StateT ValueState Identity (r (Function r))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\ix :: r (Value r)
ix -> Doc -> VSType r -> StateT ValueState Identity (r (Function r))
forall (r :: * -> *).
RenderFunction r =>
Doc -> VSType r -> VSFunction r
funcFromData (Doc -> Doc
brackets (r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
ix)) 
        (VSType r -> VSType r
forall (r :: * -> *). TypeSym r => VSType r -> VSType r
S.listInnerType (VSType r -> VSType r) -> VSType r -> VSType r
forall a b. (a -> b) -> a -> b
$ r (Type r) -> VSType r
forall (m :: * -> *) a. Monad m => a -> m a
return (r (Type r) -> VSType r) -> r (Type r) -> VSType r
forall a b. (a -> b) -> a -> b
$ r (Value r) -> r (Type r)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType r (Value r)
v'))
      checkType _ = ClassName -> StateT ValueState Identity (r (Function r))
forall a. HasCallStack => ClassName -> a
error "listAccess called on non-list-type value"
  SValue r
v SValue r -> StateT ValueState Identity (r (Function r)) -> SValue r
forall (r :: * -> *).
FunctionSym r =>
SValue r -> VSFunction r -> SValue r
$. CodeType -> StateT ValueState Identity (r (Function r))
checkType (r (Type r) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType (r (Value r) -> r (Type r)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType r (Value r)
v'))

listSet :: (RenderSym r) => SValue r -> SValue r -> SValue r -> SValue r
listSet :: SValue r -> SValue r -> SValue r -> SValue r
listSet v :: SValue r
v i :: SValue r
i toVal :: SValue r
toVal = SValue r
v SValue r -> VSFunction r -> SValue r
forall (r :: * -> *).
FunctionSym r =>
SValue r -> VSFunction r -> SValue r
$. SValue r -> SValue r -> SValue r -> VSFunction r
forall (r :: * -> *).
InternalListFunc r =>
SValue r -> SValue r -> SValue r -> VSFunction r
S.listSetFunc SValue r
v SValue r
i SValue r
toVal

getFunc :: (RenderSym r) => SVariable r -> VSFunction r
getFunc :: SVariable r -> VSFunction r
getFunc v :: SVariable r
v = SVariable r
v SVariable r -> (r (Variable r) -> VSFunction r) -> VSFunction r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\vr :: r (Variable r)
vr -> ClassName -> VSType r -> [SValue r] -> VSFunction r
forall (r :: * -> *).
FunctionSym r =>
ClassName -> VSType r -> [SValue r] -> VSFunction r
S.func (ClassName -> ClassName
getterName (ClassName -> ClassName) -> ClassName -> ClassName
forall a b. (a -> b) -> a -> b
$ r (Variable r) -> ClassName
forall (r :: * -> *). VariableElim r => r (Variable r) -> ClassName
variableName r (Variable r)
vr) 
  (r (Type r) -> VSType r
forall a s. a -> State s a
toState (r (Type r) -> VSType r) -> r (Type r) -> VSType r
forall a b. (a -> b) -> a -> b
$ r (Variable r) -> r (Type r)
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType r (Variable r)
vr) [])

setFunc :: (RenderSym r) => VSType r -> SVariable r -> SValue r -> VSFunction r
setFunc :: VSType r -> SVariable r -> SValue r -> VSFunction r
setFunc t :: VSType r
t v :: SVariable r
v toVal :: SValue r
toVal = SVariable r
v SVariable r -> (r (Variable r) -> VSFunction r) -> VSFunction r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\vr :: r (Variable r)
vr -> ClassName -> VSType r -> [SValue r] -> VSFunction r
forall (r :: * -> *).
FunctionSym r =>
ClassName -> VSType r -> [SValue r] -> VSFunction r
S.func (ClassName -> ClassName
setterName (ClassName -> ClassName) -> ClassName -> ClassName
forall a b. (a -> b) -> a -> b
$ r (Variable r) -> ClassName
forall (r :: * -> *). VariableElim r => r (Variable r) -> ClassName
variableName r (Variable r)
vr) VSType r
t 
  [SValue r
toVal])

listAppendFunc :: (RenderSym r) => Label -> SValue r -> VSFunction r
listAppendFunc :: ClassName -> SValue r -> VSFunction r
listAppendFunc f :: ClassName
f v :: SValue r
v = ClassName -> VSType r -> [SValue r] -> VSFunction r
forall (r :: * -> *).
FunctionSym r =>
ClassName -> VSType r -> [SValue r] -> VSFunction r
S.func ClassName
f (VSType r -> VSType r
forall (r :: * -> *). TypeSym r => VSType r -> VSType r
S.listType (VSType r -> VSType r) -> VSType r -> VSType r
forall a b. (a -> b) -> a -> b
$ (r (Value r) -> r (Type r)) -> SValue r -> VSType r
forall a b s. (a -> b) -> State s a -> State s b
onStateValue r (Value r) -> r (Type r)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType SValue r
v) [SValue r
v]

-- Statements --

stmt :: (RenderSym r) => MSStatement r -> MSStatement r
stmt :: MSStatement r -> MSStatement r
stmt s' :: MSStatement r
s' = do 
  r (Statement r)
s <- MSStatement r
s'
  Doc -> MSStatement r
forall (r :: * -> *). RenderSym r => Doc -> MSStatement r
mkStmtNoEnd (r (Statement r) -> Doc
forall (r :: * -> *). StatementElim r => r (Statement r) -> Doc
RC.statement r (Statement r)
s Doc -> Doc -> Doc
<> Terminator -> Doc
R.getTerm (r (Statement r) -> Terminator
forall (r :: * -> *).
StatementElim r =>
r (Statement r) -> Terminator
statementTerm r (Statement r)
s))

loopStmt :: (RenderSym r) => MSStatement r -> MSStatement r
loopStmt :: MSStatement r -> MSStatement r
loopStmt = MSStatement r -> MSStatement r
forall (r :: * -> *).
RenderStatement r =>
MSStatement r -> MSStatement r
S.stmt (MSStatement r -> MSStatement r)
-> (MSStatement r -> MSStatement r)
-> MSStatement r
-> MSStatement r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MSStatement r -> MSStatement r
forall (r :: * -> *). RenderSym r => MSStatement r -> MSStatement r
setEmpty

emptyStmt :: (RenderSym r) => MSStatement r
emptyStmt :: MSStatement r
emptyStmt = Doc -> MSStatement r
forall (r :: * -> *). RenderSym r => Doc -> MSStatement r
mkStmtNoEnd Doc
empty

assign :: (RenderSym r) => Terminator -> SVariable r -> SValue r -> 
  MSStatement r
assign :: Terminator -> SVariable r -> SValue r -> MSStatement r
assign t :: Terminator
t vr' :: SVariable r
vr' v' :: SValue r
v' = do 
  r (Variable r)
vr <- LensLike'
  (Zoomed (StateT ValueState Identity) (r (Variable r)))
  MethodState
  ValueState
-> SVariable r -> StateT MethodState Identity (r (Variable r))
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 r)))
  MethodState
  ValueState
Lens' MethodState ValueState
lensMStoVS SVariable r
vr'
  r (Value r)
v <- LensLike'
  (Zoomed (StateT ValueState Identity) (r (Value r)))
  MethodState
  ValueState
-> SValue r -> StateT MethodState Identity (r (Value r))
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 r)))
  MethodState
  ValueState
Lens' MethodState ValueState
lensMStoVS SValue r
v'
  Doc -> Terminator -> MSStatement r
forall (r :: * -> *).
RenderStatement r =>
Doc -> Terminator -> MSStatement r
stmtFromData (r (Variable r) -> r (Value r) -> Doc
forall (r :: * -> *).
RenderSym r =>
r (Variable r) -> r (Value r) -> Doc
R.assign r (Variable r)
vr r (Value r)
v) Terminator
t

subAssign :: (RenderSym r) => Terminator -> SVariable r -> SValue r -> 
  MSStatement r
subAssign :: Terminator -> SVariable r -> SValue r -> MSStatement r
subAssign t :: Terminator
t vr' :: SVariable r
vr' v' :: SValue r
v' = do 
  r (Variable r)
vr <- LensLike'
  (Zoomed (StateT ValueState Identity) (r (Variable r)))
  MethodState
  ValueState
-> SVariable r -> StateT MethodState Identity (r (Variable r))
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 r)))
  MethodState
  ValueState
Lens' MethodState ValueState
lensMStoVS SVariable r
vr'
  r (Value r)
v <- LensLike'
  (Zoomed (StateT ValueState Identity) (r (Value r)))
  MethodState
  ValueState
-> SValue r -> StateT MethodState Identity (r (Value r))
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 r)))
  MethodState
  ValueState
Lens' MethodState ValueState
lensMStoVS SValue r
v'
  Doc -> Terminator -> MSStatement r
forall (r :: * -> *).
RenderStatement r =>
Doc -> Terminator -> MSStatement r
stmtFromData (r (Variable r) -> r (Value r) -> Doc
forall (r :: * -> *).
RenderSym r =>
r (Variable r) -> r (Value r) -> Doc
R.subAssign r (Variable r)
vr r (Value r)
v) Terminator
t

increment :: (RenderSym r) => SVariable r -> SValue r -> MSStatement r
increment :: SVariable r -> SValue r -> MSStatement r
increment vr' :: SVariable r
vr' v' :: SValue r
v'= do 
  r (Variable r)
vr <- LensLike'
  (Zoomed (StateT ValueState Identity) (r (Variable r)))
  MethodState
  ValueState
-> SVariable r -> StateT MethodState Identity (r (Variable r))
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 r)))
  MethodState
  ValueState
Lens' MethodState ValueState
lensMStoVS SVariable r
vr'
  r (Value r)
v <- LensLike'
  (Zoomed (StateT ValueState Identity) (r (Value r)))
  MethodState
  ValueState
-> SValue r -> StateT MethodState Identity (r (Value r))
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 r)))
  MethodState
  ValueState
Lens' MethodState ValueState
lensMStoVS SValue r
v'
  Doc -> MSStatement r
forall (r :: * -> *). RenderSym r => Doc -> MSStatement r
mkStmt (Doc -> MSStatement r) -> Doc -> MSStatement r
forall a b. (a -> b) -> a -> b
$ r (Variable r) -> r (Value r) -> Doc
forall (r :: * -> *).
RenderSym r =>
r (Variable r) -> r (Value r) -> Doc
R.addAssign r (Variable r)
vr r (Value r)
v

objDecNew :: (RenderSym r) => SVariable r -> [SValue r] -> MSStatement r
objDecNew :: SVariable r -> [SValue r] -> MSStatement r
objDecNew v :: SVariable r
v vs :: [SValue r]
vs = SVariable r -> SValue r -> MSStatement r
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> SValue r -> MSStatement r
S.varDecDef SVariable r
v (PosCtorCall r
forall (r :: * -> *). ValueExpression r => PosCtorCall r
newObj ((r (Variable r) -> r (Type r))
-> SVariable r -> State ValueState (r (Type r))
forall a b s. (a -> b) -> State s a -> State s b
onStateValue r (Variable r) -> r (Type r)
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType SVariable r
v) [SValue r]
vs)

printList :: (RenderSym r) => Integer -> SValue r -> (SValue r -> MSStatement r)
  -> (String -> MSStatement r) -> (String -> MSStatement r) -> MSStatement r
printList :: Integer
-> SValue r
-> (SValue r -> MSStatement r)
-> (ClassName -> MSStatement r)
-> (ClassName -> MSStatement r)
-> MSStatement r
printList n :: Integer
n v :: SValue r
v prFn :: SValue r -> MSStatement r
prFn prStrFn :: ClassName -> MSStatement r
prStrFn prLnFn :: ClassName -> MSStatement r
prLnFn = [MSStatement r] -> MSStatement r
forall (r :: * -> *).
StatementSym r =>
[MSStatement r] -> MSStatement r
multi [ClassName -> MSStatement r
prStrFn "[", 
  MSStatement r
-> SValue r -> MSStatement r -> MSBody r -> MSStatement r
forall (r :: * -> *).
ControlStatement r =>
MSStatement r
-> SValue r -> MSStatement r -> MSBody r -> MSStatement r
S.for (SVariable r -> SValue r -> MSStatement r
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> SValue r -> MSStatement r
S.varDecDef SVariable r
i (Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
S.litInt 0)) 
    (SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
S.valueOf SVariable r
i SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
?< (SValue r -> SValue r
forall (r :: * -> *). List r => SValue r -> SValue r
S.listSize SValue r
v SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
#- Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
S.litInt 1)) (SVariable r
i SVariable r -> MSStatement r
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> MSStatement r
&++) 
    ([MSStatement r] -> MSBody r
forall (r :: * -> *). BodySym r => [MSStatement r] -> MSBody r
bodyStatements [SValue r -> MSStatement r
prFn (SValue r -> SValue r -> SValue r
forall (r :: * -> *). List r => SValue r -> SValue r -> SValue r
S.listAccess SValue r
v (SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
S.valueOf SVariable r
i)), ClassName -> MSStatement r
prStrFn ", "]), 
  [(SValue r, MSBody r)] -> MSStatement r
forall (r :: * -> *).
ControlStatement r =>
[(SValue r, MSBody r)] -> MSStatement r
ifNoElse [(SValue r -> SValue r
forall (r :: * -> *). List r => SValue r -> SValue r
S.listSize SValue r
v SValue r -> SValue r -> SValue r
forall (r :: * -> *).
Comparison r =>
SValue r -> SValue r -> SValue r
?> Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
S.litInt 0, MSStatement r -> MSBody r
forall (r :: * -> *). BodySym r => MSStatement r -> MSBody r
oneLiner (MSStatement r -> MSBody r) -> MSStatement r -> MSBody r
forall a b. (a -> b) -> a -> b
$
    SValue r -> MSStatement r
prFn (SValue r -> SValue r -> SValue r
forall (r :: * -> *). List r => SValue r -> SValue r -> SValue r
S.listAccess SValue r
v (SValue r -> SValue r
forall (r :: * -> *). List r => SValue r -> SValue r
S.listSize SValue r
v SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
#- Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
S.litInt 1)))], 
  ClassName -> MSStatement r
prLnFn "]"]
  where l_i :: ClassName
l_i = "list_i" ClassName -> ClassName -> ClassName
forall a. [a] -> [a] -> [a]
++ Integer -> ClassName
forall a. Show a => a -> ClassName
show Integer
n
        i :: SVariable r
i = ClassName -> VSType r -> SVariable r
forall (r :: * -> *).
VariableSym r =>
ClassName -> VSType r -> SVariable r
S.var ClassName
l_i VSType r
forall (r :: * -> *). TypeSym r => VSType r
S.int

printObj :: ClassName -> (String -> MSStatement r) -> MSStatement r
printObj :: ClassName -> (ClassName -> MSStatement r) -> MSStatement r
printObj n :: ClassName
n prLnFn :: ClassName -> MSStatement r
prLnFn = ClassName -> MSStatement r
prLnFn (ClassName -> MSStatement r) -> ClassName -> MSStatement r
forall a b. (a -> b) -> a -> b
$ "Instance of " ClassName -> ClassName -> ClassName
forall a. [a] -> [a] -> [a]
++ ClassName
n ClassName -> ClassName -> ClassName
forall a. [a] -> [a] -> [a]
++ " object"

print :: (RenderSym r) => Bool -> Maybe (SValue r) -> SValue r -> SValue r -> 
  MSStatement r
print :: Bool -> Maybe (SValue r) -> SValue r -> SValue r -> MSStatement r
print newLn :: Bool
newLn f :: Maybe (SValue r)
f printFn :: SValue r
printFn v :: SValue r
v = LensLike'
  (Zoomed (StateT ValueState Identity) (r (Value r)))
  MethodState
  ValueState
-> SValue r -> StateT MethodState Identity (r (Value r))
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 r)))
  MethodState
  ValueState
Lens' MethodState ValueState
lensMStoVS SValue r
v StateT MethodState Identity (r (Value r))
-> (r (Value r) -> MSStatement r) -> MSStatement r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CodeType -> MSStatement r
print' (CodeType -> MSStatement r)
-> (r (Value r) -> CodeType) -> r (Value r) -> MSStatement r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r (Type r) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType (r (Type r) -> CodeType)
-> (r (Value r) -> r (Type r)) -> r (Value r) -> CodeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r (Value r) -> r (Type r)
forall (r :: * -> *). ValueSym r => r (Value r) -> r (Type r)
valueType
  where print' :: CodeType -> MSStatement r
print' (List t :: CodeType
t) = Integer
-> SValue r
-> (SValue r -> MSStatement r)
-> (ClassName -> MSStatement r)
-> (ClassName -> MSStatement r)
-> MSStatement r
forall (r :: * -> *).
RenderSym r =>
Integer
-> SValue r
-> (SValue r -> MSStatement r)
-> (ClassName -> MSStatement r)
-> (ClassName -> MSStatement r)
-> MSStatement r
printList (Integer -> CodeType -> Integer
getNestDegree 1 CodeType
t) SValue r
v SValue r -> MSStatement r
prFn ClassName -> MSStatement r
prStrFn 
          ClassName -> MSStatement r
prLnFn
        print' (Object n :: ClassName
n) = ClassName -> (ClassName -> MSStatement r) -> MSStatement r
forall (r :: * -> *).
ClassName -> (ClassName -> MSStatement r) -> MSStatement r
printObj ClassName
n ClassName -> MSStatement r
prLnFn
        print' _ = Bool -> Maybe (SValue r) -> SValue r -> SValue r -> MSStatement r
forall (r :: * -> *).
InternalIOStmt r =>
Bool -> Maybe (SValue r) -> SValue r -> SValue r -> MSStatement r
S.printSt Bool
newLn Maybe (SValue r)
f SValue r
printFn SValue r
v
        prFn :: SValue r -> MSStatement r
prFn = (SValue r -> MSStatement r)
-> (SValue r -> SValue r -> MSStatement r)
-> Maybe (SValue r)
-> SValue r
-> MSStatement r
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SValue r -> MSStatement r
forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
S.print SValue r -> SValue r -> MSStatement r
forall (r :: * -> *).
IOStatement r =>
SValue r -> SValue r -> MSStatement r
printFile Maybe (SValue r)
f
        prStrFn :: ClassName -> MSStatement r
prStrFn = (ClassName -> MSStatement r)
-> (SValue r -> ClassName -> MSStatement r)
-> Maybe (SValue r)
-> ClassName
-> MSStatement r
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ClassName -> MSStatement r
forall (r :: * -> *). IOStatement r => ClassName -> MSStatement r
printStr SValue r -> ClassName -> MSStatement r
forall (r :: * -> *).
IOStatement r =>
SValue r -> ClassName -> MSStatement r
printFileStr Maybe (SValue r)
f
        prLnFn :: ClassName -> MSStatement r
prLnFn = if Bool
newLn then (ClassName -> MSStatement r)
-> (SValue r -> ClassName -> MSStatement r)
-> Maybe (SValue r)
-> ClassName
-> MSStatement r
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ClassName -> MSStatement r
forall (r :: * -> *). IOStatement r => ClassName -> MSStatement r
printStrLn SValue r -> ClassName -> MSStatement r
forall (r :: * -> *).
IOStatement r =>
SValue r -> ClassName -> MSStatement r
printFileStrLn Maybe (SValue r)
f else (ClassName -> MSStatement r)
-> (SValue r -> ClassName -> MSStatement r)
-> Maybe (SValue r)
-> ClassName
-> MSStatement r
forall b a. b -> (a -> b) -> Maybe a -> b
maybe 
          ClassName -> MSStatement r
forall (r :: * -> *). IOStatement r => ClassName -> MSStatement r
printStr SValue r -> ClassName -> MSStatement r
forall (r :: * -> *).
IOStatement r =>
SValue r -> ClassName -> MSStatement r
printFileStr Maybe (SValue r)
f 

closeFile :: (RenderSym r) => Label -> SValue r -> MSStatement r
closeFile :: ClassName -> SValue r -> MSStatement r
closeFile n :: ClassName
n f :: SValue r
f = SValue r -> MSStatement r
forall (r :: * -> *). StatementSym r => SValue r -> MSStatement r
S.valStmt (SValue r -> MSStatement r) -> SValue r -> MSStatement r
forall a b. (a -> b) -> a -> b
$ VSType r -> SValue r -> ClassName -> SValue r
forall (r :: * -> *).
InternalValueExp r =>
VSType r -> SValue r -> ClassName -> SValue r
objMethodCallNoParams VSType r
forall (r :: * -> *). TypeSym r => VSType r
S.void SValue r
f ClassName
n

returnStmt :: (RenderSym r) => Terminator -> SValue r -> MSStatement r
returnStmt :: Terminator -> SValue r -> MSStatement r
returnStmt t :: Terminator
t v' :: SValue r
v' = do 
  r (Value r)
v <- LensLike'
  (Zoomed (StateT ValueState Identity) (r (Value r)))
  MethodState
  ValueState
-> SValue r -> StateT MethodState Identity (r (Value r))
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 r)))
  MethodState
  ValueState
Lens' MethodState ValueState
lensMStoVS SValue r
v'
  Doc -> Terminator -> MSStatement r
forall (r :: * -> *).
RenderStatement r =>
Doc -> Terminator -> MSStatement r
stmtFromData ([r (Value r)] -> Doc
forall (r :: * -> *). RenderSym r => [r (Value r)] -> Doc
R.return' [r (Value r)
v]) Terminator
t

valStmt :: (RenderSym r) => Terminator -> SValue r -> MSStatement r
valStmt :: Terminator -> SValue r -> MSStatement r
valStmt t :: Terminator
t v' :: SValue r
v' = do 
  r (Value r)
v <- LensLike'
  (Zoomed (StateT ValueState Identity) (r (Value r)))
  MethodState
  ValueState
-> SValue r -> StateT MethodState Identity (r (Value r))
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 r)))
  MethodState
  ValueState
Lens' MethodState ValueState
lensMStoVS SValue r
v'
  Doc -> Terminator -> MSStatement r
forall (r :: * -> *).
RenderStatement r =>
Doc -> Terminator -> MSStatement r
stmtFromData (r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
v) Terminator
t

comment :: (RenderSym r) => Doc -> Label -> MSStatement r
comment :: Doc -> ClassName -> MSStatement r
comment cs :: Doc
cs c :: ClassName
c = Doc -> MSStatement r
forall (r :: * -> *). RenderSym r => Doc -> MSStatement r
mkStmtNoEnd (ClassName -> Doc -> Doc
R.comment ClassName
c Doc
cs)

throw :: (RenderSym r) => (r (Value r) -> Doc) -> Terminator -> Label -> 
  MSStatement r
throw :: (r (Value r) -> Doc) -> Terminator -> ClassName -> MSStatement r
throw f :: r (Value r) -> Doc
f t :: Terminator
t l :: ClassName
l = do 
  r (Value r)
msg <- LensLike'
  (Zoomed (StateT ValueState Identity) (r (Value r)))
  MethodState
  ValueState
-> StateT ValueState Identity (r (Value r))
-> StateT MethodState Identity (r (Value r))
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 r)))
  MethodState
  ValueState
Lens' MethodState ValueState
lensMStoVS (ClassName -> StateT ValueState Identity (r (Value r))
forall (r :: * -> *). Literal r => ClassName -> SValue r
S.litString ClassName
l)
  Doc -> Terminator -> MSStatement r
forall (r :: * -> *).
RenderStatement r =>
Doc -> Terminator -> MSStatement r
stmtFromData (r (Value r) -> Doc
f r (Value r)
msg) Terminator
t

-- ControlStatements --

-- 1st parameter is a Doc function to use on the render of each condition (i.e. parens)
-- 2nd parameter is the syntax for starting a block in an if-condition
-- 3rd parameter is the keyword for an else-if statement
-- 4th parameter is the syntax for ending a block in an if-condition
ifCond :: (RenderSym r) => (Doc -> Doc) -> Doc -> Doc -> Doc -> 
  [(SValue r, MSBody r)] -> MSBody r -> MSStatement r
ifCond :: (Doc -> Doc)
-> Doc
-> Doc
-> Doc
-> [(SValue r, MSBody r)]
-> MSBody r
-> MSStatement r
ifCond _ _ _ _ [] _ = ClassName -> MSStatement r
forall a. HasCallStack => ClassName -> a
error "if condition created with no cases"
ifCond f :: Doc -> Doc
f ifStart :: Doc
ifStart elif :: Doc
elif bEnd :: Doc
bEnd (c :: (SValue r, MSBody r)
c:cs :: [(SValue r, MSBody r)]
cs) eBody :: MSBody r
eBody =
    let ifSect :: (StateT ValueState Identity (r (Value r)),
 State MethodState (r (Body r)))
-> State MethodState Doc
ifSect (v :: StateT ValueState Identity (r (Value r))
v, b :: State MethodState (r (Body r))
b) = (r (Value r) -> r (Body r) -> Doc)
-> State MethodState (r (Value r))
-> State MethodState (r (Body r))
-> State MethodState Doc
forall a b c s.
(a -> b -> c) -> State s a -> State s b -> State s c
on2StateValues (\val :: r (Value r)
val bd :: r (Body r)
bd -> [Doc] -> Doc
vcat [
          Doc
ifLabel Doc -> Doc -> Doc
<+> Doc -> Doc
f (r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
val) Doc -> Doc -> Doc
<+> Doc
ifStart,
          Doc -> Doc
indent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ r (Body r) -> Doc
forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body r (Body r)
bd,
          Doc
bEnd]) (LensLike'
  (Zoomed (StateT ValueState Identity) (r (Value r)))
  MethodState
  ValueState
-> StateT ValueState Identity (r (Value r))
-> State MethodState (r (Value r))
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 r)))
  MethodState
  ValueState
Lens' MethodState ValueState
lensMStoVS StateT ValueState Identity (r (Value r))
v) State MethodState (r (Body r))
b
        elseIfSect :: (StateT ValueState Identity (r (Value r)),
 State MethodState (r (Body r)))
-> State MethodState Doc
elseIfSect (v :: StateT ValueState Identity (r (Value r))
v, b :: State MethodState (r (Body r))
b) = (r (Value r) -> r (Body r) -> Doc)
-> State MethodState (r (Value r))
-> State MethodState (r (Body r))
-> State MethodState Doc
forall a b c s.
(a -> b -> c) -> State s a -> State s b -> State s c
on2StateValues (\val :: r (Value r)
val bd :: r (Body r)
bd -> [Doc] -> Doc
vcat [
          Doc
elif Doc -> Doc -> Doc
<+> Doc -> Doc
f (r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
val) Doc -> Doc -> Doc
<+> Doc
ifStart,
          Doc -> Doc
indent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ r (Body r) -> Doc
forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body r (Body r)
bd,
          Doc
bEnd]) (LensLike'
  (Zoomed (StateT ValueState Identity) (r (Value r)))
  MethodState
  ValueState
-> StateT ValueState Identity (r (Value r))
-> State MethodState (r (Value r))
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 r)))
  MethodState
  ValueState
Lens' MethodState ValueState
lensMStoVS StateT ValueState Identity (r (Value r))
v) State MethodState (r (Body r))
b
        elseSect :: State MethodState Doc
elseSect = (r (Body r) -> Doc) -> MSBody r -> State MethodState Doc
forall a b s. (a -> b) -> State s a -> State s b
onStateValue (\bd :: r (Body r)
bd -> Doc -> Doc -> Doc
emptyIfEmpty (r (Body r) -> Doc
forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body r (Body r)
bd) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat [
          Doc
elseLabel Doc -> Doc -> Doc
<+> Doc
ifStart,
          Doc -> Doc
indent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ r (Body r) -> Doc
forall (r :: * -> *). BodyElim r => r (Body r) -> Doc
RC.body r (Body r)
bd,
          Doc
bEnd]) MSBody r
eBody
    in [State MethodState Doc] -> StateT MethodState Identity [Doc]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ((SValue r, MSBody r) -> State MethodState Doc
forall (r :: * -> *) (r :: * -> *).
(BodyElim r, ValueElim r) =>
(StateT ValueState Identity (r (Value r)),
 State MethodState (r (Body r)))
-> State MethodState Doc
ifSect (SValue r, MSBody r)
c State MethodState Doc
-> [State MethodState Doc] -> [State MethodState Doc]
forall a. a -> [a] -> [a]
: ((SValue r, MSBody r) -> State MethodState Doc)
-> [(SValue r, MSBody r)] -> [State MethodState Doc]
forall a b. (a -> b) -> [a] -> [b]
map (SValue r, MSBody r) -> State MethodState Doc
forall (r :: * -> *) (r :: * -> *).
(BodyElim r, ValueElim r) =>
(StateT ValueState Identity (r (Value r)),
 State MethodState (r (Body r)))
-> State MethodState Doc
elseIfSect [(SValue r, MSBody r)]
cs [State MethodState Doc]
-> [State MethodState Doc] -> [State MethodState Doc]
forall a. [a] -> [a] -> [a]
++ [State MethodState Doc
elseSect]) 
      StateT MethodState Identity [Doc]
-> ([Doc] -> MSStatement r) -> MSStatement r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Doc -> MSStatement r
forall (r :: * -> *). RenderSym r => Doc -> MSStatement r
mkStmtNoEnd (Doc -> MSStatement r) -> ([Doc] -> Doc) -> [Doc] -> MSStatement r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
vcat)

tryCatch :: (RenderSym r) => (r (Body r) -> r (Body r) -> Doc) -> MSBody r -> 
  MSBody r -> MSStatement r
tryCatch :: (r (Body r) -> r (Body r) -> Doc)
-> MSBody r -> MSBody r -> MSStatement r
tryCatch f :: r (Body r) -> r (Body r) -> Doc
f = (r (Body r) -> r (Body r) -> MSStatement r)
-> MSBody r -> MSBody r -> MSStatement r
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> m a -> m b -> m c
on2StateWrapped (\tb1 :: r (Body r)
tb1 tb2 :: r (Body r)
tb2 -> Doc -> MSStatement r
forall (r :: * -> *). RenderSym r => Doc -> MSStatement r
mkStmtNoEnd (r (Body r) -> r (Body r) -> Doc
f r (Body r)
tb1 r (Body r)
tb2))

-- Methods --

construct :: (RenderSym r) => Label -> MS (r (Type r))
construct :: ClassName -> MS (r (Type r))
construct n :: ClassName
n = LensLike'
  (Zoomed (StateT ValueState Identity) (r (Type r)))
  MethodState
  ValueState
-> StateT ValueState Identity (r (Type r)) -> MS (r (Type r))
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 (Type r)))
  MethodState
  ValueState
Lens' MethodState ValueState
lensMStoVS (StateT ValueState Identity (r (Type r)) -> MS (r (Type r)))
-> StateT ValueState Identity (r (Type r)) -> MS (r (Type r))
forall a b. (a -> b) -> a -> b
$ CodeType
-> ClassName -> Doc -> StateT ValueState Identity (r (Type r))
forall (r :: * -> *).
RenderType r =>
CodeType -> ClassName -> Doc -> VSType r
typeFromData (ClassName -> CodeType
Object ClassName
n) ClassName
n Doc
empty

param :: (RenderSym r) => (r (Variable r) -> Doc) -> SVariable r -> 
  MSParameter r
param :: (r (Variable r) -> Doc) -> SVariable r -> MSParameter r
param f :: r (Variable r) -> Doc
f v' :: SVariable r
v' = StateT MethodState Identity (MSParameter r) -> MSParameter r
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (StateT MethodState Identity (MSParameter r) -> MSParameter r)
-> StateT MethodState Identity (MSParameter r) -> MSParameter r
forall a b. (a -> b) -> a -> b
$ (r (Variable r) -> MethodState -> MethodState)
-> (r (Variable r) -> MSParameter r)
-> State MethodState (r (Variable r))
-> StateT MethodState Identity (MSParameter r)
forall b s a. (b -> s -> s) -> (b -> a) -> State s b -> State s a
modifyReturnFunc (ClassName -> MethodState -> MethodState
addParameter (ClassName -> MethodState -> MethodState)
-> (r (Variable r) -> ClassName)
-> r (Variable r)
-> MethodState
-> MethodState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r (Variable r) -> ClassName
forall (r :: * -> *). VariableElim r => r (Variable r) -> ClassName
variableName) 
  (SVariable r -> Doc -> MSParameter r
forall (r :: * -> *).
RenderParam r =>
SVariable r -> Doc -> MSParameter r
paramFromData SVariable r
v' (Doc -> MSParameter r)
-> (r (Variable r) -> Doc) -> r (Variable r) -> MSParameter r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r (Variable r) -> Doc
f) (LensLike'
  (Zoomed (StateT ValueState Identity) (r (Variable r)))
  MethodState
  ValueState
-> SVariable r -> State MethodState (r (Variable r))
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 r)))
  MethodState
  ValueState
Lens' MethodState ValueState
lensMStoVS SVariable r
v')

method :: (RenderSym r) => Label -> r (Scope r) -> r (Permanence r) -> VSType r 
  -> [MSParameter r] -> MSBody r -> SMethod r
method :: ClassName
-> r (Scope r)
-> r (Permanence r)
-> VSType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
method n :: ClassName
n s :: r (Scope r)
s p :: r (Permanence r)
p t :: VSType r
t = Bool
-> ClassName
-> r (Scope r)
-> r (Permanence r)
-> MSMthdType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
forall (r :: * -> *).
RenderMethod r =>
Bool
-> ClassName
-> r (Scope r)
-> r (Permanence r)
-> MSMthdType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
intMethod Bool
False ClassName
n r (Scope r)
s r (Permanence r)
p (VSType r -> MSMthdType r
forall (r :: * -> *). MethodTypeSym r => VSType r -> MSMthdType r
mType VSType r
t)

getMethod :: (RenderSym r) => SVariable r -> SMethod r
getMethod :: SVariable r -> SMethod r
getMethod v :: SVariable r
v = LensLike'
  (Zoomed (StateT ValueState Identity) (r (Variable r)))
  MethodState
  ValueState
-> SVariable r -> StateT MethodState Identity (r (Variable r))
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 r)))
  MethodState
  ValueState
Lens' MethodState ValueState
lensMStoVS SVariable r
v StateT MethodState Identity (r (Variable r))
-> (r (Variable r) -> SMethod r) -> SMethod r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\vr :: r (Variable r)
vr -> ClassName
-> r (Scope r)
-> r (Permanence r)
-> VSType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
forall (r :: * -> *).
MethodSym r =>
ClassName
-> r (Scope r)
-> r (Permanence r)
-> VSType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
S.method (ClassName -> ClassName
getterName (ClassName -> ClassName) -> ClassName -> ClassName
forall a b. (a -> b) -> a -> b
$ r (Variable r) -> ClassName
forall (r :: * -> *). VariableElim r => r (Variable r) -> ClassName
variableName 
  r (Variable r)
vr) r (Scope r)
forall (r :: * -> *). ScopeSym r => r (Scope r)
public r (Permanence r)
forall (r :: * -> *). PermanenceSym r => r (Permanence r)
dynamic (r (Type r) -> VSType r
forall a s. a -> State s a
toState (r (Type r) -> VSType r) -> r (Type r) -> VSType r
forall a b. (a -> b) -> a -> b
$ r (Variable r) -> r (Type r)
forall (r :: * -> *).
VariableElim r =>
r (Variable r) -> r (Type r)
variableType r (Variable r)
vr) [] MSBody r
getBody)
  where getBody :: MSBody r
getBody = MSStatement r -> MSBody r
forall (r :: * -> *). BodySym r => MSStatement r -> MSBody r
oneLiner (MSStatement r -> MSBody r) -> MSStatement r -> MSBody r
forall a b. (a -> b) -> a -> b
$ SValue r -> MSStatement r
forall (r :: * -> *).
ControlStatement r =>
SValue r -> MSStatement r
S.returnStmt (SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
S.valueOf (SVariable r -> SValue r) -> SVariable r -> SValue r
forall a b. (a -> b) -> a -> b
$ SVariable r -> SVariable r
forall (r :: * -> *). VariableSym r => SVariable r -> SVariable r
S.objVarSelf SVariable r
v)

setMethod :: (RenderSym r) => SVariable r -> SMethod r
setMethod :: SVariable r -> SMethod r
setMethod v :: SVariable r
v = LensLike'
  (Zoomed (StateT ValueState Identity) (r (Variable r)))
  MethodState
  ValueState
-> SVariable r -> StateT MethodState Identity (r (Variable r))
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 r)))
  MethodState
  ValueState
Lens' MethodState ValueState
lensMStoVS SVariable r
v StateT MethodState Identity (r (Variable r))
-> (r (Variable r) -> SMethod r) -> SMethod r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\vr :: r (Variable r)
vr -> ClassName
-> r (Scope r)
-> r (Permanence r)
-> VSType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
forall (r :: * -> *).
MethodSym r =>
ClassName
-> r (Scope r)
-> r (Permanence r)
-> VSType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
S.method (ClassName -> ClassName
setterName (ClassName -> ClassName) -> ClassName -> ClassName
forall a b. (a -> b) -> a -> b
$ r (Variable r) -> ClassName
forall (r :: * -> *). VariableElim r => r (Variable r) -> ClassName
variableName 
  r (Variable r)
vr) r (Scope r)
forall (r :: * -> *). ScopeSym r => r (Scope r)
public r (Permanence r)
forall (r :: * -> *). PermanenceSym r => r (Permanence r)
dynamic VSType r
forall (r :: * -> *). TypeSym r => VSType r
S.void [SVariable r -> MSParameter r
forall (r :: * -> *).
ParameterSym r =>
SVariable r -> MSParameter r
S.param SVariable r
v] MSBody r
setBody)
  where setBody :: MSBody r
setBody = MSStatement r -> MSBody r
forall (r :: * -> *). BodySym r => MSStatement r -> MSBody r
oneLiner (MSStatement r -> MSBody r) -> MSStatement r -> MSBody r
forall a b. (a -> b) -> a -> b
$ SVariable r -> SVariable r
forall (r :: * -> *). VariableSym r => SVariable r -> SVariable r
S.objVarSelf SVariable r
v SVariable r -> SValue r -> MSStatement r
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
S.valueOf SVariable r
v

initStmts :: (RenderSym r) => Initializers r -> MSBody r
initStmts :: Initializers r -> MSBody r
initStmts = [MSStatement r] -> MSBody r
forall (r :: * -> *). BodySym r => [MSStatement r] -> MSBody r
bodyStatements ([MSStatement r] -> MSBody r)
-> (Initializers r -> [MSStatement r])
-> Initializers r
-> MSBody r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((VS (r (Variable r)), VS (r (Value r))) -> MSStatement r)
-> Initializers r -> [MSStatement r]
forall a b. (a -> b) -> [a] -> [b]
map (\(vr :: VS (r (Variable r))
vr, vl :: VS (r (Value r))
vl) -> VS (r (Variable r)) -> VS (r (Variable r))
forall (r :: * -> *). VariableSym r => SVariable r -> SVariable r
S.objVarSelf VS (r (Variable r))
vr VS (r (Variable r)) -> VS (r (Value r)) -> MSStatement r
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
&= VS (r (Value r))
vl)

function :: (RenderSym r) => Label -> r (Scope r) -> VSType r -> 
  [MSParameter r] -> MSBody r -> SMethod r
function :: ClassName
-> r (Scope r)
-> VSType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
function n :: ClassName
n s :: r (Scope r)
s t :: VSType r
t = Bool
-> ClassName
-> r (Scope r)
-> r (Permanence r)
-> MSMthdType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
forall (r :: * -> *).
RenderMethod r =>
Bool
-> ClassName
-> r (Scope r)
-> r (Permanence r)
-> MSMthdType r
-> [MSParameter r]
-> MSBody r
-> SMethod r
S.intFunc Bool
False ClassName
n r (Scope r)
s r (Permanence r)
forall (r :: * -> *). PermanenceSym r => r (Permanence r)
static (VSType r -> MSMthdType r
forall (r :: * -> *). MethodTypeSym r => VSType r -> MSMthdType r
mType VSType r
t)
  
docFuncRepr :: (RenderSym r) => FuncDocRenderer -> String -> [String] -> 
  [String] -> SMethod r -> SMethod r
docFuncRepr :: FuncDocRenderer
-> ClassName
-> [ClassName]
-> [ClassName]
-> SMethod r
-> SMethod r
docFuncRepr f :: FuncDocRenderer
f desc :: ClassName
desc pComms :: [ClassName]
pComms rComms :: [ClassName]
rComms = MS (r (BlockComment r)) -> SMethod r -> SMethod r
forall (r :: * -> *).
RenderMethod r =>
MS (r (BlockComment r)) -> SMethod r -> SMethod r
commentedFunc (State MethodState [ClassName] -> MS (r (BlockComment r))
forall (r :: * -> *) a.
BlockCommentSym r =>
State a [ClassName] -> State a (r (BlockComment r))
docComment (State MethodState [ClassName] -> MS (r (BlockComment r)))
-> State MethodState [ClassName] -> MS (r (BlockComment r))
forall a b. (a -> b) -> a -> b
$ ([ClassName] -> [ClassName])
-> State MethodState [ClassName] -> State MethodState [ClassName]
forall a b s. (a -> b) -> State s a -> State s b
onStateValue 
  (\ps :: [ClassName]
ps -> FuncDocRenderer
f ClassName
desc ([ClassName] -> [ClassName] -> [(ClassName, ClassName)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ClassName]
ps [ClassName]
pComms) [ClassName]
rComms) State MethodState [ClassName]
getParameters)

docFunc :: (RenderSym r) => FuncDocRenderer -> String -> [String] -> 
  Maybe String -> SMethod r -> SMethod r
docFunc :: FuncDocRenderer
-> ClassName
-> [ClassName]
-> Maybe ClassName
-> SMethod r
-> SMethod r
docFunc f :: FuncDocRenderer
f desc :: ClassName
desc pComms :: [ClassName]
pComms rComm :: Maybe ClassName
rComm = FuncDocRenderer
-> ClassName
-> [ClassName]
-> [ClassName]
-> SMethod r
-> SMethod r
forall (r :: * -> *).
RenderSym r =>
FuncDocRenderer
-> ClassName
-> [ClassName]
-> [ClassName]
-> SMethod r
-> SMethod r
docFuncRepr FuncDocRenderer
f ClassName
desc [ClassName]
pComms (Maybe ClassName -> [ClassName]
forall a. Maybe a -> [a]
maybeToList Maybe ClassName
rComm)

-- Classes --

buildClass :: (RenderSym r) =>  Maybe Label -> [CSStateVar r] -> 
  [SMethod r] -> SClass r
buildClass :: Maybe ClassName -> [CSStateVar r] -> [SMethod r] -> SClass r
buildClass p :: Maybe ClassName
p stVars :: [CSStateVar r]
stVars methods :: [SMethod r]
methods = do 
  ClassName
n <- LensLike'
  (Zoomed (StateT FileState Identity) ClassName) ClassState FileState
-> StateT FileState Identity ClassName
-> StateT ClassState Identity ClassName
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 FileState Identity) ClassName) ClassState FileState
Lens' ClassState FileState
lensCStoFS StateT FileState Identity ClassName
getModuleName
  ClassName
-> r (Scope r)
-> r Doc
-> [CSStateVar r]
-> [SMethod r]
-> SClass r
forall (r :: * -> *).
RenderClass r =>
ClassName
-> r (Scope r)
-> r Doc
-> [CSStateVar r]
-> [SMethod r]
-> SClass r
S.intClass ClassName
n r (Scope r)
forall (r :: * -> *). ScopeSym r => r (Scope r)
public (Maybe ClassName -> r Doc
forall (r :: * -> *). RenderClass r => Maybe ClassName -> r Doc
inherit Maybe ClassName
p) [CSStateVar r]
stVars [SMethod r]
methods

implementingClass :: (RenderSym r) => Label -> [Label] -> [CSStateVar r] -> 
  [SMethod r] -> SClass r
implementingClass :: ClassName
-> [ClassName] -> [CSStateVar r] -> [SMethod r] -> SClass r
implementingClass n :: ClassName
n is :: [ClassName]
is = ClassName
-> r (Scope r)
-> r Doc
-> [CSStateVar r]
-> [SMethod r]
-> SClass r
forall (r :: * -> *).
RenderClass r =>
ClassName
-> r (Scope r)
-> r Doc
-> [CSStateVar r]
-> [SMethod r]
-> SClass r
S.intClass ClassName
n r (Scope r)
forall (r :: * -> *). ScopeSym r => r (Scope r)
public ([ClassName] -> r Doc
forall (r :: * -> *). RenderClass r => [ClassName] -> r Doc
implements [ClassName]
is)

docClass :: (RenderSym r) => ClassDocRenderer -> String -> SClass r -> SClass r
docClass :: ClassDocRenderer -> ClassName -> SClass r -> SClass r
docClass cdr :: ClassDocRenderer
cdr d :: ClassName
d = CS (r (BlockComment r)) -> SClass r -> SClass r
forall (r :: * -> *).
RenderClass r =>
CS (r (BlockComment r)) -> SClass r -> SClass r
S.commentedClass (State ClassState [ClassName] -> CS (r (BlockComment r))
forall (r :: * -> *) a.
BlockCommentSym r =>
State a [ClassName] -> State a (r (BlockComment r))
docComment (State ClassState [ClassName] -> CS (r (BlockComment r)))
-> State ClassState [ClassName] -> CS (r (BlockComment r))
forall a b. (a -> b) -> a -> b
$ [ClassName] -> State ClassState [ClassName]
forall a s. a -> State s a
toState ([ClassName] -> State ClassState [ClassName])
-> [ClassName] -> State ClassState [ClassName]
forall a b. (a -> b) -> a -> b
$ ClassDocRenderer
cdr ClassName
d)

commentedClass :: (RenderSym r, Monad r) => CS (r (BlockComment r)) -> SClass r 
  -> CS (r Doc)
commentedClass :: CS (r (BlockComment r)) -> SClass r -> CS (r Doc)
commentedClass = (r (BlockComment r) -> r (Class r) -> r Doc)
-> CS (r (BlockComment r)) -> SClass r -> CS (r Doc)
forall a b c s.
(a -> b -> c) -> State s a -> State s b -> State s c
on2StateValues (\cmt :: r (BlockComment r)
cmt cs :: r (Class r)
cs -> Doc -> r Doc
forall (r :: * -> *) a. Monad r => a -> r a
toCode (Doc -> r Doc) -> Doc -> r Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc -> Doc
R.commentedItem 
  (r (BlockComment r) -> Doc
forall (r :: * -> *).
BlockCommentElim r =>
r (BlockComment r) -> Doc
RC.blockComment' r (BlockComment r)
cmt) (r (Class r) -> Doc
forall (r :: * -> *). ClassElim r => r (Class r) -> Doc
RC.class' r (Class r)
cs))

-- Modules --

modFromData :: Label -> (Doc -> r (Module r)) -> FS Doc -> FSModule r
modFromData :: ClassName -> (Doc -> r (Module r)) -> FS Doc -> FSModule r
modFromData n :: ClassName
n f :: Doc -> r (Module r)
f d :: FS Doc
d = (FileState -> FileState) -> StateT FileState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ClassName -> FileState -> FileState
setModuleName ClassName
n) StateT FileState Identity () -> FSModule r -> FSModule r
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Doc -> r (Module r)) -> FS Doc -> FSModule r
forall a b s. (a -> b) -> State s a -> State s b
onStateValue Doc -> r (Module r)
f FS Doc
d

-- Files --

fileDoc :: (RenderSym r) => String -> (r (Module r) -> r (Block r)) -> 
  r (Block r) -> FSModule r -> SFile r
fileDoc :: ClassName
-> (r (Module r) -> r (Block r))
-> r (Block r)
-> FSModule r
-> SFile r
fileDoc ext :: ClassName
ext topb :: r (Module r) -> r (Block r)
topb botb :: r (Block r)
botb mdl :: FSModule r
mdl = do
  r (Module r)
m <- FSModule r
mdl
  ClassName
nm <- StateT FileState Identity ClassName
getModuleName
  let fp :: ClassName
fp = ClassName -> ClassName -> ClassName
addExt ClassName
ext ClassName
nm
      updm :: r (Module r)
updm = (Doc -> Doc) -> r (Module r) -> r (Module r)
forall (r :: * -> *).
RenderMod r =>
(Doc -> Doc) -> r (Module r) -> r (Module r)
updateModuleDoc (\d :: Doc
d -> Doc -> Doc -> Doc
emptyIfEmpty Doc
d 
        (Doc -> Doc -> Doc -> Doc
R.file (r (Block r) -> Doc
forall (r :: * -> *). BlockElim r => r (Block r) -> Doc
RC.block (r (Block r) -> Doc) -> r (Block r) -> Doc
forall a b. (a -> b) -> a -> b
$ r (Module r) -> r (Block r)
topb r (Module r)
m) Doc
d (r (Block r) -> Doc
forall (r :: * -> *). BlockElim r => r (Block r) -> Doc
RC.block r (Block r)
botb))) r (Module r)
m
  ClassName -> FSModule r -> SFile r
forall (r :: * -> *).
RenderFile r =>
ClassName -> FSModule r -> SFile r
S.fileFromData ClassName
fp (r (Module r) -> FSModule r
forall a s. a -> State s a
toState r (Module r)
updm)

docMod :: (RenderSym r) => ModuleDocRenderer -> String -> String -> [String] -> 
  String -> SFile r -> SFile r
docMod :: ModuleDocRenderer
-> ClassName
-> ClassName
-> [ClassName]
-> ClassName
-> SFile r
-> SFile r
docMod mdr :: ModuleDocRenderer
mdr e :: ClassName
e d :: ClassName
d a :: [ClassName]
a dt :: ClassName
dt fl :: SFile r
fl = SFile r -> FS (r (BlockComment r)) -> SFile r
forall (r :: * -> *).
RenderFile r =>
SFile r -> FS (r (BlockComment r)) -> SFile r
commentedMod SFile r
fl (State FileState [ClassName] -> FS (r (BlockComment r))
forall (r :: * -> *) a.
BlockCommentSym r =>
State a [ClassName] -> State a (r (BlockComment r))
docComment (State FileState [ClassName] -> FS (r (BlockComment r)))
-> State FileState [ClassName] -> FS (r (BlockComment r))
forall a b. (a -> b) -> a -> b
$ ModuleDocRenderer
mdr ClassName
d [ClassName]
a ClassName
dt ClassDocRenderer -> (ClassName -> ClassName) -> ClassDocRenderer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassName -> ClassName -> ClassName
addExt ClassName
e 
  ClassDocRenderer
-> StateT FileState Identity ClassName
-> State FileState [ClassName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT FileState Identity ClassName
getModuleName)

fileFromData :: (RenderSym r) => (FilePath -> r (Module r) -> r (File r)) 
  -> FilePath -> FSModule r -> SFile r
fileFromData :: (ClassName -> r (Module r) -> r (File r))
-> ClassName -> FSModule r -> SFile r
fileFromData f :: ClassName -> r (Module r) -> r (File r)
f fpath :: ClassName
fpath mdl' :: FSModule r
mdl' = do
  -- Add this file to list of files as long as it is not empty
  r (Module r)
mdl <- FSModule r
mdl'
  (FileState -> FileState) -> StateT FileState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\s :: FileState
s -> if Doc -> Bool
isEmpty (r (Module r) -> Doc
forall (r :: * -> *). ModuleElim r => r (Module r) -> Doc
RC.module' r (Module r)
mdl) 
    then FileState
s
    else ASetter FileState FileState GOOLState GOOLState
-> (GOOLState -> GOOLState) -> FileState -> FileState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter FileState FileState GOOLState GOOLState
Lens' FileState GOOLState
lensFStoGS (FileType -> ClassName -> GOOLState -> GOOLState
addFile (FileState
s FileState -> Getting FileType FileState FileType -> FileType
forall s a. s -> Getting a s a -> a
^. Getting FileType FileState FileType
Lens' FileState FileType
currFileType) ClassName
fpath) (FileState -> FileState) -> FileState -> FileState
forall a b. (a -> b) -> a -> b
$ 
      -- If this is the main source file, set it as the main module in the state
      if FileState
s FileState -> Getting Bool FileState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool FileState Bool
Lens' FileState Bool
currMain Bool -> Bool -> Bool
&& FileType -> Bool
isSource (FileState
s FileState -> Getting FileType FileState FileType -> FileType
forall s a. s -> Getting a s a -> a
^. Getting FileType FileState FileType
Lens' FileState FileType
currFileType) 
        then ASetter FileState FileState GOOLState GOOLState
-> (GOOLState -> GOOLState) -> FileState -> FileState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter FileState FileState GOOLState GOOLState
Lens' FileState GOOLState
lensFStoGS (ClassName -> GOOLState -> GOOLState
setMainMod ClassName
fpath) FileState
s
        else FileState
s)
  r (File r) -> SFile r
forall (m :: * -> *) a. Monad m => a -> m a
return (r (File r) -> SFile r) -> r (File r) -> SFile r
forall a b. (a -> b) -> a -> b
$ ClassName -> r (Module r) -> r (File r)
f ClassName
fpath r (Module r)
mdl

-- Helper functions

setEmpty :: (RenderSym r) => MSStatement r -> MSStatement r
setEmpty :: MSStatement r -> MSStatement r
setEmpty s' :: MSStatement r
s' = MSStatement r
s' MSStatement r
-> (r (Statement r) -> MSStatement r) -> MSStatement r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Doc -> MSStatement r
forall (r :: * -> *). RenderSym r => Doc -> MSStatement r
mkStmtNoEnd (Doc -> MSStatement r)
-> (r (Statement r) -> Doc) -> r (Statement r) -> MSStatement r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r (Statement r) -> Doc
forall (r :: * -> *). StatementElim r => r (Statement r) -> Doc
RC.statement