module Language.Drasil.Code.Imperative.Logging (
  logBody, loggedMethod, varLogFile
) where

import Control.Lens ((^.))
import Control.Lens.Zoom (zoom)
import Control.Monad.State (get)

import Language.Drasil.Code.Imperative.DrasilState (GenState, HasChoices(..))
import Language.Drasil.Choices (Logging(..))

import Drasil.GOOL (Label, block, VS, MS, BodySym(..), BlockSym(..), TypeSym(..),
  var, VariableElim(..), Literal(..), VariableValue(..), MultiStatement(..),
  DeclStatement(..), FileHandling(..), PrintFile(..), lensMStoVS, ScopeSym(..),
  VariableSym)

-- | Generates the body of a function with the given name, list of parameters,
-- and blocks to include in the body. If the user chose to turn on logging of
-- function calls, statements that log how the function was called are added to
-- the beginning of the body.
logBody
  ::
    ( TypeSym r typ
    , Literal r val typ
    , VariableSym r var typ
    , VariableValue r var val
    , ScopeSym r scope
    , MultiStatement r stmt
    , DeclStatement r bod stmt var scope val
    , FileHandling r stmt var val
    , PrintFile r stmt val
    , BlockSym r block stmt
    , BodySym r bod block
    , VariableElim r var typ
    )
  => Label -> [VS (r var)] -> [MS (r block)] -> GenState (MS (r bod))
logBody :: forall {k} (r :: k -> *) (typ :: k) (val :: k) (var :: k)
       (scope :: k) (stmt :: k) (bod :: k) (block :: k).
(TypeSym r typ, Literal r val typ, VariableSym r var typ,
 VariableValue r var val, ScopeSym r scope, MultiStatement r stmt,
 DeclStatement r bod stmt var scope val,
 FileHandling r stmt var val, PrintFile r stmt val,
 BlockSym r block stmt, BodySym r bod block,
 VariableElim r var typ) =>
Label -> [VS (r var)] -> [MS (r block)] -> GenState (MS (r bod))
logBody Label
n [VS (r var)]
vars [MS (r block)]
b = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  pure $ body $
    [loggedMethod (g ^. logName) n vars | LogFunc `elem` g ^. logKind] <> b

-- | Generates a block that logs, to the given 'FilePath', the name of a function,
-- and the names and values of the passed list of variables. Intended to be
-- used as the first block in the function, to log that it was called and what
-- inputs it was called with.
loggedMethod
  ::
    ( TypeSym r typ
    , Literal r val typ
    , VariableSym r var typ
    , VariableValue r var val
    , ScopeSym r scope
    , MultiStatement r stmt
    , DeclStatement r bod stmt var scope val
    , FileHandling r stmt var val
    , PrintFile r stmt val
    , BlockSym r block stmt
    , VariableElim r var typ
    )
  => FilePath -> Label -> [VS (r var)] -> MS (r block)
loggedMethod :: forall {k} (r :: k -> *) (typ :: k) (val :: k) (var :: k)
       (scope :: k) (stmt :: k) (bod :: k) (block :: k).
(TypeSym r typ, Literal r val typ, VariableSym r var typ,
 VariableValue r var val, ScopeSym r scope, MultiStatement r stmt,
 DeclStatement r bod stmt var scope val,
 FileHandling r stmt var val, PrintFile r stmt val,
 BlockSym r block stmt, VariableElim r var typ) =>
Label -> Label -> [VS (r var)] -> MS (r block)
loggedMethod Label
lName Label
n [VS (r var)]
vars = [MS (r stmt)] -> MS (r block)
forall {k} (r :: k -> *) (block :: k) (stmt :: k).
BlockSym r block stmt =>
[MS (r stmt)] -> MS (r block)
block [
      VS (r var) -> r scope -> MS (r stmt)
forall {k} (r :: k -> *) (bod :: k) (stmt :: k) (var :: k)
       (scope :: k) (val :: k).
DeclStatement r bod stmt var scope val =>
VS (r var) -> r scope -> MS (r stmt)
varDec VS (r var)
forall {k} (r :: k -> *) (typ :: k) (var :: k).
(TypeSym r typ, VariableSym r var typ) =>
VS (r var)
varLogFile r scope
forall {k} (r :: k -> *) (scope :: k). ScopeSym r scope => r scope
local,
      VS (r var) -> VS (r val) -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k) (var :: k) (val :: k).
