module Drasil.Shared.LanguageRenderer.Common (
boolRender, bool, extVar, funcType, extFuncAppMixedArgs, listAccessFunc,
listSetFunc, forEach', varDecDef, listSize
) where
import Prelude hiding (print, pi, (<>))
import Control.Lens.Zoom (zoom)
import Control.Monad (join)
import Control.Monad.State (modify)
import Text.PrettyPrint.HughesPJ (text, empty, Doc)
import Drasil.Shared.CodeType (CodeType(..))
import Drasil.Shared.InterfaceCommon (VSType, SVariable, TypeElim(getType),
MixedCall, SValue, VSFunction, ValueSym(valueType, Value), MSBody,
MSStatement, VariableElim(variableName), VariableSym(Variable), Label,
Library, BodySym(Body), ScopeSym(Scope))
import Drasil.Shared.RendererClassesCommon (scopeData, CommonRenderSym, typeFromData, call, RenderFunction(funcFromData))
import Drasil.Shared.LanguageRenderer (access, intValue)
import qualified Drasil.Shared.LanguageRenderer as R (extVar, listAccessFunc)
import qualified Drasil.Shared.RendererClassesCommon as RC (value, functionType, function)
import Drasil.Shared.LanguageRenderer.Constructors
import Drasil.Shared.Helpers (on2StateValues, onStateValue)
import Drasil.Shared.State (lensMStoVS, useVarName, setVarScope)
import qualified Drasil.Shared.InterfaceCommon as IC (emptyStmt, assign)
import qualified Drasil.Shared.RendererClassesCommon as S (listSizeFunc)
boolRender :: String
boolRender :: String
boolRender = String
"Bool"
bool :: (CommonRenderSym r) => VSType r
bool :: forall (r :: * -> *). CommonRenderSym r => VSType r
bool = CodeType
-> String -> Doc -> StateT ValueState Identity (r (Type r))
forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData CodeType
Boolean String
boolRender (String -> Doc
text String
boolRender)
extVar :: (CommonRenderSym r) => Label -> Label -> VSType r -> SVariable r
extVar :: forall (r :: * -> *).
CommonRenderSym r =>
String -> String -> VSType r -> SVariable r
extVar String
l String
n VSType r
t = String
-> VSType r -> Doc -> StateT ValueState Identity (r (Variable r))
forall (r :: * -> *).
CommonRenderSym r =>
String -> VSType r -> Doc -> SVariable r
mkStateVar (String
l String -> String -> String
`access` String
n) VSType r
t (String -> String -> Doc
R.extVar String
l String
n)
funcType :: (CommonRenderSym r) => [VSType r] -> VSType r -> VSType r
funcType :: forall (r :: * -> *).
CommonRenderSym r =>
[VSType r] -> VSType r -> VSType r
funcType [VSType r]
ps' VSType r
r' = do
[r (Type r)]
ps <- [VSType r] -> StateT ValueState Identity [r (Type r)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [VSType r]
ps'
r (Type r)
r <- VSType r
r'
CodeType -> String -> Doc -> VSType r
forall (r :: * -> *).
RenderType r =>
CodeType -> String -> Doc -> VSType r
typeFromData ([CodeType] -> CodeType -> CodeType
Func ((r (Type r) -> CodeType) -> [r (Type r)] -> [CodeType]
forall a b. (a -> b) -> [a] -> [b]
map r (Type r) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType [r (Type r)]
ps) (r (Type r) -> CodeType
forall (r :: * -> *). TypeElim r => r (Type r) -> CodeType
getType r (Type r)
r)) String
"" Doc
empty
extFuncAppMixedArgs :: (CommonRenderSym r) => Library -> MixedCall r
extFuncAppMixedArgs :: forall (r :: * -> *). CommonRenderSym r => String -> MixedCall r
extFuncAppMixedArgs String
l = Maybe String
-> Maybe Doc
-> String
-> StateT ValueState Identity (r (Type r))
-> [StateT ValueState Identity (r (Value r))]
-> [(StateT ValueState Identity (r (Variable r)),
StateT ValueState Identity (r (Value r)))]
-> StateT ValueState Identity (r (Value r))
forall (r :: * -> *).
RenderValue r =>
Maybe String -> Maybe Doc -> MixedCall r
call (String -> Maybe String
forall a. a -> Maybe a
Just String
l) Maybe Doc
forall a. Maybe a
Nothing
listAccessFunc :: (CommonRenderSym r) => VSType r -> SValue r -> VSFunction r
listAccessFunc :: forall (r :: * -> *).
CommonRenderSym r =>
VSType r -> SValue r -> VSFunction r
listAccessFunc VSType r
t SValue r
v = SValue r -> SValue r
forall (r :: * -> *). CommonRenderSym r => SValue r -> SValue r
intValue SValue r
v SValue r
-> (r (Value r) -> StateT ValueState Identity (r (Function r)))
-> StateT ValueState Identity (r (Function 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
>>= ((Doc -> VSType r -> StateT ValueState Identity (r (Function r))
forall (r :: * -> *).
RenderFunction r =>
Doc -> VSType r -> VSFunction r
`funcFromData` VSType r
t) (Doc -> StateT ValueState Identity (r (Function r)))
-> (r (Value r) -> Doc)
-> r (Value r)
-> StateT ValueState Identity (r (Function r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r (Value r) -> Doc
forall (r :: * -> *). CommonRenderSym r => r (Value r) -> Doc
R.listAccessFunc)
listSetFunc :: (CommonRenderSym r) => (Doc -> Doc -> Doc) -> SValue r -> SValue r ->
SValue r -> VSFunction r
listSetFunc :: forall (r :: * -> *).
CommonRenderSym r =>
(Doc -> Doc -> Doc)
-> SValue r -> SValue r -> SValue r -> VSFunction r
listSetFunc Doc -> Doc -> Doc
f SValue r
v SValue r
idx SValue r
setVal = StateT
ValueState Identity (StateT ValueState Identity (r (Function r)))
-> StateT ValueState Identity (r (Function r))
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (StateT
ValueState Identity (StateT ValueState Identity (r (Function r)))
-> StateT ValueState Identity (r (Function r)))
-> StateT
ValueState Identity (StateT ValueState Identity (r (Function r)))
-> StateT ValueState Identity (r (Function r))
forall a b. (a -> b) -> a -> b
$ (r (Value r)
-> r (Value r) -> StateT ValueState Identity (r (Function r)))
-> SValue r
-> SValue r
-> StateT
ValueState Identity (StateT ValueState Identity (r (Function r)))
forall a b c s.
(a -> b -> c) -> State s a -> State s b -> State s c
on2StateValues (\r (Value r)
i r (Value r)
toVal -> Doc -> VSType r -> StateT ValueState Identity (r (Function r))
forall (r :: * -> *).
RenderFunction r =>
Doc -> VSType r -> VSFunction r
funcFromData
(Doc -> Doc -> Doc
f (r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
i) (r (Value r) -> Doc
forall (r :: * -> *). ValueElim r => r (Value r) -> Doc
RC.value r (Value r)
toVal)) ((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 -> SValue r
forall (r :: * -> *). CommonRenderSym r => SValue r -> SValue r
intValue SValue r
idx)
SValue r
setVal
forEach' :: (CommonRenderSym r) => (r (Variable r) -> r (Value r) -> r (Body r) -> Doc)
-> SVariable r -> SValue r -> MSBody r -> MSStatement r
forEach' :: forall (r :: * -> *).
CommonRenderSym r =>
(r (Variable r) -> r (Value r) -> r (Body r) -> Doc)
-> SVariable r -> SValue r -> MSBody r -> MSStatement r
forEach' r (Variable r) -> r (Value r) -> r (Body r) -> Doc
f SVariable r
i' SValue r
v' MSBody r
b' = do
r (Variable r)
i <- LensLike'
(Zoomed (StateT ValueState Identity) (r (Variable r)))
MethodState
ValueState
-> SVariable r -> StateT MethodState Identity (r (Variable r))
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 r)))
MethodState
ValueState
(ValueState -> Focusing Identity (r (Variable r)) ValueState)
-> MethodState -> Focusing Identity (r (Variable r)) MethodState
Lens' MethodState ValueState
lensMStoVS SVariable r
i'
r (Value r)
v <- LensLike'
(Zoomed (StateT ValueState Identity) (r (Value r)))
MethodState
ValueState
-> SValue r -> StateT MethodState Identity (r (Value r))
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 r)))
MethodState
ValueState
(ValueState -> Focusing Identity (r (Value r)) ValueState)
-> MethodState -> Focusing Identity (r (Value r)) MethodState
Lens' MethodState ValueState
lensMStoVS SValue r
v'
r (Body r)
b <- MSBody r
b'
Doc -> MSStatement r
forall (r :: * -> *). CommonRenderSym r => Doc -> MSStatement r
mkStmtNoEnd (r (Variable r) -> r (Value r) -> r (Body r) -> Doc
f r (Variable r)
i r (Value r)
v r (Body r)
b)
varDecDef :: (CommonRenderSym r) => SVariable r -> r (Scope r) -> Maybe (SValue r)
-> MSStatement r
varDecDef :: forall (r :: * -> *).
CommonRenderSym r =>
SVariable r -> r (Scope r) -> Maybe (SValue r) -> MSStatement r
varDecDef SVariable r
v r (Scope r)
scp Maybe (SValue r)
e = do
r (Variable r)
v' <- LensLike'
(Zoomed (StateT ValueState Identity) (r (Variable r)))
MethodState
ValueState
-> SVariable r -> StateT MethodState Identity (r (Variable r))
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 r)))
MethodState
ValueState
(ValueState -> Focusing Identity (r (Variable r)) ValueState)
-> MethodState -> Focusing Identity (r (Variable r)) MethodState
Lens' MethodState ValueState
lensMStoVS SVariable r
v
(MethodState -> MethodState) -> StateT MethodState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((MethodState -> MethodState) -> StateT MethodState Identity ())
-> (MethodState -> MethodState) -> StateT MethodState Identity ()
forall a b. (a -> b) -> a -> b
$ String -> MethodState -> MethodState
useVarName (r (Variable r) -> String
forall (r :: * -> *). VariableElim r => r (Variable r) -> String
variableName r (Variable r)
v')
(MethodState -> MethodState) -> StateT MethodState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((MethodState -> MethodState) -> StateT MethodState Identity ())
-> (MethodState -> MethodState) -> StateT MethodState Identity ()
forall a b. (a -> b) -> a -> b
$ String -> ScopeData -> MethodState -> MethodState
setVarScope (r (Variable r) -> String
forall (r :: * -> *). VariableElim r => r (Variable r) -> String
variableName r (Variable r)
v') (r (Scope r) -> ScopeData
forall (r :: * -> *). ScopeElim r => r (Scope r) -> ScopeData
scopeData r (Scope r)
scp)
Maybe (SValue r) -> MSStatement r
def Maybe (SValue r)
e
where
def :: Maybe (SValue r) -> MSStatement r
def Maybe (SValue r)
Nothing = MSStatement r
forall (r :: * -> *). StatementSym r => MSStatement r
IC.emptyStmt
def (Just SValue r
d) = SVariable r -> SValue r -> MSStatement r
forall (r :: * -> *).
AssignStatement r =>
SVariable r -> SValue r -> MSStatement r
IC.assign SVariable r
v SValue r
d
listSize :: (CommonRenderSym r) => SValue r -> SValue r
listSize :: forall (r :: * -> *). CommonRenderSym r => SValue r -> SValue r
listSize SValue r
l = do
r (Function r)
f <- SValue r -> StateT ValueState Identity (r (Function r))
forall (r :: * -> *).
InternalListFunc r =>
SValue r -> VSFunction r
S.listSizeFunc SValue r
l
r (Type r) -> Doc -> SValue r
forall (r :: * -> *).
CommonRenderSym r =>
r (Type r) -> Doc -> SValue r
mkVal (r (Function r) -> r (Type r)
forall (r :: * -> *).
FunctionElim r =>
r (Function r) -> r (Type r)
RC.functionType r (Function r)
f) (r (Function r) -> Doc
forall (r :: * -> *). FunctionElim r => r (Function r) -> Doc
RC.function r (Function r)
f)