{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
module Drasil.Shared.LanguageRenderer.LanguagePolymorphic (fileFromData,
multiBody, block, multiBlock, obj, negateOp, csc, sec, cot, equalOp,
notEqualOp, greaterOp, greaterEqualOp, lessOp, lessEqualOp, plusOp, minusOp,
multOp, divideOp, moduloOp, var, classVar, instanceVarAccess,
classVarAccessCheck, arrayElem, local, litChar, litDouble, litInt, litString,
valueOf, arg, argsList, call, funcAppMixedArgs, newObjMixedArgs, lambda,
objAccess, objMethodCall, func, get, set, listAccess, getFunc, setFunc, stmt,
loopStmt, emptyStmt, assign, subAssign, 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, OptionalSpace(..), defaultOptSpace, smartAdd, smartSub
) where
import Drasil.FileHandling.Legacy (indent)
import Drasil.Shared.CodeType (CodeType(..), ClassName)
import Drasil.Shared.InterfaceCommon (UnRepr(..), Label, Library, Variable,
SVariable, Value, SValue, NamedArgs, MixedCall, MixedCtorCall, bodyStatements,
oneLiner, VisibilitySym(..), VariableElim(variableName, variableType),
ValueSym(valueType), NumericExpression((#+), (#-), (#/), sin, cos, tan),
Comparison(..), funcApp, MultiStatement(multi), AssignStatement((&++)), (&=),
TypeElim(..), PrintConsole(printStr, printStrLn),
PrintFile(printFile, printFileStr, printFileStrLn), ifNoElse, convType,
VSBinder, BinderElim(..), getCodeType, getTypeString, ValueExpression,
VariableValue, BlockSym, BodySym)
import qualified Drasil.Shared.InterfaceCommon as IC
import Drasil.GOOL.InterfaceGOOL (Class, Initializers, CSStateVar, newObj,
objMethodCallNoParams, ($.), AttachmentSym(..), SelfSym)
import qualified Drasil.GOOL.InterfaceGOOL as IG
import Drasil.Shared.RendererClassesCommon (InternalVarElim(variableBind),
RenderValue(valFromData), RenderFunction(funcFromData),
FunctionElim(functionType), RenderStatement(stmtFromData),
StatementElim(statementTerm), MethodTypeSym(mType), RenderParam(paramFromData),
RenderMethod(commentedFunc), BlockCommentSym(..), ValueElim (value),
RenderVariable)
import qualified Drasil.Shared.RendererClassesCommon as RC
import Drasil.GOOL.RendererClassesOO (OORenderSym, RenderFile(commentedMod),
OORenderMethod(intMethod), RenderClass(inherit, implements),
RenderMod(updateModuleDoc))
import qualified Drasil.GOOL.RendererClassesOO as RO
import Drasil.Shared.AST (AttachmentTag(..), Terminator(..), isSource,
ScopeTag(Local), ScopeData, sd, TypeData(..), BinderD, ParamData, FuncData)
import Drasil.Shared.Helpers (doubleQuotedText, vibcat, emptyIfEmpty, toCode,
toState, onStateValue, on2StateValues, onStateList, getNestDegree,
on2StateWrapped)
import Drasil.Shared.LanguageRenderer (dot, ifLabel, elseLabel, access, addExt,
FuncDocRenderer, ClassDocRenderer, ModuleDocRenderer, getterName, setterName,
valueList, namedArgList)
import qualified Drasil.Shared.LanguageRenderer as R
import Drasil.Shared.LanguageRenderer.Constructors (mkStmtNoEnd, mkStateVal,
mkVal, mkStateVar, mkVar, mkClassVar, VSOp, unOpPrec, compEqualPrec, compPrec,
addPrec, multPrec, typeFromData)
import Drasil.Shared.State (VS, FS, CS, MS, lensFStoGS, lensMStoVS, lensCStoFS,
currMain, currFileType, addFile, setMainMod, setModuleName, getModuleName,
addParameter, getParameters, useVarName)
import Prelude hiding (print,sin,cos,tan,(<>))
import Data.Maybe (fromMaybe, maybeToList)
import Control.Monad.State (modify)
import Control.Lens ((^.), over)
import Control.Lens.Zoom (zoom)
import Text.PrettyPrint.HughesPJ (Doc, text, empty, render, (<>), (<+>), ($+$),
parens, brackets, integer, vcat, comma, isEmpty, space)
import qualified Text.PrettyPrint.HughesPJ as D
multiBody :: (RC.BodyElim r bod, Monad r) => [MS (r bod)] -> MS (r Doc)
multiBody :: forall (r :: * -> *) bod.
(BodyElim r bod, Monad r) =>
[MS (r bod)] -> MS (r Doc)
multiBody [MS (r bod)]
bs = ([Doc] -> r Doc)
-> [State MethodState Doc] -> State MethodState (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] -> State MethodState (r Doc))
-> [State MethodState Doc] -> State MethodState (r Doc)
forall a b. (a -> b) -> a -> b
$ (MS (r bod) -> State MethodState Doc)
-> [MS (r bod)] -> [State MethodState Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((r bod -> Doc) -> MS (r bod) -> State MethodState Doc
forall a b s. (a -> b) -> State s a -> State s b
onStateValue r bod -> Doc
forall {k} (r :: k -> *) (bod :: k). BodyElim r bod => r bod -> Doc
RC.body) [MS (r bod)]
bs
block
:: (Monad r, RenderStatement r stmt, StatementElim r stmt)
=> [MS (r stmt)] -> MS (r Doc)
block :: forall (r :: * -> *) stmt.
(Monad r, RenderStatement r stmt, StatementElim r stmt) =>
[MS (r stmt)] -> MS (r Doc)
block [MS (r stmt)]
sts = ([r stmt] -> r Doc) -> [MS (r stmt)] -> State MethodState (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 stmt] -> Doc) -> [r stmt] -> r Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
R.block ([Doc] -> Doc) -> ([r stmt] -> [Doc]) -> [r stmt] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r stmt -> Doc) -> [r stmt] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map r stmt -> Doc
forall {k} (r :: k -> *) (stmt :: k).
StatementElim r stmt =>
r stmt -> Doc
RC.statement) ((MS (r stmt) -> MS (r stmt)) -> [MS (r stmt)] -> [MS (r stmt)]
forall a b. (a -> b) -> [a] -> [b]
map 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)]
sts)
multiBlock :: (RC.BlockElim r block, Monad r) => [MS (r block)] -> MS (r Doc)
multiBlock :: forall (r :: * -> *) block.
(BlockElim r block, Monad r) =>
[MS (r block)] -> MS (r Doc)
multiBlock [MS (r block)]
bs = ([Doc] -> r Doc)
-> [State MethodState Doc] -> State MethodState (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] -> State MethodState (r Doc))
-> [State MethodState Doc] -> State MethodState (r Doc)
forall a b. (a -> b) -> a -> b
$ (MS (r block) -> State MethodState Doc)
-> [MS (r block)] -> [State MethodState Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((r block -> Doc) -> MS (r block) -> State MethodState Doc
forall a b s. (a -> b) -> State s a -> State s b
onStateValue r block -> Doc
forall {k} (r :: k -> *) (block :: k).
BlockElim r block =>
r block -> Doc
RC.block) [MS (r block)]
bs
obj :: (Monad r) => ClassName -> VS (r TypeData)
obj :: forall (r :: * -> *). Monad r => ClassName -> VS (r TypeData)
obj ClassName
n = CodeType -> ClassName -> Doc -> VS (r TypeData)
forall (r :: * -> *).
Monad r =>
CodeType -> ClassName -> Doc -> VS (r TypeData)
typeFromData (ClassName -> CodeType
Object ClassName
n) ClassName
n (ClassName -> Doc
text ClassName
n)
negateOp :: (Monad r) => VSOp r
negateOp :: forall (r :: * -> *). Monad r => VSOp r
negateOp = ClassName -> VSOp r
forall (r :: * -> *). Monad r => ClassName -> VSOp r
unOpPrec ClassName
"-"
csc :: (IC.Literal r, IC.NumericExpression r, TypeElim r) => SValue r -> SValue r
csc :: forall (r :: * -> *).
(Literal r, NumericExpression r, TypeElim r) =>
SValue r -> SValue r
csc SValue r
v = VS (r TypeData) -> SValue r
forall (r :: * -> *).
(Literal r, TypeElim r) =>
VS (r TypeData) -> SValue r
valOfOne ((r Value -> r TypeData) -> SValue r -> VS (r TypeData)
forall a b.
(a -> b)
-> StateT ValueState Identity a -> StateT ValueState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap r Value -> r TypeData
forall (r :: * -> *). ValueSym r => r Value -> r TypeData
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 :: (IC.Literal r, IC.NumericExpression r, TypeElim r) => SValue r -> SValue r
sec :: forall (r :: * -> *).
(Literal r, NumericExpression r, TypeElim r) =>
SValue r -> SValue r
sec SValue r
v = VS (r TypeData) -> SValue r
forall (r :: * -> *).
(Literal r, TypeElim r) =>
VS (r TypeData) -> SValue r
valOfOne ((r Value -> r TypeData) -> SValue r -> VS (r TypeData)
forall a b.
(a -> b)
-> StateT ValueState Identity a -> StateT ValueState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap r Value -> r TypeData
forall (r :: * -> *). ValueSym r => r Value -> r TypeData
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 :: (IC.Literal r, IC.NumericExpression r, TypeElim r) => SValue r -> SValue r
cot :: forall (r :: * -> *).
(Literal r, NumericExpression r, TypeElim r) =>
SValue r -> SValue r
cot SValue r
v = VS (r TypeData) -> SValue r
forall (r :: * -> *).
(Literal r, TypeElim r) =>
VS (r TypeData) -> SValue r
valOfOne ((r Value -> r TypeData) -> SValue r -> VS (r TypeData)
forall a b.
(a -> b)
-> StateT ValueState Identity a -> StateT ValueState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap r Value -> r TypeData
forall (r :: * -> *). ValueSym r => r Value -> r TypeData
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 :: (IC.Literal r, TypeElim r) => VS (r TypeData) -> SValue r
valOfOne :: forall (r :: * -> *).
(Literal r, TypeElim r) =>
VS (r TypeData) -> SValue r
valOfOne VS (r TypeData)
t = VS (r TypeData)
t VS (r TypeData)
-> (r TypeData -> StateT ValueState Identity (r Value))
-> StateT ValueState Identity (r Value)
forall a b.
StateT ValueState Identity a
-> (a -> StateT ValueState Identity b)
-> StateT ValueState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CodeType -> StateT ValueState Identity (r Value)
forall {r :: * -> *}. Literal r => CodeType -> SValue r
getVal (CodeType -> StateT ValueState Identity (r Value))
-> (r TypeData -> CodeType)
-> r TypeData
-> StateT ValueState Identity (r Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r TypeData -> CodeType
forall (r :: * -> *). TypeElim r => r TypeData -> CodeType
getCodeType)
where getVal :: CodeType -> SValue r
getVal CodeType
Float = Float -> SValue r
forall (r :: * -> *). Literal r => Float -> SValue r
IC.litFloat Float
1.0
getVal CodeType
_ = Double -> SValue r
forall (r :: * -> *). Literal r => Double -> SValue r
IC.litDouble Double
1.0
smartAdd
:: (IC.Literal r, IC.NumericExpression r, RenderValue r, ValueElim r)
=> SValue r -> SValue r -> SValue r
smartAdd :: forall (r :: * -> *).
(Literal r, NumericExpression r, RenderValue r, ValueElim r) =>
SValue r -> SValue r -> SValue r
smartAdd SValue r
v1 SValue r
v2 = do
v1' <- SValue r
v1
v2' <- v2
case (RC.valueInt v1', RC.valueInt v2') of
(Just Integer
i1, Just Integer
i2) -> Integer -> SValue r
forall (r :: * -> *).
(RenderValue r, TypeSym r) =>
Integer -> SValue r
litInt (Integer
i1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
i2)
(Maybe Integer
_, Just Integer
i2) | Integer
i2 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 -> SValue r
v1 SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
#- Integer -> SValue r
forall (r :: * -> *).
(RenderValue r, TypeSym r) =>
Integer -> SValue r
litInt (Integer -> Integer
forall a. Num a => a -> a
negate Integer
i2)
(Maybe Integer, Maybe Integer)
_ -> SValue r
v1 SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
#+ SValue r
v2
smartSub
:: (IC.Literal r, IC.NumericExpression r, RenderValue r, ValueElim r)
=> SValue r -> SValue r -> SValue r
smartSub :: forall (r :: * -> *).
(Literal r, NumericExpression r, RenderValue r, ValueElim r) =>
SValue r -> SValue r -> SValue r
smartSub SValue r
v1 SValue r
v2 = do
v1' <- SValue r
v1
v2' <- v2
case (RC.valueInt v1', RC.valueInt v2') of
(Just Integer
i1, Just Integer
i2) -> Integer -> SValue r
forall (r :: * -> *).
(RenderValue r, TypeSym r) =>
Integer -> SValue r
litInt (Integer
i1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
i2)
(Maybe Integer, Maybe Integer)
_ -> SValue r
v1 SValue r -> SValue r -> SValue r
forall (r :: * -> *).
NumericExpression r =>
SValue r -> SValue r -> SValue r
#- SValue r
v2
equalOp :: (Monad r) => VSOp r
equalOp :: forall (r :: * -> *). Monad r => VSOp r
equalOp = ClassName -> VSOp r
forall (r :: * -> *). Monad r => ClassName -> VSOp r
compEqualPrec ClassName
"=="
notEqualOp :: (Monad r) => VSOp r
notEqualOp :: forall (r :: * -> *). Monad r => VSOp r
notEqualOp = ClassName -> VSOp r
forall (r :: * -> *). Monad r => ClassName -> VSOp r
compEqualPrec ClassName
"!="
greaterOp :: (Monad r) => VSOp r
greaterOp :: forall (r :: * -> *). Monad r => VSOp r
greaterOp = ClassName -> VSOp r
forall (r :: * -> *). Monad r => ClassName -> VSOp r
compPrec ClassName
">"
greaterEqualOp :: (Monad r) => VSOp r
greaterEqualOp :: forall (r :: * -> *). Monad r => VSOp r
greaterEqualOp = ClassName -> VSOp r
forall (r :: * -> *). Monad r => ClassName -> VSOp r
compPrec ClassName
">="
lessOp :: (Monad r) => VSOp r
lessOp :: forall (r :: * -> *). Monad r => VSOp r
lessOp = ClassName -> VSOp r
forall (r :: * -> *). Monad r => ClassName -> VSOp r
compPrec ClassName
"<"
lessEqualOp :: (Monad r) => VSOp r
lessEqualOp :: forall (r :: * -> *). Monad r => VSOp r
lessEqualOp = ClassName -> VSOp r
forall (r :: * -> *). Monad r => ClassName -> VSOp r
compPrec ClassName
"<="
plusOp :: (Monad r) => VSOp r
plusOp :: forall (r :: * -> *). Monad r => VSOp r
plusOp = ClassName -> VSOp r
forall (r :: * -> *). Monad r => ClassName -> VSOp r
addPrec ClassName
"+"
minusOp :: (Monad r) => VSOp r
minusOp :: forall (r :: * -> *). Monad r => VSOp r
minusOp = ClassName -> VSOp r
forall (r :: * -> *). Monad r => ClassName -> VSOp r
addPrec ClassName
"-"
multOp :: (Monad r) => VSOp r
multOp :: forall (r :: * -> *). Monad r => VSOp r
multOp = ClassName -> VSOp r
forall (r :: * -> *). Monad r => ClassName -> VSOp r
multPrec ClassName
"*"
divideOp :: (Monad r) => VSOp r
divideOp :: forall (r :: * -> *). Monad r => VSOp r
divideOp = ClassName -> VSOp r
forall (r :: * -> *). Monad r => ClassName -> VSOp r
multPrec ClassName
"/"
moduloOp :: (Monad r) => VSOp r
moduloOp :: forall (r :: * -> *). Monad r => VSOp r
moduloOp = ClassName -> VSOp r
forall (r :: * -> *). Monad r => ClassName -> VSOp r
multPrec ClassName
"%"
var :: (RenderVariable r) => Label -> VS (r TypeData) -> SVariable r
var :: forall (r :: * -> *).
RenderVariable r =>
ClassName -> VS (r TypeData) -> SVariable r
var ClassName
n VS (r TypeData)
t = ClassName -> VS (r TypeData) -> Doc -> SVariable r
forall (r :: * -> *).
RenderVariable r =>
ClassName -> VS (r TypeData) -> Doc -> SVariable r
mkStateVar ClassName
n VS (r TypeData)
t (ClassName -> Doc
R.var ClassName
n)
classVar :: (RenderVariable r) => Label -> VS (r TypeData) -> SVariable r
classVar :: forall (r :: * -> *).
RenderVariable r =>
ClassName -> VS (r TypeData) -> SVariable r
classVar ClassName
n VS (r TypeData)
t = ClassName -> VS (r TypeData) -> Doc -> SVariable r
forall (r :: * -> *).
RenderVariable r =>
ClassName -> VS (r TypeData) -> Doc -> SVariable r
mkClassVar ClassName
n VS (r TypeData)
t (ClassName -> Doc
R.var ClassName
n)
classVarAccessCheck :: (InternalVarElim r) => r Variable -> r Variable
classVarAccessCheck :: forall (r :: * -> *). InternalVarElim r => r Variable -> r Variable
classVarAccessCheck r Variable
v = AttachmentTag -> r Variable
classVarCS (r Variable -> AttachmentTag
forall (r :: * -> *).
InternalVarElim r =>
r Variable -> AttachmentTag
variableBind r Variable
v)
where classVarCS :: AttachmentTag -> r Variable
classVarCS AttachmentTag
InstanceLevel = ClassName -> r Variable
forall a. HasCallStack => ClassName -> a
error
ClassName
"classVarAccess can only be used to access class-level variables"
classVarCS AttachmentTag
ClassLevel = r Variable
v
instanceVarAccess
:: (InternalVarElim r, RenderVariable r, ValueElim r, VariableElim r)
=> SValue r -> SVariable r -> SVariable r
instanceVarAccess :: forall (r :: * -> *).
(InternalVarElim r, RenderVariable r, ValueElim r,
VariableElim r) =>
SValue r -> SVariable r -> SVariable r
instanceVarAccess SValue r
o' SVariable r
v' = do
o <- SValue r
o'
v <- v'
let instanceVarAccess' AttachmentTag
ClassLevel = ClassName -> SVariable r
forall a. HasCallStack => ClassName -> a
error
ClassName
"Cannot access class-level variables through an object, use classVarAccess instead"
instanceVarAccess' AttachmentTag
InstanceLevel = ClassName -> r TypeData -> Doc -> SVariable r
forall (r :: * -> *).
RenderVariable r =>
ClassName -> r TypeData -> Doc -> SVariable r
mkVar (Doc -> ClassName
render (r Value -> Doc
forall (r :: * -> *). ValueElim r => r Value -> Doc
value r Value
o) ClassName -> ClassName -> ClassName
`access` r Variable -> ClassName
forall (r :: * -> *). VariableElim r => r Variable -> ClassName
variableName r Variable
v)
(r Variable -> r TypeData
forall (r :: * -> *). VariableElim r => r Variable -> r TypeData
variableType r Variable
v) (Doc -> Doc -> Doc
R.instanceVarAccess (r Value -> Doc
forall (r :: * -> *). ValueElim r => r Value -> Doc
RC.value r Value
o) (r Variable -> Doc
forall (r :: * -> *). InternalVarElim r => r Variable -> Doc
RC.variable r Variable
v))
instanceVarAccess' (variableBind v)
arrayElem
:: (IC.IndexTranslator r, RenderVariable r, ValueElim r)
=> SValue r -> SValue r -> SVariable r
arrayElem :: forall (r :: * -> *).
(IndexTranslator r, RenderVariable r, ValueElim r) =>
SValue r -> SValue r -> SVariable r
arrayElem SValue r
arr' SValue r
i' = do
i <- SValue r -> SValue r
forall (r :: * -> *). IndexTranslator r => SValue r -> SValue r
IC.intToIndex SValue r
i'
arr <- arr'
let vName = Doc -> ClassName
render (r Value -> Doc
forall (r :: * -> *). ValueElim r => r Value -> Doc
RC.value r Value
arr) ClassName -> ClassName -> ClassName
forall a. [a] -> [a] -> [a]
++ ClassName
"[" ClassName -> ClassName -> ClassName
forall a. [a] -> [a] -> [a]
++ Doc -> ClassName
render (r Value -> Doc
forall (r :: * -> *). ValueElim r => r Value -> Doc
RC.value r Value
i) ClassName -> ClassName -> ClassName
forall a. [a] -> [a] -> [a]
++ ClassName
"]"
vType = VS (r TypeData) -> VS (r TypeData)
forall (r :: * -> *).
TypeSym r =>
VS (r TypeData) -> VS (r TypeData)
IC.innerType (VS (r TypeData) -> VS (r TypeData))
-> VS (r TypeData) -> VS (r TypeData)
forall a b. (a -> b) -> a -> b
$ r TypeData -> VS (r TypeData)
forall a. a -> StateT ValueState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (r TypeData -> VS (r TypeData)) -> r TypeData -> VS (r TypeData)
forall a b. (a -> b) -> a -> b
$ r Value -> r TypeData
forall (r :: * -> *). ValueSym r => r Value -> r TypeData
valueType r Value
arr
vRender = r Value -> Doc
forall (r :: * -> *). ValueElim r => r Value -> Doc
RC.value r Value
arr Doc -> Doc -> Doc
<> Doc -> Doc
brackets (r Value -> Doc
forall (r :: * -> *). ValueElim r => r Value -> Doc
RC.value r Value
i)
mkStateVar vName vType vRender
local :: (Monad r) => r ScopeData
local :: forall (r :: * -> *). Monad r => r ScopeData
local = ScopeData -> r ScopeData
forall (r :: * -> *) a. Monad r => a -> r a
toCode (ScopeData -> r ScopeData) -> ScopeData -> r ScopeData
forall a b. (a -> b) -> a -> b
$ ScopeTag -> ScopeData
sd ScopeTag
Local
litChar :: (RenderValue r, IC.TypeSym r) => (Doc -> Doc) -> Char -> SValue r
litChar :: forall (r :: * -> *).
(RenderValue r, TypeSym r) =>
(Doc -> Doc) -> Char -> SValue r
litChar Doc -> Doc
f Char
c = 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.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
== Char
'\n' then ClassName -> Doc
text ClassName
"\\n" else Char -> Doc
D.char Char
c)
litDouble :: (RenderValue r, IC.TypeSym r) => Double -> SValue r
litDouble :: forall (r :: * -> *).
(RenderValue r, TypeSym r) =>
Double -> SValue r
litDouble Double
d = 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.double (Double -> Doc
D.double Double
d)
litInt :: (RenderValue r, IC.TypeSym r) => Integer -> SValue r
litInt :: forall (r :: * -> *).
(RenderValue r, TypeSym r) =>
Integer -> SValue r
litInt Integer
i = Maybe Int -> Maybe Integer -> VS (r TypeData) -> Doc -> SValue r
forall (r :: * -> *).
RenderValue r =>
Maybe Int -> Maybe Integer -> VS (r TypeData) -> Doc -> SValue r
valFromData Maybe Int
forall a. Maybe a
Nothing (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i) VS (r TypeData)
forall (r :: * -> *). TypeSym r => VS (r TypeData)
IC.int (Integer -> Doc
integer Integer
i)
litString :: (RenderValue r, IC.TypeSym r) => String -> SValue r
litString :: forall (r :: * -> *).
(RenderValue r, TypeSym r) =>
ClassName -> SValue r
litString ClassName
s = 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.string (ClassName -> Doc
doubleQuotedText ClassName
s)
valueOf
:: (InternalVarElim r, RenderValue r, VariableElim r)
=> SVariable r -> SValue r
valueOf :: forall (r :: * -> *).
(InternalVarElim r, RenderValue r, VariableElim r) =>
SVariable r -> SValue r
valueOf SVariable r
v' = do
v <- SVariable r
v'
mkVal (variableType v) (RC.variable v)
arg
:: (RenderValue r, IC.TypeSym r, ValueElim r)
=> SValue r -> SValue r -> SValue r
arg :: forall (r :: * -> *).
(RenderValue r, TypeSym r, ValueElim r) =>
SValue r -> SValue r -> SValue r
arg SValue r
n' SValue r
args' = do
n <- SValue r
n'
args <- args'
s <- IC.string
mkVal s (R.arg n args)
argsList :: (RenderValue r, IC.TypeSym r) => String -> SValue r
argsList :: forall (r :: * -> *).
(RenderValue r, TypeSym r) =>
ClassName -> SValue r
argsList ClassName
l = VS (r TypeData) -> Doc -> SValue r
forall (r :: * -> *).
RenderValue r =>
VS (r TypeData) -> Doc -> SValue r
mkStateVal (VS (r TypeData) -> VS (r TypeData)
forall (r :: * -> *).
TypeSym r =>
VS (r TypeData) -> VS (r TypeData)
IC.arrayType VS (r TypeData)
forall (r :: * -> *). TypeSym r => VS (r TypeData)
IC.string) (ClassName -> Doc
text ClassName
l)
call
:: (InternalVarElim r, RenderValue r, ValueElim r)
=> Doc -> Maybe Library -> Maybe Doc -> MixedCall r
call :: forall (r :: * -> *).
(InternalVarElim r, RenderValue r, ValueElim r) =>
Doc -> Maybe ClassName -> Maybe Doc -> MixedCall r
call Doc
sep Maybe ClassName
lib Maybe Doc
o ClassName
n VS (r TypeData)
t [SValue r]
pas NamedArgs r
nas = do
pargs <- [SValue r] -> StateT ValueState Identity [r Value]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [SValue r]
pas
nms <- mapM fst nas
nargs <- mapM snd nas
let 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 -> Maybe Doc -> Doc
forall a. a -> Maybe a -> a
fromMaybe Doc
empty Maybe Doc
o
mkStateVal t $ obDoc <> libDoc <> parens (valueList pargs <>
(if null pas || null nas then empty else comma) <+> namedArgList sep
(zip nms nargs))
funcAppMixedArgs :: (RenderValue r) => MixedCall r
funcAppMixedArgs :: forall (r :: * -> *). RenderValue r => MixedCall r
funcAppMixedArgs = Maybe ClassName -> Maybe Doc -> MixedCall r
forall (r :: * -> *).
RenderValue r =>
Maybe ClassName -> Maybe Doc -> MixedCall r
RC.call Maybe ClassName
forall a. Maybe a
Nothing Maybe Doc
forall a. Maybe a
Nothing
newObjMixedArgs
:: (RenderValue r, UnRepr r TypeData)
=> String -> MixedCtorCall r
newObjMixedArgs :: forall (r :: * -> *).
(RenderValue r, UnRepr r TypeData) =>
ClassName -> MixedCtorCall r
newObjMixedArgs ClassName
s VS (r TypeData)
tp [SValue r]
vs NamedArgs r
ns = do
t <- VS (r TypeData)
tp
RC.call Nothing Nothing (s ++ getTypeString t) (return t) vs ns
lambda
:: (BinderElim r, RenderValue r, ValueSym r)
=> ([r BinderD] -> r Value -> Doc) -> [VSBinder r] -> SValue r -> SValue r
lambda :: forall (r :: * -> *).
(BinderElim r, RenderValue r, ValueSym r) =>
([r BinderD] -> r Value -> Doc)
-> [VSBinder r] -> SValue r -> SValue r
lambda [r BinderD] -> r Value -> Doc
f [VSBinder r]
ps' SValue r
ex' = do
ps <- [VSBinder r] -> StateT ValueState Identity [r BinderD]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [VSBinder r]
ps'
ex <- ex'
let ft = [VS (r TypeData)] -> VS (r TypeData) -> VS (r TypeData)
forall (r :: * -> *).
TypeSym r =>
[VS (r TypeData)] -> VS (r TypeData) -> VS (r TypeData)
IC.funcType ((r BinderD -> VS (r TypeData)) -> [r BinderD] -> [VS (r TypeData)]
forall a b. (a -> b) -> [a] -> [b]
map (r TypeData -> VS (r TypeData)
forall a. a -> StateT ValueState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (r TypeData -> VS (r TypeData))
-> (r BinderD -> r TypeData) -> r BinderD -> VS (r TypeData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r BinderD -> r TypeData
forall (r :: * -> *). BinderElim r => r BinderD -> r TypeData
binderType) [r BinderD]
ps) (r TypeData -> VS (r TypeData)
forall a. a -> StateT ValueState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (r TypeData -> VS (r TypeData)) -> r TypeData -> VS (r TypeData)
forall a b. (a -> b) -> a -> b
$ r Value -> r TypeData
forall (r :: * -> *). ValueSym r => r Value -> r TypeData
valueType r Value
ex)
valFromData (Just 0) Nothing ft (f ps ex)
objAccess
:: (FunctionElim r, RenderValue r, ValueElim r)
=> SValue r -> VS (r FuncData) -> SValue r
objAccess :: forall (r :: * -> *).
(FunctionElim r, RenderValue r, ValueElim r) =>
SValue r -> VS (r FuncData) -> SValue r
objAccess = (r Value -> r FuncData -> StateT ValueState Identity (r Value))
-> StateT ValueState Identity (r Value)
-> StateT ValueState Identity (r FuncData)
-> StateT ValueState Identity (r Value)
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> m a -> m b -> m c
on2StateWrapped (\r Value
v r FuncData
f-> r TypeData -> Doc -> StateT ValueState Identity (r Value)
forall (r :: * -> *).
RenderValue r =>
r TypeData -> Doc -> SValue r
mkVal (r FuncData -> r TypeData
forall (r :: * -> *). FunctionElim r => r FuncData -> r TypeData
functionType r FuncData
f)
(Doc -> Doc -> Doc
R.objAccess (r Value -> Doc
forall (r :: * -> *). ValueElim r => r Value -> Doc
RC.value r Value
v) (r FuncData -> Doc
forall (r :: * -> *). FunctionElim r => r FuncData -> Doc
RC.function r FuncData
f)))
objMethodCall
:: (RenderValue r, ValueElim r)
=> Label -> VS (r TypeData) -> SValue r -> [SValue r] -> NamedArgs r -> SValue r
objMethodCall :: forall (r :: * -> *).
(RenderValue r, ValueElim r) =>
ClassName
-> VS (r TypeData)
-> SValue r
-> [SValue r]
-> NamedArgs r
-> SValue r
objMethodCall ClassName
f VS (r TypeData)
t SValue r
ob [SValue r]
vs NamedArgs r
ns = SValue r
ob SValue r -> (r Value -> SValue r) -> SValue r
forall a b.
StateT ValueState Identity a
-> (a -> StateT ValueState Identity b)
-> StateT ValueState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\r Value
o -> Maybe ClassName -> Maybe Doc -> MixedCall r
forall (r :: * -> *).
RenderValue r =>
Maybe ClassName -> Maybe Doc -> MixedCall r
RC.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 -> Doc
forall (r :: * -> *). ValueElim r => r Value -> Doc
RC.value r Value
o Doc -> Doc -> Doc
<> Doc
dot) ClassName
f VS (r TypeData)
t [SValue r]
vs NamedArgs r
ns)
func
:: (RenderFunction r, ValueElim r, ValueExpression r)
=> Label -> VS (r TypeData) -> [SValue r] -> VS (r FuncData)
func :: forall (r :: * -> *).
(RenderFunction r, ValueElim r, ValueExpression r) =>
ClassName -> VS (r TypeData) -> [SValue r] -> VS (r FuncData)
func ClassName
l VS (r TypeData)
t [SValue r]
vs = PosCall r
forall (r :: * -> *). ValueExpression r => PosCall r
funcApp ClassName
l VS (r TypeData)
t [SValue r]
vs SValue r
-> (r Value -> StateT ValueState Identity (r FuncData))
-> StateT ValueState Identity (r FuncData)
forall a b.
StateT ValueState Identity a
-> (a -> StateT ValueState Identity b)
-> StateT ValueState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((Doc -> VS (r TypeData) -> StateT ValueState Identity (r FuncData)
forall (r :: * -> *).
RenderFunction r =>
Doc -> VS (r TypeData) -> VS (r FuncData)
`funcFromData` VS (r TypeData)
t) (Doc -> StateT ValueState Identity (r FuncData))
-> (r Value -> Doc)
-> r Value
-> StateT ValueState Identity (r FuncData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
R.func (Doc -> Doc) -> (r Value -> Doc) -> r Value -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r Value -> Doc
forall (r :: * -> *). ValueElim r => r Value -> Doc
RC.value)
get
:: (RO.InternalGetSet r, IG.OOFunctionSym r)
=> SValue r -> SVariable r -> SValue r
get :: forall (r :: * -> *).
(InternalGetSet r, OOFunctionSym r) =>
SValue r -> SVariable r -> SValue r
get SValue r
v SVariable r
vToGet = SValue r
v SValue r -> VS (r FuncData) -> SValue r
forall (r :: * -> *).
OOFunctionSym r =>
SValue r -> VS (r FuncData) -> SValue r
$. SVariable r -> VS (r FuncData)
forall (r :: * -> *).
InternalGetSet r =>
SVariable r -> VS (r FuncData)
RO.getFunc SVariable r
vToGet
set :: (RO.InternalGetSet r, IG.OOFunctionSym r) => SValue r -> SVariable r -> SValue r -> SValue r
set :: forall (r :: * -> *).
(InternalGetSet r, OOFunctionSym r) =>
SValue r -> SVariable r -> SValue r -> SValue r
set SValue r
v SVariable r
vToSet SValue r
toVal = SValue r
v SValue r -> VS (r FuncData) -> SValue r
forall (r :: * -> *).
OOFunctionSym r =>
SValue r -> VS (r FuncData) -> SValue r
$. VS (r TypeData) -> SVariable r -> SValue r -> VS (r FuncData)
forall (r :: * -> *).
InternalGetSet r =>
VS (r TypeData) -> SVariable r -> SValue r -> VS (r FuncData)
RO.setFunc ((r Value -> r TypeData) -> SValue r -> VS (r TypeData)
forall a b s. (a -> b) -> State s a -> State s b
onStateValue r Value -> r TypeData
forall (r :: * -> *). ValueSym r => r Value -> r TypeData
valueType SValue r
v) SVariable r
vToSet SValue r
toVal
listAccess
:: ( IC.IndexTranslator r
, RC.InternalListFunc r
, FunctionElim r
, RenderFunction r
, RenderValue r
, TypeElim r
, ValueElim r
)
=> SValue r -> SValue r -> SValue r
listAccess :: forall (r :: * -> *).
(IndexTranslator r, InternalListFunc r, FunctionElim r,
RenderFunction r, RenderValue r, TypeElim r, ValueElim r) =>
SValue r -> SValue r -> SValue r
listAccess SValue r
v SValue r
i = do
v' <- SValue r
v
let i' = SValue r -> SValue r
forall (r :: * -> *). IndexTranslator r => SValue r -> SValue r
IC.intToIndex SValue r
i
t = VS (r TypeData) -> VS (r TypeData)
forall (r :: * -> *).
TypeSym r =>
VS (r TypeData) -> VS (r TypeData)
IC.innerType (VS (r TypeData) -> VS (r TypeData))
-> VS (r TypeData) -> VS (r TypeData)
forall a b. (a -> b) -> a -> b
$ r TypeData -> VS (r TypeData)
forall a. a -> StateT ValueState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (r TypeData -> VS (r TypeData)) -> r TypeData -> VS (r TypeData)
forall a b. (a -> b) -> a -> b
$ r Value -> r TypeData
forall (r :: * -> *). ValueSym r => r Value -> r TypeData
valueType r Value
v'
checkType (List CodeType
_) = VS (r TypeData) -> SValue r -> VS (r FuncData)
forall (r :: * -> *).
InternalListFunc r =>
VS (r TypeData) -> SValue r -> VS (r FuncData)
RC.listAccessFunc VS (r TypeData)
t SValue r
i'
checkType (Set CodeType
_) = VS (r TypeData) -> SValue r -> VS (r FuncData)
forall (r :: * -> *).
InternalListFunc r =>
VS (r TypeData) -> SValue r -> VS (r FuncData)
RC.listAccessFunc VS (r TypeData)
t SValue r
i'
checkType (Array CodeType
_) = SValue r
i' SValue r -> (r Value -> VS (r FuncData)) -> VS (r FuncData)
forall a b.
StateT ValueState Identity a
-> (a -> StateT ValueState Identity b)
-> StateT ValueState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
(\r Value
ix -> Doc -> VS (r TypeData) -> VS (r FuncData)
forall (r :: * -> *).
RenderFunction r =>
Doc -> VS (r TypeData) -> VS (r FuncData)
funcFromData (Doc -> Doc
brackets (r Value -> Doc
forall (r :: * -> *). ValueElim r => r Value -> Doc
RC.value r Value
ix)) VS (r TypeData)
t)
checkType CodeType
_ = ClassName -> VS (r FuncData)
forall a. HasCallStack => ClassName -> a
error ClassName
"listAccess called on non-list-type value"
f <- checkType (getCodeType (valueType v'))
mkVal (RC.functionType f) (RC.value v' <> RC.function f)
getFunc
:: (IG.OOFunctionSym r, VariableElim r)
=> SVariable r -> VS (r FuncData)
getFunc :: forall (r :: * -> *).
(OOFunctionSym r, VariableElim r) =>
SVariable r -> VS (r FuncData)
getFunc SVariable r
v = SVariable r
v SVariable r
-> (r Variable -> StateT ValueState Identity (r FuncData))
-> StateT ValueState Identity (r FuncData)
forall a b.
StateT ValueState Identity a
-> (a -> StateT ValueState Identity b)
-> StateT ValueState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\r Variable
vr -> ClassName
-> VS (r TypeData)
-> [SValue r]
-> StateT ValueState Identity (r FuncData)
forall (r :: * -> *).
OOFunctionSym r =>
ClassName -> VS (r TypeData) -> [SValue r] -> VS (r FuncData)
IG.func (ClassName -> ClassName
getterName (ClassName -> ClassName) -> ClassName -> ClassName
forall a b. (a -> b) -> a -> b
$ r Variable -> ClassName
forall (r :: * -> *). VariableElim r => r Variable -> ClassName
variableName r Variable
vr)
(r TypeData -> VS (r TypeData)
forall a s. a -> State s a
toState (r TypeData -> VS (r TypeData)) -> r TypeData -> VS (r TypeData)
forall a b. (a -> b) -> a -> b
$ r Variable -> r TypeData
forall (r :: * -> *). VariableElim r => r Variable -> r TypeData
variableType r Variable
vr) [])
setFunc
:: (IG.OOFunctionSym r, VariableElim r)
=> VS (r TypeData) -> SVariable r -> SValue r -> VS (r FuncData)
setFunc :: forall (r :: * -> *).
(OOFunctionSym r, VariableElim r) =>
VS (r TypeData) -> SVariable r -> SValue r -> VS (r FuncData)
setFunc VS (r TypeData)
t SVariable r
v SValue r
toVal = SVariable r
v SVariable r
-> (r Variable -> StateT ValueState Identity (r FuncData))
-> StateT ValueState Identity (r FuncData)
forall a b.
StateT ValueState Identity a
-> (a -> StateT ValueState Identity b)
-> StateT ValueState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\r Variable
vr -> ClassName
-> VS (r TypeData)
-> [SValue r]
-> StateT ValueState Identity (r FuncData)
forall (r :: * -> *).
OOFunctionSym r =>
ClassName -> VS (r TypeData) -> [SValue r] -> VS (r FuncData)
IG.func (ClassName -> ClassName
setterName (ClassName -> ClassName) -> ClassName -> ClassName
forall a b. (a -> b) -> a -> b
$ r Variable -> ClassName
forall (r :: * -> *). VariableElim r => r Variable -> ClassName
variableName r Variable
vr) VS (r TypeData)
t
[SValue r
toVal])
stmt
:: (RenderStatement r stmt, StatementElim r stmt)
=> MS (r stmt) -> MS (r stmt)
stmt :: forall {k} (r :: k -> *) (stmt :: k).
(RenderStatement r stmt, StatementElim r stmt) =>
MS (r stmt) -> MS (r stmt)
stmt MS (r stmt)
s' = do
s <- MS (r stmt)
s'
mkStmtNoEnd (RC.statement s <> R.getTerm (statementTerm s))
loopStmt
:: (RenderStatement r stmt, StatementElim r stmt)
=> MS (r stmt) -> MS (r stmt)
loopStmt :: forall {k} (r :: k -> *) (stmt :: k).
(RenderStatement r stmt, StatementElim r stmt) =>
MS (r stmt) -> MS (r stmt)
loopStmt = 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) -> MS (r stmt))
-> (MS (r stmt) -> MS (r stmt)) -> MS (r stmt) -> MS (r stmt)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MS (r stmt) -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k).
(RenderStatement r stmt, StatementElim r stmt) =>
MS (r stmt) -> MS (r stmt)
setEmpty
emptyStmt :: (RenderStatement r stmt) => MS (r stmt)
emptyStmt :: forall {k} (r :: k -> *) (stmt :: k).
RenderStatement r stmt =>
MS (r stmt)
emptyStmt = Doc -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k).
RenderStatement r stmt =>
Doc -> MS (r stmt)
mkStmtNoEnd Doc
empty
assign
:: (InternalVarElim r, RenderStatement r stmt, ValueElim r)
=> Terminator -> SVariable r -> SValue r -> MS (r stmt)
assign :: forall (r :: * -> *) stmt.
(InternalVarElim r, RenderStatement r stmt, ValueElim r) =>
Terminator -> SVariable r -> SValue r -> MS (r stmt)
assign Terminator
t 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'
stmtFromData (R.assign vr v) t
subAssign
:: (InternalVarElim r, RenderStatement r stmt, ValueElim r)
=> Terminator -> SVariable r -> SValue r -> MS (r stmt)
subAssign :: forall (r :: * -> *) stmt.
(InternalVarElim r, RenderStatement r stmt, ValueElim r) =>
Terminator -> SVariable r -> SValue r -> MS (r stmt)
subAssign Terminator
t 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'
stmtFromData (R.subAssign vr v) t
objDecNew
:: (IC.DeclStatement r stmt bod, IG.OOValueExpression r, VariableElim r)
=> SVariable r -> r ScopeData -> [SValue r] -> MS (r stmt)
objDecNew :: forall (r :: * -> *) stmt bod.
(DeclStatement r stmt bod, OOValueExpression r, VariableElim r) =>
SVariable r -> r ScopeData -> [SValue r] -> MS (r stmt)
objDecNew 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 (PosCtorCall r
forall (r :: * -> *). OOValueExpression r => PosCtorCall r
newObj ((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)
printList
::
( BlockSym r block stmt
, BodySym r bod block
, MultiStatement r stmt
, IC.DeclStatement r stmt bod
, AssignStatement r stmt
, IC.ControlStatement r stmt bod
, IC.Literal r
, NumericExpression r
, Comparison r
, IC.VariableValue r
, IC.List r
)
=> Integer
-> SValue r
-> (SValue r -> MS (r stmt))
-> (String -> MS (r stmt))
-> (String -> MS (r stmt))
-> MS (r stmt)
printList :: forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, MultiStatement r stmt,
DeclStatement r stmt bod, AssignStatement r stmt,
ControlStatement r stmt bod, Literal r, NumericExpression r,
Comparison r, VariableValue r, List r) =>
Integer
-> SValue r
-> (SValue r -> MS (r stmt))
-> (ClassName -> MS (r stmt))
-> (ClassName -> MS (r stmt))
-> MS (r stmt)
printList Integer
n SValue r
v SValue r -> MS (r stmt)
prFn ClassName -> MS (r stmt)
prStrFn ClassName -> MS (r stmt)
prLnFn = [MS (r stmt)] -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k).
MultiStatement r stmt =>
[MS (r stmt)] -> MS (r stmt)
multi [ClassName -> MS (r stmt)
prStrFn ClassName
"[",
MS (r stmt) -> SValue r -> MS (r stmt) -> MS (r bod) -> MS (r stmt)
forall (r :: * -> *) stmt bod.
ControlStatement r stmt bod =>
MS (r stmt) -> SValue r -> MS (r stmt) -> MS (r bod) -> MS (r stmt)
IC.for (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
i r ScopeData
forall (r :: * -> *). ScopeSym r => r ScopeData
IC.local (Integer -> SValue r
forall (r :: * -> *). Literal r => Integer -> SValue r
IC.litInt Integer
0))
(SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
IC.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
IC.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
IC.litInt Integer
1)) (SVariable r
i SVariable r -> MS (r stmt)
forall (r :: * -> *) stmt.
AssignStatement r stmt =>
SVariable r -> MS (r stmt)
&++)
([MS (r stmt)] -> MS (r bod)
forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k).
(BlockSym r block stmt, BodySym r bod block) =>
[MS (r stmt)] -> MS (r bod)
bodyStatements [SValue r -> MS (r stmt)
prFn (SValue r -> SValue r -> SValue r
forall (r :: * -> *). List r => SValue r -> SValue r -> SValue r
IC.listAccess SValue r
v (SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
IC.valueOf SVariable r
i)), ClassName -> MS (r stmt)
prStrFn ClassName
", "]),
[(SValue r, MS (r bod))] -> MS (r stmt)
forall (r :: * -> *) bod block stmt.
(BodySym r bod block, ControlStatement r stmt bod) =>
[(SValue r, MS (r bod))] -> MS (r stmt)
ifNoElse [(SValue r -> SValue r
forall (r :: * -> *). List r => SValue r -> SValue r
IC.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
IC.litInt Integer
0, MS (r stmt) -> MS (r bod)
forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k).
(BlockSym r block stmt, BodySym r bod block) =>
MS (r stmt) -> MS (r bod)
oneLiner (MS (r stmt) -> MS (r bod)) -> MS (r stmt) -> MS (r bod)
forall a b. (a -> b) -> a -> b
$
SValue r -> MS (r stmt)
prFn (SValue r -> SValue r -> SValue r
forall (r :: * -> *). List r => SValue r -> SValue r -> SValue r
IC.listAccess SValue r
v (SValue r -> SValue r
forall (r :: * -> *). List r => SValue r -> SValue r
IC.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
IC.litInt Integer
1)))],
ClassName -> MS (r stmt)
prLnFn ClassName
"]"]
where l_i :: ClassName
l_i = ClassName
"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 -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
ClassName -> VS (r TypeData) -> SVariable r
IC.var ClassName
l_i VS (r TypeData)
forall (r :: * -> *). TypeSym r => VS (r TypeData)
IC.int
printSet
::
( BlockSym r block stmt
, BodySym r bod block
, MultiStatement r stmt
, IC.ControlStatement r stmt bod
, IC.VariableValue r
)
=> Integer
-> SValue r
-> (SValue r -> MS (r stmt))
-> (String -> MS (r stmt))
-> (String -> MS (r stmt))
-> VS (r TypeData)
-> MS (r stmt)
printSet :: forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, MultiStatement r stmt,
ControlStatement r stmt bod, VariableValue r) =>
Integer
-> SValue r
-> (SValue r -> MS (r stmt))
-> (ClassName -> MS (r stmt))
-> (ClassName -> MS (r stmt))
-> VS (r TypeData)
-> MS (r stmt)
printSet Integer
n SValue r
v SValue r -> MS (r stmt)
prFn ClassName -> MS (r stmt)
prStrFn ClassName -> MS (r stmt)
prLnFn VS (r TypeData)
s = [MS (r stmt)] -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k).
MultiStatement r stmt =>
[MS (r stmt)] -> MS (r stmt)
multi [ClassName -> MS (r stmt)
prStrFn ClassName
"{ ",
SVariable r -> SValue r -> MS (r bod) -> MS (r stmt)
forall (r :: * -> *) stmt bod.
ControlStatement r stmt bod =>
SVariable r -> SValue r -> MS (r bod) -> MS (r stmt)
IC.forEach SVariable r
i SValue r
v
([MS (r stmt)] -> MS (r bod)
forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k).
(BlockSym r block stmt, BodySym r bod block) =>
[MS (r stmt)] -> MS (r bod)
bodyStatements [SValue r -> MS (r stmt)
prFn (SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
IC.valueOf SVariable r
i),ClassName -> MS (r stmt)
prStrFn ClassName
" "]),
ClassName -> MS (r stmt)
prLnFn ClassName
"}"]
where set_i :: ClassName
set_i = ClassName
"set_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 -> VS (r TypeData) -> SVariable r
forall (r :: * -> *).
VariableSym r =>
ClassName -> VS (r TypeData) -> SVariable r
IC.var ClassName
set_i VS (r TypeData)
s
printObj :: ClassName -> (String -> MS (r stmt)) -> MS (r stmt)
printObj :: forall {k} (r :: k -> *) (stmt :: k).
ClassName -> (ClassName -> MS (r stmt)) -> MS (r stmt)
printObj ClassName
n ClassName -> MS (r stmt)
prLnFn = ClassName -> MS (r stmt)
prLnFn (ClassName -> MS (r stmt)) -> ClassName -> MS (r stmt)
forall a b. (a -> b) -> a -> b
$ ClassName
"Instance of " ClassName -> ClassName -> ClassName
forall a. [a] -> [a] -> [a]
++ ClassName
n ClassName -> ClassName -> ClassName
forall a. [a] -> [a] -> [a]
++ ClassName
" object"
print
::
( BlockSym r block stmt
, BodySym r bod block
, MultiStatement r stmt
, PrintConsole r stmt
, PrintFile r stmt
, IC.DeclStatement r stmt bod
, AssignStatement r stmt
, IC.ControlStatement r stmt bod
, IC.Literal r
, NumericExpression r
, Comparison r
, IC.VariableValue r
, IC.List r
, TypeElim r
, RC.InternalIOStmt r stmt
)
=> Bool -> Maybe (SValue r) -> SValue r -> SValue r -> MS (r stmt)
print :: forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, MultiStatement r stmt,
PrintConsole r stmt, PrintFile r stmt, DeclStatement r stmt bod,
AssignStatement r stmt, ControlStatement r stmt bod, Literal r,
NumericExpression r, Comparison r, VariableValue r, List r,
TypeElim r, InternalIOStmt r stmt) =>
Bool -> Maybe (SValue r) -> SValue r -> SValue r -> MS (r stmt)
print Bool
newLn Maybe (SValue r)
f SValue r
printFn SValue r
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 StateT MethodState Identity (r Value)
-> (r Value -> StateT MethodState Identity (r stmt))
-> StateT MethodState Identity (r stmt)
forall a b.
StateT MethodState Identity a
-> (a -> StateT MethodState Identity b)
-> StateT MethodState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CodeType -> StateT MethodState Identity (r stmt)
print' (CodeType -> StateT MethodState Identity (r stmt))
-> (r Value -> CodeType)
-> r Value
-> StateT MethodState Identity (r stmt)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r TypeData -> CodeType
forall (r :: * -> *). TypeElim r => r TypeData -> CodeType
getCodeType (r TypeData -> CodeType)
-> (r Value -> r TypeData) -> r Value -> CodeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r Value -> r TypeData
forall (r :: * -> *). ValueSym r => r Value -> r TypeData
valueType
where print' :: CodeType -> StateT MethodState Identity (r stmt)
print' (List CodeType
t) = Integer
-> SValue r
-> (SValue r -> StateT MethodState Identity (r stmt))
-> (ClassName -> StateT MethodState Identity (r stmt))
-> (ClassName -> StateT MethodState Identity (r stmt))
-> StateT MethodState Identity (r stmt)
forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, MultiStatement r stmt,
DeclStatement r stmt bod, AssignStatement r stmt,
ControlStatement r stmt bod, Literal r, NumericExpression r,
Comparison r, VariableValue r, List r) =>
Integer
-> SValue r
-> (SValue r -> MS (r stmt))
-> (ClassName -> MS (r stmt))
-> (ClassName -> MS (r stmt))
-> MS (r stmt)
printList (Integer -> CodeType -> Integer
getNestDegree Integer
1 CodeType
t) SValue r
v SValue r -> StateT MethodState Identity (r stmt)
prFn ClassName -> StateT MethodState Identity (r stmt)
prStrFn ClassName -> StateT MethodState Identity (r stmt)
prLnFn
print' (Object ClassName
n) = ClassName
-> (ClassName -> StateT MethodState Identity (r stmt))
-> StateT MethodState Identity (r stmt)
forall {k} (r :: k -> *) (stmt :: k).
ClassName -> (ClassName -> MS (r stmt)) -> MS (r stmt)
printObj ClassName
n ClassName -> StateT MethodState Identity (r stmt)
prLnFn
print' (Set CodeType
t) = Integer
-> SValue r
-> (SValue r -> StateT MethodState Identity (r stmt))
-> (ClassName -> StateT MethodState Identity (r stmt))
-> (ClassName -> StateT MethodState Identity (r stmt))
-> VS (r TypeData)
-> StateT MethodState Identity (r stmt)
forall (r :: * -> *) block stmt bod.
(BlockSym r block stmt, BodySym r bod block, MultiStatement r stmt,
ControlStatement r stmt bod, VariableValue r) =>
Integer
-> SValue r
-> (SValue r -> MS (r stmt))
-> (ClassName -> MS (r stmt))
-> (ClassName -> MS (r stmt))
-> VS (r TypeData)
-> MS (r stmt)
printSet (Integer -> CodeType -> Integer
getNestDegree Integer
1 CodeType
t) SValue r
v SValue r -> StateT MethodState Identity (r stmt)
prFn ClassName -> StateT MethodState Identity (r stmt)
prStrFn ClassName -> StateT MethodState Identity (r stmt)
prLnFn (CodeType -> VS (r TypeData)
forall (r :: * -> *). TypeSym r => CodeType -> VS (r TypeData)
convType CodeType
t)
print' CodeType
_ = Bool
-> Maybe (SValue r)
-> SValue r
-> SValue r
-> StateT MethodState Identity (r stmt)
forall (r :: * -> *) stmt.
InternalIOStmt r stmt =>
Bool -> Maybe (SValue r) -> SValue r -> SValue r -> MS (r stmt)
RC.printSt Bool
newLn Maybe (SValue r)
f SValue r
printFn SValue r
v
prFn :: SValue r -> StateT MethodState Identity (r stmt)
prFn = (SValue r -> StateT MethodState Identity (r stmt))
-> (SValue r -> SValue r -> StateT MethodState Identity (r stmt))
-> Maybe (SValue r)
-> SValue r
-> StateT MethodState Identity (r stmt)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SValue r -> StateT MethodState Identity (r stmt)
forall (r :: * -> *) stmt.
PrintConsole r stmt =>
SValue r -> MS (r stmt)
IC.print SValue r -> SValue r -> StateT MethodState Identity (r stmt)
forall (r :: * -> *) stmt.
PrintFile r stmt =>
SValue r -> SValue r -> MS (r stmt)
printFile Maybe (SValue r)
f
prStrFn :: ClassName -> StateT MethodState Identity (r stmt)
prStrFn = (ClassName -> StateT MethodState Identity (r stmt))
-> (SValue r -> ClassName -> StateT MethodState Identity (r stmt))
-> Maybe (SValue r)
-> ClassName
-> StateT MethodState Identity (r stmt)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ClassName -> StateT MethodState Identity (r stmt)
forall (r :: * -> *) stmt.
PrintConsole r stmt =>
ClassName -> MS (r stmt)
printStr SValue r -> ClassName -> StateT MethodState Identity (r stmt)
forall (r :: * -> *) stmt.
PrintFile r stmt =>
SValue r -> ClassName -> MS (r stmt)
printFileStr Maybe (SValue r)
f
prLnFn :: ClassName -> StateT MethodState Identity (r stmt)
prLnFn = if Bool
newLn then (ClassName -> StateT MethodState Identity (r stmt))
-> (SValue r -> ClassName -> StateT MethodState Identity (r stmt))
-> Maybe (SValue r)
-> ClassName
-> StateT MethodState Identity (r stmt)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ClassName -> StateT MethodState Identity (r stmt)
forall (r :: * -> *) stmt.
PrintConsole r stmt =>
ClassName -> MS (r stmt)
printStrLn SValue r -> ClassName -> StateT MethodState Identity (r stmt)
forall (r :: * -> *) stmt.
PrintFile r stmt =>
SValue r -> ClassName -> MS (r stmt)
printFileStrLn Maybe (SValue r)
f else (ClassName -> StateT MethodState Identity (r stmt))
-> (SValue r -> ClassName -> StateT MethodState Identity (r stmt))
-> Maybe (SValue r)
-> ClassName
-> StateT MethodState Identity (r stmt)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
ClassName -> StateT MethodState Identity (r stmt)
forall (r :: * -> *) stmt.
PrintConsole r stmt =>
ClassName -> MS (r stmt)
printStr SValue r -> ClassName -> StateT MethodState Identity (r stmt)
forall (r :: * -> *) stmt.
PrintFile r stmt =>
SValue r -> ClassName -> MS (r stmt)
printFileStr Maybe (SValue r)
f
closeFile
:: (IG.InternalValueExp r, IC.ValueStatement r stmt)
=> Label -> SValue r -> MS (r stmt)
closeFile :: forall (r :: * -> *) stmt.
(InternalValueExp r, ValueStatement r stmt) =>
ClassName -> SValue r -> MS (r stmt)
closeFile ClassName
n SValue r
f = SValue r -> MS (r stmt)
forall (r :: * -> *) stmt.
ValueStatement r stmt =>
SValue r -> MS (r stmt)
IC.valStmt (SValue r -> MS (r stmt)) -> SValue r -> MS (r stmt)
forall a b. (a -> b) -> a -> b
$ VS (r TypeData) -> SValue r -> ClassName -> SValue r
forall (r :: * -> *).
InternalValueExp r =>
VS (r TypeData) -> SValue r -> ClassName -> SValue r
objMethodCallNoParams VS (r TypeData)
forall (r :: * -> *). TypeSym r => VS (r TypeData)
IC.void SValue r
f ClassName
n
returnStmt
:: (RenderStatement r stmt, ValueElim r)
=> Terminator -> SValue r -> MS (r stmt)
returnStmt :: forall (r :: * -> *) stmt.
(RenderStatement r stmt, ValueElim r) =>
Terminator -> SValue r -> MS (r stmt)
returnStmt Terminator
t SValue r
v' = 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'
stmtFromData (R.return' [v]) t
valStmt :: (RenderStatement r stmt, ValueElim r) => Terminator -> SValue r -> MS (r stmt)
valStmt :: forall (r :: * -> *) stmt.
(RenderStatement r stmt, ValueElim r) =>
Terminator -> SValue r -> MS (r stmt)
valStmt Terminator
t SValue r
v' = 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'
stmtFromData (RC.value v) t
comment :: (RenderStatement r stmt) => Doc -> Label -> MS (r stmt)
Doc
cs ClassName
c = Doc -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k).
RenderStatement r stmt =>
Doc -> MS (r stmt)
mkStmtNoEnd (ClassName -> Doc -> Doc
R.comment ClassName
c Doc
cs)
throw :: (IC.Literal r, RenderStatement r stmt) => (r Value -> Doc) -> Terminator ->
Label -> MS (r stmt)
throw :: forall (r :: * -> *) stmt.
(Literal r, RenderStatement r stmt) =>
(r Value -> Doc) -> Terminator -> ClassName -> MS (r stmt)
throw r Value -> Doc
f Terminator
t ClassName
l = do
msg <- LensLike'
(Zoomed (StateT ValueState Identity) (r Value))
MethodState
ValueState
-> StateT ValueState Identity (r Value)
-> 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 (ClassName -> StateT ValueState Identity (r Value)
forall (r :: * -> *). Literal r => ClassName -> SValue r
IC.litString ClassName
l)
stmtFromData (f msg) t
newtype OptionalSpace = OSpace {OptionalSpace -> Doc
oSpace :: Doc}
defaultOptSpace :: OptionalSpace
defaultOptSpace :: OptionalSpace
defaultOptSpace = OSpace {oSpace :: Doc
oSpace = Doc
space}
optSpaceDoc :: OptionalSpace -> Doc
optSpaceDoc :: OptionalSpace -> Doc
optSpaceDoc OSpace {oSpace :: OptionalSpace -> Doc
oSpace = Doc
sp} = Doc
sp
ifCond
:: (RC.BodyElim r bod, RenderStatement r stmt, ValueElim r)
=> (Doc -> Doc)
-> Doc
-> OptionalSpace
-> Doc
-> Doc
-> Doc
-> [(SValue r, MS (r bod))]
-> MS (r bod)
-> MS (r stmt)
ifCond :: forall (r :: * -> *) bod stmt.
(BodyElim r bod, RenderStatement r stmt, ValueElim r) =>
(Doc -> Doc)
-> Doc
-> OptionalSpace
-> Doc
-> Doc
-> Doc
-> [(SValue r, MS (r bod))]
-> MS (r bod)
-> MS (r stmt)
ifCond Doc -> Doc
_ Doc
_ OptionalSpace
_ Doc
_ Doc
_ Doc
_ [] MS (r bod)
_ = ClassName -> MS (r stmt)
forall a. HasCallStack => ClassName -> a
error ClassName
"if condition created with no cases"
ifCond Doc -> Doc
f Doc
ifStart OptionalSpace
os Doc
elif Doc
bEnd Doc
ifEnd ((SValue r, MS (r bod))
c:[(SValue r, MS (r bod))]
cs) MS (r bod)
eBody =
let ifSect :: (SValue r, MS (r bod)) -> State MethodState Doc
ifSect (SValue r
v, MS (r bod)
b) = (r Value -> r bod -> Doc)
-> State MethodState (r Value)
-> MS (r bod)
-> State MethodState Doc
forall a b c s.
(a -> b -> c) -> State s a -> State s b -> State s c
on2StateValues (\r Value
val r bod
bd -> [Doc] -> Doc
vcat [
Doc
ifLabel Doc -> Doc -> Doc
<+> Doc -> Doc
f (r Value -> Doc
forall (r :: * -> *). ValueElim r => r Value -> Doc
RC.value r Value
val) Doc -> Doc -> Doc
<> OptionalSpace -> Doc
optSpaceDoc OptionalSpace
os Doc -> Doc -> Doc
<> Doc
ifStart,
Doc -> Doc
indent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ r bod -> Doc
forall {k} (r :: k -> *) (bod :: k). BodyElim r bod => r bod -> Doc
RC.body r bod
bd,
Doc
bEnd]) (LensLike'
(Zoomed (StateT ValueState Identity) (r Value))
MethodState
ValueState
-> SValue r -> State MethodState (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) MS (r bod)
b
elseIfSect :: (SValue r, MS (r bod)) -> State MethodState Doc
elseIfSect (SValue r
v, MS (r bod)
b) = (r Value -> r bod -> Doc)
-> State MethodState (r Value)
-> MS (r bod)
-> State MethodState Doc
forall a b c s.
(a -> b -> c) -> State s a -> State s b -> State s c
on2StateValues (\r Value
val r bod
bd -> [Doc] -> Doc
vcat [
Doc
elif Doc -> Doc -> Doc
<+> Doc -> Doc
f (r Value -> Doc
forall (r :: * -> *). ValueElim r => r Value -> Doc
RC.value r Value
val) Doc -> Doc -> Doc
<> OptionalSpace -> Doc
optSpaceDoc OptionalSpace
os Doc -> Doc -> Doc
<> Doc
ifStart,
Doc -> Doc
indent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ r bod -> Doc
forall {k} (r :: k -> *) (bod :: k). BodyElim r bod => r bod -> Doc
RC.body r bod
bd,
Doc
bEnd]) (LensLike'
(Zoomed (StateT ValueState Identity) (r Value))
MethodState
ValueState
-> SValue r -> State MethodState (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) MS (r bod)
b
elseSect :: State MethodState Doc
elseSect = (r bod -> Doc) -> MS (r bod) -> State MethodState Doc
forall a b s. (a -> b) -> State s a -> State s b
onStateValue (\r bod
bd -> Doc -> Doc -> Doc
emptyIfEmpty (r bod -> Doc
forall {k} (r :: k -> *) (bod :: k). BodyElim r bod => r bod -> Doc
RC.body r bod
bd) ([Doc] -> Doc
vcat [
Doc
elseLabel Doc -> Doc -> Doc
<> OptionalSpace -> Doc
optSpaceDoc OptionalSpace
os Doc -> Doc -> Doc
<> Doc
ifStart,
Doc -> Doc
indent (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ r bod -> Doc
forall {k} (r :: k -> *) (bod :: k). BodyElim r bod => r bod -> Doc
RC.body r bod
bd,
Doc
bEnd]) Doc -> Doc -> Doc
$+$ Doc
ifEnd) MS (r bod)
eBody
in [State MethodState Doc] -> StateT MethodState Identity [Doc]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ((SValue r, MS (r bod)) -> State MethodState Doc
ifSect (SValue r, MS (r bod))
c State MethodState Doc
-> [State MethodState Doc] -> [State MethodState Doc]
forall a. a -> [a] -> [a]
: ((SValue r, MS (r bod)) -> State MethodState Doc)
-> [(SValue r, MS (r bod))] -> [State MethodState Doc]
forall a b. (a -> b) -> [a] -> [b]
map (SValue r, MS (r bod)) -> State MethodState Doc
elseIfSect [(SValue r, MS (r bod))]
cs [State MethodState Doc]
-> [State MethodState Doc] -> [State MethodState Doc]
forall a. [a] -> [a] -> [a]
++ [State MethodState Doc
elseSect])
StateT MethodState Identity [Doc]
-> ([Doc] -> MS (r stmt)) -> MS (r stmt)
forall a b.
StateT MethodState Identity a
-> (a -> StateT MethodState Identity b)
-> StateT MethodState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Doc -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k).
RenderStatement r stmt =>
Doc -> MS (r stmt)
mkStmtNoEnd (Doc -> MS (r stmt)) -> ([Doc] -> Doc) -> [Doc] -> MS (r stmt)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
vcat)
tryCatch :: (RenderStatement r stmt) => (r bod -> r bod -> Doc) ->
MS (r bod) -> MS (r bod) -> MS (r stmt)
tryCatch :: forall {k} (r :: k -> *) (stmt :: k) (bod :: k).
RenderStatement r stmt =>
(r bod -> r bod -> Doc) -> MS (r bod) -> MS (r bod) -> MS (r stmt)
tryCatch r bod -> r bod -> Doc
f = (r bod -> r bod -> StateT MethodState Identity (r stmt))
-> StateT MethodState Identity (r bod)
-> StateT MethodState Identity (r bod)
-> StateT MethodState Identity (r stmt)
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> m a -> m b -> m c
on2StateWrapped (\r bod
tb1 r bod
tb2 -> Doc -> StateT MethodState Identity (r stmt)
forall {k} (r :: k -> *) (stmt :: k).
RenderStatement r stmt =>
Doc -> MS (r stmt)
mkStmtNoEnd (r bod -> r bod -> Doc
f r bod
tb1 r bod
tb2))
construct :: (Monad r) => Label -> MS (r TypeData)
construct :: forall (r :: * -> *). Monad r => ClassName -> MS (r TypeData)
construct ClassName
n = LensLike'
(Zoomed (StateT ValueState Identity) (r TypeData))
MethodState
ValueState
-> StateT ValueState Identity (r TypeData)
-> StateT MethodState Identity (r TypeData)
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 TypeData))
MethodState
ValueState
(ValueState -> Focusing Identity (r TypeData) ValueState)
-> MethodState -> Focusing Identity (r TypeData) MethodState
Lens' MethodState ValueState
lensMStoVS (StateT ValueState Identity (r TypeData)
-> StateT MethodState Identity (r TypeData))
-> StateT ValueState Identity (r TypeData)
-> StateT MethodState Identity (r TypeData)
forall a b. (a -> b) -> a -> b
$ CodeType
-> ClassName -> Doc -> StateT ValueState Identity (r TypeData)
forall (r :: * -> *).
Monad r =>
CodeType -> ClassName -> Doc -> VS (r TypeData)
typeFromData (ClassName -> CodeType
Object ClassName
n) ClassName
n Doc
empty
param
:: (RenderParam r, VariableElim r)
=> (r Variable -> Doc) -> SVariable r -> MS (r ParamData)
param :: forall (r :: * -> *).
(RenderParam r, VariableElim r) =>
(r Variable -> Doc) -> SVariable r -> MS (r ParamData)
param r Variable -> Doc
f SVariable r
v' = 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'
let n = r Variable -> ClassName
forall (r :: * -> *). VariableElim r => r Variable -> ClassName
variableName r Variable
v
modify $ addParameter n
modify $ useVarName n
paramFromData v' $ f v
method
:: (OORenderMethod r vis mthd attch bod)
=> Label
-> r vis
-> r attch
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r bod)
-> MS (r mthd)
method :: forall (r :: * -> *) vis mthd attch bod.
OORenderMethod r vis mthd attch bod =>
ClassName
-> r vis
-> r attch
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r bod)
-> MS (r mthd)
method ClassName
n r vis
s r attch
p VS (r TypeData)
t = Bool
-> ClassName
-> r vis
-> r attch
-> MSMthdType r
-> [MS (r ParamData)]
-> MS (r bod)
-> MS (r mthd)
forall (r :: * -> *) vis mthd attch bod.
OORenderMethod r vis mthd attch bod =>
Bool
-> ClassName
-> r vis
-> r attch
-> MSMthdType r
-> [MS (r ParamData)]
-> MS (r bod)
-> MS (r mthd)
intMethod Bool
False ClassName
n r vis
s r attch
p (VS (r TypeData) -> MSMthdType r
forall (r :: * -> *).
MethodTypeSym r =>
VS (r TypeData) -> MSMthdType r
mType VS (r TypeData)
t)
getMethod
:: (OORenderSym r vis stmt mthd stvr attch file mod bod block)
=> SVariable r -> MS (r mthd)
getMethod :: forall (r :: * -> *) vis stmt mthd stvr attch file mod bod block.
OORenderSym r vis stmt mthd stvr attch file mod bod block =>
SVariable r -> MS (r mthd)
getMethod SVariable r
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 StateT MethodState Identity (r Variable)
-> (r Variable -> StateT MethodState Identity (r mthd))
-> StateT MethodState Identity (r mthd)
forall a b.
StateT MethodState Identity a
-> (a -> StateT MethodState Identity b)
-> StateT MethodState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\r Variable
vr -> ClassName
-> r vis
-> r attch
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r bod)
-> StateT MethodState Identity (r mthd)
forall (r :: * -> *) vis mthd attch bod.
OORenderMethod r vis mthd attch bod =>
ClassName
-> r vis
-> r attch
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r bod)
-> MS (r mthd)
method (ClassName -> ClassName
getterName (ClassName -> ClassName) -> ClassName -> ClassName
forall a b. (a -> b) -> a -> b
$ r Variable -> ClassName
forall (r :: * -> *). VariableElim r => r Variable -> ClassName
variableName
r Variable
vr) r vis
forall {k} (r :: k -> *) (vis :: k). VisibilitySym r vis => r vis
public r attch
forall {k} (r :: k -> *) (attch :: k).
AttachmentSym r attch =>
r attch
instanceLevel (r TypeData -> VS (r TypeData)
forall a s. a -> State s a
toState (r TypeData -> VS (r TypeData)) -> r TypeData -> VS (r TypeData)
forall a b. (a -> b) -> a -> b
$ r Variable -> r TypeData
forall (r :: * -> *). VariableElim r => r Variable -> r TypeData
variableType r Variable
vr) [] MS (r bod)
getBody)
where getBody :: MS (r bod)
getBody = MS (r stmt) -> MS (r bod)
forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k).
(BlockSym r block stmt, BodySym r bod block) =>
MS (r stmt) -> MS (r bod)
oneLiner (MS (r stmt) -> MS (r bod)) -> MS (r stmt) -> MS (r bod)
forall a b. (a -> b) -> a -> b
$ SValue r -> MS (r stmt)
forall (r :: * -> *) stmt bod.
ControlStatement r stmt bod =>
SValue r -> MS (r stmt)
IC.returnStmt (SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
IC.valueOf (SVariable r -> SValue r) -> SVariable r -> SValue r
forall a b. (a -> b) -> a -> b
$ SVariable r -> SVariable r
forall (r :: * -> *).
(SelfSym r, VariableValue r) =>
SVariable r -> SVariable r
IG.instanceVarSelf SVariable r
v)
setMethod
:: (OORenderSym r vis stmt mthd stvr attch file mod bod block)
=> SVariable r -> MS (r mthd)
setMethod :: forall (r :: * -> *) vis stmt mthd stvr attch file mod bod block.
OORenderSym r vis stmt mthd stvr attch file mod bod block =>
SVariable r -> MS (r mthd)
setMethod SVariable r
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 StateT MethodState Identity (r Variable)
-> (r Variable -> StateT MethodState Identity (r mthd))
-> StateT MethodState Identity (r mthd)
forall a b.
StateT MethodState Identity a
-> (a -> StateT MethodState Identity b)
-> StateT MethodState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\r Variable
vr -> ClassName
-> r vis
-> r attch
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r bod)
-> StateT MethodState Identity (r mthd)
forall (r :: * -> *) vis mthd attch bod.
OORenderMethod r vis mthd attch bod =>
ClassName
-> r vis
-> r attch
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r bod)
-> MS (r mthd)
method (ClassName -> ClassName
setterName (ClassName -> ClassName) -> ClassName -> ClassName
forall a b. (a -> b) -> a -> b
$ r Variable -> ClassName
forall (r :: * -> *). VariableElim r => r Variable -> ClassName
variableName
r Variable
vr) r vis
forall {k} (r :: k -> *) (vis :: k). VisibilitySym r vis => r vis
public r attch
forall {k} (r :: k -> *) (attch :: k).
AttachmentSym r attch =>
r attch
instanceLevel VS (r TypeData)
forall (r :: * -> *). TypeSym r => VS (r TypeData)
IC.void [SVariable r -> MS (r ParamData)
forall (r :: * -> *).
ParameterSym r =>
SVariable r -> MS (r ParamData)
IC.param SVariable r
v] MS (r bod)
setBody)
where setBody :: MS (r bod)
setBody = MS (r stmt) -> MS (r bod)
forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k).
(BlockSym r block stmt, BodySym r bod block) =>
MS (r stmt) -> MS (r bod)
oneLiner (MS (r stmt) -> MS (r bod)) -> MS (r stmt) -> MS (r bod)
forall a b. (a -> b) -> a -> b
$ SVariable r -> SVariable r
forall (r :: * -> *).
(SelfSym r, VariableValue r) =>
SVariable r -> SVariable r
IG.instanceVarSelf SVariable r
v SVariable r -> SValue r -> MS (r stmt)
forall (r :: * -> *) stmt.
AssignStatement r stmt =>
SVariable r -> SValue r -> MS (r stmt)
&= SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
IC.valueOf SVariable r
v
initStmts
::
( VariableValue r
, SelfSym r
, AssignStatement r stmt
, BlockSym r block stmt
, BodySym r bod block
)
=> Initializers r -> MS (r bod)
initStmts :: forall (r :: * -> *) stmt block bod.
(VariableValue r, SelfSym r, AssignStatement r stmt,
BlockSym r block stmt, BodySym r bod block) =>
Initializers r -> MS (r bod)
initStmts = [MS (r stmt)] -> MS (r bod)
forall {k} (r :: k -> *) (block :: k) (stmt :: k) (bod :: k).
(BlockSym r block stmt, BodySym r bod block) =>
[MS (r stmt)] -> MS (r bod)
bodyStatements ([MS (r stmt)] -> MS (r bod))
-> (Initializers r -> [MS (r stmt)])
-> Initializers r
-> MS (r bod)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SVariable r, SValue r) -> MS (r stmt))
-> Initializers r -> [MS (r stmt)]
forall a b. (a -> b) -> [a] -> [b]
map (\(SVariable r
vr, SValue r
vl) -> SVariable r -> SVariable r
forall (r :: * -> *).
(SelfSym r, VariableValue r) =>
SVariable r -> SVariable r
IG.instanceVarSelf SVariable r
vr SVariable r -> SValue r -> MS (r stmt)
forall (r :: * -> *) stmt.
AssignStatement r stmt =>
SVariable r -> SValue r -> MS (r stmt)
&= SValue r
vl)
function
:: (AttachmentSym r attch, OORenderMethod r vis mthd attch bod)
=> Label -> r vis -> VS (r TypeData) -> [MS (r ParamData)] -> MS (r bod) -> MS (r mthd)
function :: forall (r :: * -> *) attch vis mthd bod.
(AttachmentSym r attch, OORenderMethod r vis mthd attch bod) =>
ClassName
-> r vis
-> VS (r TypeData)
-> [MS (r ParamData)]
-> MS (r bod)
-> MS (r mthd)
function ClassName
n r vis
s VS (r TypeData)
t = Bool
-> ClassName
-> r vis
-> r attch
-> MSMthdType r
-> [MS (r ParamData)]
-> MS (r bod)
-> MS (r mthd)
forall (r :: * -> *) vis mthd attch bod.
OORenderMethod r vis mthd attch bod =>
Bool
-> ClassName
-> r vis
-> r attch
-> MSMthdType r
-> [MS (r ParamData)]
-> MS (r bod)
-> MS (r mthd)
RO.intFunc Bool
False ClassName
n r vis
s r attch
forall {k} (r :: k -> *) (attch :: k).
AttachmentSym r attch =>
r attch
classLevel (VS (r TypeData) -> MSMthdType r
forall (r :: * -> *).
MethodTypeSym r =>
VS (r TypeData) -> MSMthdType r
mType VS (r TypeData)
t)
docFuncRepr :: (RenderMethod r mthd) => FuncDocRenderer -> String ->
[String] -> [String] -> MS (r mthd) -> MS (r mthd)
docFuncRepr :: forall (r :: * -> *) mthd.
RenderMethod r mthd =>
FuncDocRenderer
-> ClassName
-> [ClassName]
-> [ClassName]
-> MS (r mthd)
-> MS (r mthd)
docFuncRepr FuncDocRenderer
f ClassName
desc [ClassName]
pComms [ClassName]
rComms = MS (r Doc) -> MS (r mthd) -> MS (r mthd)
forall (r :: * -> *) mthd.
RenderMethod r mthd =>
MS (r Doc) -> MS (r mthd) -> MS (r mthd)
commentedFunc (State MethodState [ClassName] -> MS (r Doc)
forall a. State a [ClassName] -> State a (r Doc)
forall (r :: * -> *) a.
BlockCommentSym r =>
State a [ClassName] -> State a (r Doc)
docComment (State MethodState [ClassName] -> MS (r Doc))
-> State MethodState [ClassName] -> MS (r Doc)
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
(\[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 :: (RenderMethod r mthd) => FuncDocRenderer -> String -> [String] ->
Maybe String -> MS (r mthd) -> MS (r mthd)
docFunc :: forall (r :: * -> *) mthd.
RenderMethod r mthd =>
FuncDocRenderer
-> ClassName
-> [ClassName]
-> Maybe ClassName
-> MS (r mthd)
-> MS (r mthd)
docFunc FuncDocRenderer
f ClassName
desc [ClassName]
pComms Maybe ClassName
rComm = FuncDocRenderer
-> ClassName
-> [ClassName]
-> [ClassName]
-> MS (r mthd)
-> MS (r mthd)
forall (r :: * -> *) mthd.
RenderMethod r mthd =>
FuncDocRenderer
-> ClassName
-> [ClassName]
-> [ClassName]
-> MS (r mthd)
-> MS (r mthd)
docFuncRepr FuncDocRenderer
f ClassName
desc [ClassName]
pComms (Maybe ClassName -> [ClassName]
forall a. Maybe a -> [a]
maybeToList Maybe ClassName
rComm)
buildClass
:: (RenderClass r vis mthd stvr, VisibilitySym r vis)
=> Maybe Label -> [CSStateVar r stvr] -> [MS (r mthd)] -> [MS (r mthd)] -> CS (r Class)
buildClass :: forall (r :: * -> *) vis mthd stvr.
(RenderClass r vis mthd stvr, VisibilitySym r vis) =>
Maybe ClassName
-> [CSStateVar r stvr]
-> [MS (r mthd)]
-> [MS (r mthd)]
-> CS (r Doc)
buildClass Maybe ClassName
p [CSStateVar r stvr]
stVars [MS (r mthd)]
constructors [MS (r mthd)]
methods = do
n <- LensLike'
(Zoomed (StateT FileState Identity) ClassName) ClassState FileState
-> StateT FileState Identity ClassName
-> StateT ClassState Identity ClassName
forall c.
LensLike'
(Zoomed (StateT FileState Identity) c) ClassState FileState
-> StateT FileState Identity c -> StateT ClassState 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 FileState Identity) ClassName) ClassState FileState
(FileState -> Focusing Identity ClassName FileState)
-> ClassState -> Focusing Identity ClassName ClassState
Lens' ClassState FileState
lensCStoFS StateT FileState Identity ClassName
getModuleName
RO.intClass n public (inherit p) stVars constructors methods
implementingClass :: (RenderClass r vis mthd stvr, VisibilitySym r vis) => Label -> [Label] ->
[CSStateVar r stvr] -> [MS (r mthd)] -> [MS (r mthd)] -> CS (r Class)
implementingClass :: forall (r :: * -> *) vis mthd stvr.
(RenderClass r vis mthd stvr, VisibilitySym r vis) =>
ClassName
-> [ClassName]
-> [CSStateVar r stvr]
-> [MS (r mthd)]
-> [MS (r mthd)]
-> CS (r Doc)
implementingClass ClassName
n [ClassName]
is = ClassName
-> r vis
-> r Doc
-> [CSStateVar r stvr]
-> [MS (r mthd)]
-> [MS (r mthd)]
-> CS (r Doc)
forall (r :: * -> *) vis mthd stvr.
RenderClass r vis mthd stvr =>
ClassName
-> r vis
-> r Doc
-> [CSStateVar r stvr]
-> [MS (r mthd)]
-> [MS (r mthd)]
-> CS (r Doc)
RO.intClass ClassName
n r vis
forall {k} (r :: k -> *) (vis :: k). VisibilitySym r vis => r vis
public ([ClassName] -> r Doc
forall (r :: * -> *) vis mthd stvr.
RenderClass r vis mthd stvr =>
[ClassName] -> r Doc
implements [ClassName]
is)
docClass
:: (RenderClass r vis mthd stvr)
=> ClassDocRenderer -> String -> CS (r Class) -> CS (r Class)
docClass :: forall (r :: * -> *) vis mthd stvr.
RenderClass r vis mthd stvr =>
ClassDocRenderer -> ClassName -> CS (r Doc) -> CS (r Doc)
docClass ClassDocRenderer
cdr ClassName
d = CS (r Doc) -> CS (r Doc) -> CS (r Doc)
forall (r :: * -> *) vis mthd stvr.
RenderClass r vis mthd stvr =>
CS (r Doc) -> CS (r Doc) -> CS (r Doc)
RO.commentedClass (State ClassState [ClassName] -> CS (r Doc)
forall a. State a [ClassName] -> State a (r Doc)
forall (r :: * -> *) a.
BlockCommentSym r =>
State a [ClassName] -> State a (r Doc)
docComment (State ClassState [ClassName] -> CS (r Doc))
-> State ClassState [ClassName] -> CS (r Doc)
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
:: (RC.BlockCommentElim r, RO.ClassElim r, Monad r)
=> CS (r Doc) -> CS (r Class) -> CS (r Doc)
= (r Doc -> r Doc -> r Doc)
-> State ClassState (r Doc)
-> State ClassState (r Doc)
-> State ClassState (r Doc)
forall a b c s.
(a -> b -> c) -> State s a -> State s b -> State s c
on2StateValues (\r Doc
cmt r Doc
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 Doc -> Doc
forall (r :: * -> *). BlockCommentElim r => r Doc -> Doc
RC.blockComment' r Doc
cmt) (r Doc -> Doc
forall (r :: * -> *). ClassElim r => r Doc -> Doc
RO.class' r Doc
cs))
modFromData :: Label -> (Doc -> r mod) -> FS Doc -> FS (r mod)
modFromData :: forall {k} (r :: k -> *) (mod :: k).
ClassName -> (Doc -> r mod) -> FS Doc -> FS (r mod)
modFromData ClassName
n Doc -> r mod
f 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 ()
-> StateT FileState Identity (r mod)
-> StateT FileState Identity (r mod)
forall a b.
StateT FileState Identity a
-> StateT FileState Identity b -> StateT FileState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Doc -> r mod) -> FS Doc -> StateT FileState Identity (r mod)
forall a b s. (a -> b) -> State s a -> State s b
onStateValue Doc -> r mod
f FS Doc
d
fileDoc
:: (RC.BlockElim r block, RenderMod r mod, RenderFile r file mod)
=> String -> (r mod -> r block) -> r block -> FS (r mod) -> FS (r file)
fileDoc :: forall (r :: * -> *) block mod file.
(BlockElim r block, RenderMod r mod, RenderFile r file mod) =>
ClassName
-> (r mod -> r block) -> r block -> FS (r mod) -> FS (r file)
fileDoc ClassName
ext r mod -> r block
topb r block
botb FS (r mod)
mdl = do
m <- FS (r mod)
mdl
nm <- getModuleName
let fp = ClassName -> ClassName -> ClassName
addExt ClassName
ext ClassName
nm
updm = (Doc -> Doc) -> r mod -> r mod
forall {k} (r :: k -> *) (mod :: k).
RenderMod r mod =>
(Doc -> Doc) -> r mod -> r mod
updateModuleDoc (\Doc
d -> Doc -> Doc -> Doc
emptyIfEmpty Doc
d
(Doc -> Doc -> Doc -> Doc
R.file (r block -> Doc
forall {k} (r :: k -> *) (block :: k).
BlockElim r block =>
r block -> Doc
RC.block (r block -> Doc) -> r block -> Doc
forall a b. (a -> b) -> a -> b
$ r mod -> r block
topb r mod
m) Doc
d (r block -> Doc
forall {k} (r :: k -> *) (block :: k).
BlockElim r block =>
r block -> Doc
RC.block r block
botb))) r mod
m
RO.fileFromData fp (toState updm)
docMod
:: (RenderFile r file mod)
=> ModuleDocRenderer
-> String
-> String
-> String
-> [String]
-> String
-> FS (r file)
-> FS (r file)
docMod :: forall (r :: * -> *) file mod.
RenderFile r file mod =>
ModuleDocRenderer
-> ClassName
-> ClassName
-> ClassName
-> [ClassName]
-> ClassName
-> FS (r file)
-> FS (r file)
docMod ModuleDocRenderer
mdr ClassName
e ClassName
wm ClassName
d [ClassName]
a ClassName
dt FS (r file)
fl = FS (r file) -> FS (r Doc) -> FS (r file)
forall (r :: * -> *) file mod.
RenderFile r file mod =>
FS (r file) -> FS (r Doc) -> FS (r file)
commentedMod FS (r file)
fl (State FileState [ClassName] -> FS (r Doc)
forall a. State a [ClassName] -> State a (r Doc)
forall (r :: * -> *) a.
BlockCommentSym r =>
State a [ClassName] -> State a (r Doc)
docComment (State FileState [ClassName] -> FS (r Doc))
-> State FileState [ClassName] -> FS (r Doc)
forall a b. (a -> b) -> a -> b
$ ModuleDocRenderer
mdr ClassName
wm 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
:: (RO.ModuleElim r mod)
=> (FilePath -> r mod -> r file) -> FilePath -> FS (r mod) -> FS (r file)
fileFromData :: forall {k} (r :: k -> *) (mod :: k) (file :: k).
ModuleElim r mod =>
(ClassName -> r mod -> r file)
-> ClassName -> FS (r mod) -> FS (r file)
fileFromData ClassName -> r mod -> r file
f ClassName
fpath FS (r mod)
mdl' = do
mdl <- FS (r mod)
mdl'
modify (\FileState
s -> if Doc -> Bool
isEmpty (r mod -> Doc
forall {k} (r :: k -> *) (mod :: k).
ModuleElim r mod =>
r mod -> Doc
RO.module' r mod
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 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)
return $ f fpath mdl
setEmpty :: (RenderStatement r stmt, StatementElim r stmt) => MS (r stmt) -> MS (r stmt)
setEmpty :: forall {k} (r :: k -> *) (stmt :: k).
(RenderStatement r stmt, StatementElim r stmt) =>
MS (r stmt) -> MS (r stmt)
setEmpty MS (r stmt)
s' = MS (r stmt)
s' MS (r stmt) -> (r stmt -> MS (r stmt)) -> MS (r stmt)
forall a b.
StateT MethodState Identity a
-> (a -> StateT MethodState Identity b)
-> StateT MethodState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Doc -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k).
RenderStatement r stmt =>
Doc -> MS (r stmt)
mkStmtNoEnd (Doc -> MS (r stmt)) -> (r stmt -> Doc) -> r stmt -> MS (r stmt)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r stmt -> Doc
forall {k} (r :: k -> *) (stmt :: k).
StatementElim r stmt =>
r stmt -> Doc
RC.statement