FileHandling r stmt var val =>
VS (r var) -> VS (r val) -> MS (r stmt)
openFileA VS (r var)
forall {k} (r :: k -> *) (typ :: k) (var :: k).
(TypeSym r typ, VariableSym r var typ) =>
VS (r var)
varLogFile (Label -> VS (r val)
forall {k} (r :: k -> *) (val :: k) (typ :: k).
Literal r val typ =>
Label -> VS (r val)
litString Label
lName),
      VS (r val) -> Label -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k) (val :: k).
PrintFile r stmt val =>
VS (r val) -> Label -> MS (r stmt)
printFileStrLn VS (r val)
forall {k} (r :: k -> *) (typ :: k) (var :: k) (val :: k).
(TypeSym r typ, VariableSym r var typ, VariableValue r var val) =>
VS (r val)
valLogFile (Label
"function " Label -> Label -> Label
forall a. Semigroup a => a -> a -> a
<> Label
n Label -> Label -> Label
forall a. Semigroup a => a -> a -> a
<> Label
" called with inputs: {"),
      [MS (r stmt)] -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k).
MultiStatement r stmt =>
[MS (r stmt)] -> MS (r stmt)
multi ([MS (r stmt)] -> MS (r stmt)) -> [MS (r stmt)] -> MS (r stmt)
forall a b. (a -> b) -> a -> b
$ [VS (r var)] -> [MS (r stmt)]
forall {k} {r :: k -> *} {typ :: k} {stmt :: k} {val :: k}
       {var :: k} {typ :: k}.
(TypeSym r typ, PrintFile r stmt val, VariableValue r var val,
 VariableElim r var typ, VariableSym r var typ) =>
[StateT ValueState Identity (r var)]
-> [StateT MethodState Identity (r stmt)]
printInputs [VS (r var)]
vars,
      VS (r val) -> Label -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k) (val :: k).
PrintFile r stmt val =>
VS (r val) -> Label -> MS (r stmt)
printFileStrLn VS (r val)
forall {k} (r :: k -> *) (typ :: k) (var :: k) (val :: k).
(TypeSym r typ, VariableSym r var typ, VariableValue r var val) =>
VS (r val)
valLogFile Label
"  }",
      VS (r val) -> MS (r stmt)
forall {k} (r :: k -> *) (stmt :: k) (var :: k) (val :: k).
FileHandling r stmt var val =>
VS (r val) -> MS (r stmt)
closeFile VS (r val)
forall {k} (r :: k -> *) (typ :: k) (var :: k) (val :: k).
(TypeSym r typ, VariableSym r var typ, VariableValue r var val) =>
VS (r val)
valLogFile]
  where
    printInputs :: [StateT ValueState Identity (r var)]
-> [StateT MethodState Identity (r stmt)]
printInputs [] = []
    printInputs [StateT ValueState Identity (r var)
v] = [
      LensLike'
  (Zoomed (StateT ValueState Identity) (r var))
  MethodState
  ValueState
-> StateT ValueState Identity (r var)
-> StateT MethodState Identity (r var)
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 var))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r var) ValueState)
-> MethodState -> Focusing Identity (r var) MethodState
Lens' MethodState ValueState
lensMStoVS StateT ValueState Identity (r var)
v StateT MethodState Identity (r var)
-> (r var -> 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
>>= (\r var
v' -> VS (r val) -> Label -> StateT MethodState Identity (r stmt)
forall {k} (r :: k -> *) (stmt :: k) (val :: k).
PrintFile r stmt val =>
VS (r val) -> Label -> MS (r stmt)
printFileStr VS (r val)
forall {k} (r :: k -> *) (typ :: k) (var :: k) (val :: k).
(TypeSym r typ, VariableSym r var typ, VariableValue r var val) =>
VS (r val)
valLogFile (Label
"  " Label -> Label -> Label
forall a. Semigroup a => a -> a -> a
<>
        r var -> Label
forall {k} (r :: k -> *) (var :: k) (typ :: k).
VariableElim r var typ =>
r var -> Label
variableName r var
v' Label -> Label -> Label
forall a. Semigroup a => a -> a -> a
<> Label
" = ")),
      VS (r val) -> VS (r val) -> StateT MethodState Identity (r stmt)
forall {k} (r :: k -> *) (stmt :: k) (val :: k).
PrintFile r stmt val =>
VS (r val) -> VS (r val) -> MS (r stmt)
printFileLn VS (r val)
forall {k} (r :: k -> *) (typ :: k) (var :: k) (val :: k).
(TypeSym r typ, VariableSym r var typ, VariableValue r var val) =>
VS (r val)
valLogFile (StateT ValueState Identity (r var) -> VS (r val)
forall {k} (r :: k -> *) (var :: k) (val :: k).
VariableValue r var val =>
VS (r var) -> VS (r val)
valueOf StateT ValueState Identity (r var)
v)]
    printInputs (StateT ValueState Identity (r var)
v:[StateT ValueState Identity (r var)]
vs) = [
      LensLike'
  (Zoomed (StateT ValueState Identity) (r var))
  MethodState
  ValueState
-> StateT ValueState Identity (r var)
-> StateT MethodState Identity (r var)
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 var))
  MethodState
  ValueState
