module Language.Drasil.Code.Imperative.Logging (
maybeLog, logBody, loggedMethod, varLogFile
) where
import Control.Lens ((^.))
import Control.Lens.Zoom (zoom)
import Control.Monad.State (get)
import Language.Drasil.Code.Imperative.DrasilState (GenState, DrasilState(..),
HasChoices(..))
import Language.Drasil.Choices (Logging(..))
import Drasil.GOOL (Label, MSBody, MSBlock, SVariable, SValue, MSStatement,
SharedProg, BodySym(..), BlockSym(..), TypeSym(..), var, VariableElim(..),
Literal(..), VariableValue(..), StatementSym(..), DeclStatement(..),
IOStatement(..), lensMStoVS, ScopeSym(..), LoggingFor(..))
import Text.PrettyPrint.HughesPJ (render)
maybeLog :: (SharedProg r) => SVariable (LoggingFor r) -> SVariable r -> GenState [MSStatement r]
maybeLog :: forall (r :: * -> *).
SharedProg r =>
SVariable (LoggingFor r) -> SVariable r -> GenState [MSStatement r]
maybeLog SVariable (LoggingFor r)
vlog SVariable r
v = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
[StateT DrasilState Identity (MSStatement r)]
-> GenState [MSStatement 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 [SVariable (LoggingFor r)
-> SVariable r -> StateT DrasilState Identity (MSStatement r)
forall (r :: * -> *).
SharedProg r =>
SVariable (LoggingFor r) -> SVariable r -> GenState (MSStatement r)
loggedVar SVariable (LoggingFor r)
vlog SVariable r
v | Logging
LogVar Logging -> [Logging] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState
g DrasilState -> Getting [Logging] DrasilState [Logging] -> [Logging]
forall s a. s -> Getting a s a -> a
^. Getting [Logging] DrasilState [Logging]
forall a. HasChoices a => Lens' a [Logging]
Lens' DrasilState [Logging]
logKind]
loggedVar :: (SharedProg r) => SVariable (LoggingFor r) -> SVariable r -> GenState (MSStatement r)
loggedVar :: forall (r :: * -> *).
SharedProg r =>
SVariable (LoggingFor r) -> SVariable r -> GenState (MSStatement r)
loggedVar SVariable (LoggingFor r)
vlog SVariable r
v = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
MSStatement r -> GenState (MSStatement r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MSStatement r -> GenState (MSStatement r))
-> MSStatement r -> GenState (MSStatement r)
forall a b. (a -> b) -> a -> b
$ [MSStatement r] -> MSStatement r
forall (r :: * -> *).
StatementSym r =>
[MSStatement r] -> MSStatement r
multi [
SVariable r -> SValue r -> MSStatement r
forall (r :: * -> *).
IOStatement r =>
SVariable r -> SValue r -> MSStatement r
openFileA SVariable r
forall (r :: * -> *). SharedProg r => SVariable r
varLogFile (String -> SValue r
forall (r :: * -> *). Literal r => String -> SValue r
litString (String -> SValue r) -> String -> SValue r
forall a b. (a -> b) -> a -> b
$ DrasilState
g DrasilState -> Getting String DrasilState String -> String
forall s a. s -> Getting a s a -> a
^. Getting String DrasilState String
forall a. HasChoices a => Lens' a String
Lens' DrasilState String
logName),
do
LoggingFor r Doc
vlog' <- LensLike'
(Zoomed (StateT ValueState Identity) (LoggingFor r Doc))
MethodState
ValueState
-> StateT ValueState Identity (LoggingFor r Doc)
-> StateT MethodState Identity (LoggingFor r Doc)
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) (LoggingFor r Doc))
MethodState
ValueState
(ValueState -> Focusing Identity (LoggingFor r Doc) ValueState)
-> MethodState -> Focusing Identity (LoggingFor r Doc) MethodState
Lens' MethodState ValueState
lensMStoVS StateT ValueState Identity (LoggingFor r Doc)
SVariable (LoggingFor r)
vlog
SValue r -> String -> MSStatement r
forall (r :: * -> *).
IOStatement r =>
SValue r -> String -> MSStatement r
printFileStr SValue r
forall (r :: * -> *). SharedProg r => SValue r
valLogFile (String
"var '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Doc -> String
render (Doc -> String)
-> (LoggingFor r Doc -> Doc) -> LoggingFor r Doc -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoggingFor r Doc -> Doc
forall (lang :: * -> *) a. LoggingFor lang a -> a
unLC) LoggingFor r Doc
vlog' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' assigned "),
SValue r -> SValue r -> MSStatement r
forall (r :: * -> *).
IOStatement r =>
SValue r -> SValue r -> MSStatement r
printFile SValue r
forall (r :: * -> *). SharedProg r => SValue r
valLogFile (SVariable r -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable r
v),
SValue r -> String -> MSStatement r
forall (r :: * -> *).
IOStatement r =>
SValue r -> String -> MSStatement r
printFileStrLn SValue r
forall (r :: * -> *). SharedProg r => SValue r
valLogFile (String
" in module " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DrasilState -> String
currentModule DrasilState
g),
SValue r -> MSStatement r
forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
closeFile SValue r
forall (r :: * -> *). SharedProg r => SValue r
valLogFile]
logBody :: (SharedProg r) => Label -> [SVariable r] -> [MSBlock r] ->
GenState (MSBody r)
logBody :: forall (r :: * -> *).
SharedProg r =>
String -> [SVariable r] -> [MSBlock r] -> GenState (MSBody r)
logBody String
n [SVariable r]
vars [MSBlock r]
b = do
DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
MSBody r -> GenState (MSBody r)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (MSBody r -> GenState (MSBody r))
-> MSBody r -> GenState (MSBody r)
forall a b. (a -> b) -> a -> b
$ [MSBlock r] -> MSBody r
forall (r :: * -> *). BodySym r => [MSBlock r] -> MSBody r
body ([MSBlock r] -> MSBody r) -> [MSBlock r] -> MSBody r
forall a b. (a -> b) -> a -> b
$
[String -> String -> [SVariable r] -> MSBlock r
forall (r :: * -> *).
SharedProg r =>
String -> String -> [SVariable r] -> MSBlock r
loggedMethod (DrasilState
g DrasilState -> Getting String DrasilState String -> String
forall s a. s -> Getting a s a -> a
^. Getting String DrasilState String
forall a. HasChoices a => Lens' a String
Lens' DrasilState String
logName) String
n [SVariable r]
vars | Logging
LogFunc Logging -> [Logging] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DrasilState
g DrasilState -> Getting [Logging] DrasilState [Logging] -> [Logging]
forall s a. s -> Getting a s a -> a
^. Getting [Logging] DrasilState [Logging]
forall a. HasChoices a => Lens' a [Logging]
Lens' DrasilState [Logging]
logKind] [MSBlock r] -> [MSBlock r] -> [MSBlock r]
forall a. [a] -> [a] -> [a]
++ [MSBlock r]
b
loggedMethod :: (SharedProg r) => FilePath -> Label -> [SVariable r] -> MSBlock r
loggedMethod :: forall (r :: * -> *).
SharedProg r =>
String -> String -> [SVariable r] -> MSBlock r
loggedMethod String
lName String
n [SVariable r]
vars = [MSStatement r] -> StateT MethodState Identity (r (Block r))
forall (r :: * -> *). BlockSym r => [MSStatement r] -> MSBlock r
block [
SVariable r -> r ScopeData -> MSStatement r
forall (r :: * -> *).
DeclStatement r =>
SVariable r -> r ScopeData -> MSStatement r
varDec SVariable r
forall (r :: * -> *). SharedProg r => SVariable r
varLogFile r ScopeData
forall (r :: * -> *). ScopeSym r => r ScopeData
local,
SVariable r -> SValue r -> MSStatement r
forall (r :: * -> *).
IOStatement r =>
SVariable r -> SValue r -> MSStatement r
openFileA SVariable r
forall (r :: * -> *). SharedProg r => SVariable r
varLogFile (String -> SValue r
forall (r :: * -> *). Literal r => String -> SValue r
litString String
lName),
SValue r -> String -> MSStatement r
forall (r :: * -> *).
IOStatement r =>
SValue r -> String -> MSStatement r
printFileStrLn SValue r
forall (r :: * -> *). SharedProg r => SValue r
valLogFile (String
"function " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" called with inputs: {"),
[MSStatement r] -> MSStatement r
forall (r :: * -> *).
StatementSym r =>
[MSStatement r] -> MSStatement r
multi ([MSStatement r] -> MSStatement r)
-> [MSStatement r] -> MSStatement r
forall a b. (a -> b) -> a -> b
$ [SVariable r] -> [MSStatement r]
forall {r :: * -> *}.
SharedProg r =>
[StateT ValueState Identity (r (Variable r))]
-> [StateT MethodState Identity (r (Statement r))]
printInputs [SVariable r]
vars,
SValue r -> String -> MSStatement r
forall (r :: * -> *).
IOStatement r =>
SValue r -> String -> MSStatement r
printFileStrLn SValue r
forall (r :: * -> *). SharedProg r => SValue r
valLogFile String
" }",
SValue r -> MSStatement r
forall (r :: * -> *). IOStatement r => SValue r -> MSStatement r
closeFile SValue r
forall (r :: * -> *). SharedProg r => SValue r
valLogFile]
where
printInputs :: [StateT ValueState Identity (r (Variable r))]
-> [StateT MethodState Identity (r (Statement r))]
printInputs [] = []
printInputs [StateT ValueState Identity (r (Variable r))
v] = [
LensLike'
(Zoomed (StateT ValueState Identity) (r (Variable r)))
MethodState
ValueState
-> StateT ValueState Identity (r (Variable 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 StateT ValueState Identity (r (Variable r))
v StateT MethodState Identity (r (Variable r))
-> (r (Variable r)
-> StateT MethodState Identity (r (Statement r)))
-> StateT MethodState Identity (r (Statement r))
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 r)
v' -> SValue r -> String -> StateT MethodState Identity (r (Statement r))
forall (r :: * -> *).
IOStatement r =>
SValue r -> String -> MSStatement r
printFileStr SValue r
forall (r :: * -> *). SharedProg r => SValue r
valLogFile (String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++
r (Variable r) -> String
forall (r :: * -> *). VariableElim r => r (Variable r) -> String
variableName r (Variable r)
v' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = ")),
SValue r
-> SValue r -> StateT MethodState Identity (r (Statement r))
forall (r :: * -> *).
IOStatement r =>
SValue r -> SValue r -> MSStatement r
printFileLn SValue r
forall (r :: * -> *). SharedProg r => SValue r
valLogFile (StateT ValueState Identity (r (Variable r)) -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf StateT ValueState Identity (r (Variable r))
v)]
printInputs (StateT ValueState Identity (r (Variable r))
v:[StateT ValueState Identity (r (Variable r))]
vs) = [
LensLike'
(Zoomed (StateT ValueState Identity) (r (Variable r)))
MethodState
ValueState
-> StateT ValueState Identity (r (Variable 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 StateT ValueState Identity (r (Variable r))
v StateT MethodState Identity (r (Variable r))
-> (r (Variable r)
-> StateT MethodState Identity (r (Statement r)))
-> StateT MethodState Identity (r (Statement r))
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 r)
v' -> SValue r -> String -> StateT MethodState Identity (r (Statement r))
forall (r :: * -> *).
IOStatement r =>
SValue r -> String -> MSStatement r
printFileStr SValue r
forall (r :: * -> *). SharedProg r => SValue r
valLogFile (String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++
r (Variable r) -> String
forall (r :: * -> *). VariableElim r => r (Variable r) -> String
variableName r (Variable r)
v' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = ")),
SValue r
-> SValue r -> StateT MethodState Identity (r (Statement r))
forall (r :: * -> *).
IOStatement r =>
SValue r -> SValue r -> MSStatement r
printFile SValue r
forall (r :: * -> *). SharedProg r => SValue r
valLogFile (StateT ValueState Identity (r (Variable r)) -> SValue r
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf StateT ValueState Identity (r (Variable r))
v),
SValue r -> String -> StateT MethodState Identity (r (Statement r))
forall (r :: * -> *).
IOStatement r =>
SValue r -> String -> MSStatement r
printFileStrLn SValue r
forall (r :: * -> *). SharedProg r => SValue r
valLogFile String
", "] [StateT MethodState Identity (r (Statement r))]
-> [StateT MethodState Identity (r (Statement r))]
-> [StateT MethodState Identity (r (Statement r))]
forall a. [a] -> [a] -> [a]
++ [StateT ValueState Identity (r (Variable r))]
-> [StateT MethodState Identity (r (Statement r))]
printInputs [StateT ValueState Identity (r (Variable r))]
vs
varLogFile :: (SharedProg r) => SVariable r
varLogFile :: forall (r :: * -> *). SharedProg r => SVariable r
varLogFile = String -> VSType r -> StateT ValueState Identity (r (Variable r))
forall (r :: * -> *).
VariableSym r =>
String -> VSType r -> SVariable r
var String
"outfile" VSType r
forall (r :: * -> *). TypeSym r => VSType r
outfile
valLogFile :: (SharedProg r) => SValue r
valLogFile :: forall (r :: * -> *). SharedProg r => SValue r
valLogFile = SVariable r -> StateT ValueState Identity (r (Value r))
forall (r :: * -> *). VariableValue r => SVariable r -> SValue r
valueOf SVariable r
forall (r :: * -> *). SharedProg r => SVariable r
varLogFile