(ValueState -> Focusing Identity (r var) ValueState)
-> MethodState -> Focusing Identity (r var) MethodState
Lens' MethodState ValueState
lensMStoVS StateT ValueState Identity (r var)
v StateT MethodState Identity (r var)
-> (r var -> 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
>>= (\r var
v' -> VS (r val) -> Label -> StateT MethodState Identity (r stmt)
forall {k} (r :: k -> *) (stmt :: k) (val :: k).
PrintFile r stmt val =>
VS (r val) -> Label -> MS (r stmt)
printFileStr VS (r val)
forall {k} (r :: k -> *) (typ :: k) (var :: k) (val :: k).
(TypeSym r typ, VariableSym r var typ, VariableValue r var val) =>
VS (r val)
valLogFile (Label
"  " Label -> Label -> Label
forall a. Semigroup a => a -> a -> a
<>
        r var -> Label
forall {k} (r :: k -> *) (var :: k) (typ :: k).
VariableElim r var typ =>
r var -> Label
variableName r var
v' Label -> Label -> Label
forall a. Semigroup a => a -> a -> a
<> Label
" = ")),
      VS (r val) -> VS (r val) -> StateT MethodState Identity (r stmt)
forall {k} (r :: k -> *) (stmt :: k) (val :: k).
PrintFile r stmt val =>
VS (r val) -> VS (r val) -> MS (r stmt)
printFile VS (r val)
forall {k} (r :: k -> *) (typ :: k) (var :: k) (val :: k).
(TypeSym r typ, VariableSym r var typ, VariableValue r var val) =>
VS (r val)
valLogFile (StateT ValueState Identity (r var) -> VS (r val)
forall {k} (r :: k -> *) (var :: k) (val :: k).
VariableValue r var val =>
VS (r var) -> VS (r val)
valueOf StateT ValueState Identity (r var)
v),
      VS (r val) -> Label -> StateT MethodState Identity (r stmt)
forall {k} (r :: k -> *) (stmt :: k) (val :: k).
PrintFile r stmt val =>
VS (r val) -> Label -> MS (r stmt)
printFileStrLn VS (r val)
forall {k} (r :: k -> *) (typ :: k) (var :: k) (val :: k).
(TypeSym r typ, VariableSym r var typ, VariableValue r var val) =>
VS (r val)
valLogFile Label
", "] [StateT MethodState Identity (r stmt)]
-> [StateT MethodState Identity (r stmt)]
-> [StateT MethodState Identity (r stmt)]
forall a. Semigroup a => a -> a -> a
<> [StateT ValueState Identity (r var)]
-> [StateT MethodState Identity (r stmt)]
printInputs [StateT ValueState Identity (r var)]
vs

-- | The variable representing the log file in write mode.
varLogFile :: (TypeSym r typ, VariableSym r var typ) => VS (r var)
varLogFile :: forall {k} (r :: k -> *) (typ :: k) (var :: k).
(TypeSym r typ, VariableSym r var typ) =>
VS (r var)
varLogFile = Label -> VS (r typ) -> VS (r var)
forall {k} (r :: k -> *) (var :: k) (typ :: k).
VariableSym r var typ =>
Label -> VS (r typ) -> VS (r var)
var Label
"outfile" VS (r typ)
forall {k} (r :: k -> *) (typ :: k). TypeSym r typ => VS (r typ)
outfile

-- | The value of the variable representing the log file in write mode.
valLogFile
  :: (TypeSym r typ, VariableSym r var typ, VariableValue r var val)
  => VS (r val)
valLogFile :: forall {k} (r :: k -> *) (typ :: k) (var :: k) (val :: k).
(TypeSym r typ, VariableSym r var typ, VariableValue r var val) =>
VS (r val)
valLogFile = VS (r var) -> VS (r val)
forall {k} (r :: k -> *) (var :: k) (val :: k).
VariableValue r var val =>
VS (r var) -> VS (r val)
valueOf VS (r var)
forall {k} (r :: k -> *) (typ :: k) (var :: k).
(TypeSym r typ, VariableSym r var typ) =>
VS (r var)
varLogFile