{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications  #-}
{- |
   Module      : Text.Pandoc.Lua.Module.Log
   Copyright   : © 2024 Albert Krewinkel
   License     : GPL-2.0-or-later
   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>

Logging module.
-}
module Text.Pandoc.Lua.Module.Log
  ( documentedModule
  ) where

import Data.Version (makeVersion)
import HsLua
import Text.Pandoc.Class
  ( CommonState (stVerbosity, stLog)
  , PandocMonad (putCommonState, getCommonState)
  , report )
import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Logging
  ( Verbosity (ERROR)
  , LogMessage (ScriptingInfo, ScriptingWarning) )
import Text.Pandoc.Lua.Marshal.List (pushPandocList)
import Text.Pandoc.Lua.Marshal.LogMessage (pushLogMessage)
import Text.Pandoc.Lua.PandocLua (liftPandocLua, unPandocLua)
import Text.Pandoc.Lua.SourcePos (luaSourcePos)
import qualified Data.Text as T
import qualified HsLua.Core.Utf8 as UTF8

-- | Push the pandoc.log module on the Lua stack.
documentedModule :: Module PandocError
documentedModule :: Module PandocError
documentedModule = Module
  { moduleName :: Name
moduleName = Name
"pandoc.log"
  , moduleDescription :: Text
moduleDescription =
      Text
"Access to pandoc's logging system."
  , moduleFields :: [Field PandocError]
moduleFields = []
  , moduleFunctions :: [DocumentedFunction PandocError]
moduleFunctions =
      [ Name
-> (ByteString -> LuaE PandocError ())
-> HsFnPrecursor PandocError (ByteString -> LuaE PandocError ())
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"info"
        ### (\msg -> do
                -- reporting levels:
                -- 0: this function,
                -- 1: userdata wrapper function for the function,
                -- 2: function calling warn.
                pos <- luaSourcePos 2
                unPandocLua $ report $ ScriptingInfo (UTF8.toText msg) pos)
        HsFnPrecursor PandocError (ByteString -> LuaE PandocError ())
-> Parameter PandocError ByteString
-> HsFnPrecursor PandocError (LuaE PandocError ())
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker PandocError ByteString
-> TypeSpec -> Text -> Text -> Parameter PandocError ByteString
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker PandocError ByteString
forall e. Peeker e ByteString
peekByteString TypeSpec
"string" Text
"message" Text
"the info message"
        HsFnPrecursor PandocError (LuaE PandocError ())
-> FunctionResults PandocError () -> DocumentedFunction PandocError
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> []
        #? "Reports a ScriptingInfo message to pandoc's logging system."
        DocumentedFunction PandocError
-> Version -> DocumentedFunction PandocError
forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` [Int] -> Version
makeVersion [Int
3, Int
2]

      , Name
-> (StackIndex -> LuaE PandocError NumResults)
-> HsFnPrecursor
     PandocError (StackIndex -> LuaE PandocError NumResults)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"silence"
        ### const silence
        HsFnPrecursor
  PandocError (StackIndex -> LuaE PandocError NumResults)
-> Parameter PandocError StackIndex
-> HsFnPrecursor PandocError (LuaE PandocError NumResults)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker PandocError StackIndex
-> TypeSpec -> Text -> Text -> Parameter PandocError StackIndex
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker PandocError StackIndex
forall a. a -> Peek PandocError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeSpec
"function" Text
"fn"
              Text
"function to be silenced"
        HsFnPrecursor PandocError (LuaE PandocError NumResults)
-> Text -> DocumentedFunction PandocError
forall e.
HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
=?> (Text
"List of log messages triggered during the function call, " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
             Text
"and any value returned by the function.")
        #? T.unlines
           [ "Applies the function to the given arguments while"
           , "preventing log messages from being added to the log."
           , "The warnings and info messages reported during the function"
           , "call are returned as the first return value, with the"
           , "results of the function call following thereafter."
           ]
        DocumentedFunction PandocError
-> Version -> DocumentedFunction PandocError
forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` [Int] -> Version
makeVersion [Int
3, Int
2]

      , Name
-> (ByteString -> LuaE PandocError ())
-> HsFnPrecursor PandocError (ByteString -> LuaE PandocError ())
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"warn"
        ### (\msg -> do
                -- reporting levels:
                -- 0: this function,
                -- 1: userdata wrapper function for the function,
                -- 2: function calling warn.
                pos <- luaSourcePos 2
                unPandocLua $ report $ ScriptingWarning (UTF8.toText msg) pos)
        HsFnPrecursor PandocError (ByteString -> LuaE PandocError ())
-> Parameter PandocError ByteString
-> HsFnPrecursor PandocError (LuaE PandocError ())
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker PandocError ByteString
-> TypeSpec -> Text -> Text -> Parameter PandocError ByteString
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker PandocError ByteString
forall e. Peeker e ByteString
peekByteString TypeSpec
"string" Text
"message"
              Text
"the warning message"
        HsFnPrecursor PandocError (LuaE PandocError ())
-> FunctionResults PandocError () -> DocumentedFunction PandocError
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> []
        #? T.unlines
           [ "Reports a ScriptingWarning to pandoc's logging system."
           , "The warning will be printed to stderr unless logging"
           , "verbosity has been set to *ERROR*."
           ]
        DocumentedFunction PandocError
-> Version -> DocumentedFunction PandocError
forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` [Int] -> Version
makeVersion [Int
3, Int
2]
      ]
  , moduleOperations :: [(Operation, DocumentedFunction PandocError)]
moduleOperations = []
  , moduleTypeInitializers :: [LuaE PandocError Name]
moduleTypeInitializers = []
  }

-- | Calls the function given as the first argument, but suppresses logging.
-- Returns the list of generated log messages as the first result, and the other
-- results of the function call after that.
silence :: LuaE PandocError NumResults
silence :: LuaE PandocError NumResults
silence = PandocLua NumResults -> LuaE PandocError NumResults
forall a. PandocLua a -> LuaE PandocError a
unPandocLua (PandocLua NumResults -> LuaE PandocError NumResults)
-> PandocLua NumResults -> LuaE PandocError NumResults
forall a b. (a -> b) -> a -> b
$ do
  -- get current log messages
  CommonState
origState <- PandocLua CommonState
forall (m :: * -> *). PandocMonad m => m CommonState
getCommonState
  let origLog :: [LogMessage]
origLog = CommonState -> [LogMessage]
stLog CommonState
origState
  let origVerbosity :: Verbosity
origVerbosity = CommonState -> Verbosity
stVerbosity CommonState
origState
  CommonState -> PandocLua ()
forall (m :: * -> *). PandocMonad m => CommonState -> m ()
putCommonState (CommonState
origState { stLog = [], stVerbosity = ERROR })

  -- call function given as the first argument
  LuaE PandocError () -> PandocLua ()
forall a. LuaE PandocError a -> PandocLua a
liftPandocLua (LuaE PandocError () -> PandocLua ())
-> LuaE PandocError () -> PandocLua ()
forall a b. (a -> b) -> a -> b
$ do
    NumArgs
nargs <- (CInt -> NumArgs
NumArgs (CInt -> NumArgs) -> (StackIndex -> CInt) -> StackIndex -> NumArgs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
subtract CInt
1 (CInt -> CInt) -> (StackIndex -> CInt) -> StackIndex -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> CInt
fromStackIndex) (StackIndex -> NumArgs)
-> LuaE PandocError StackIndex -> LuaE PandocError NumArgs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LuaE PandocError StackIndex
forall e. LuaE e StackIndex
gettop
    forall e. LuaError e => NumArgs -> NumResults -> LuaE e ()
call @PandocError NumArgs
nargs NumResults
multret

  -- restore original log messages
  CommonState
newState <- PandocLua CommonState
forall (m :: * -> *). PandocMonad m => m CommonState
getCommonState
  let newLog :: [LogMessage]
newLog = CommonState -> [LogMessage]
stLog CommonState
newState
  CommonState -> PandocLua ()
forall (m :: * -> *). PandocMonad m => CommonState -> m ()
putCommonState (CommonState
newState { stLog = origLog, stVerbosity = origVerbosity })

  LuaE PandocError NumResults -> PandocLua NumResults
forall a. LuaE PandocError a -> PandocLua a
liftPandocLua (LuaE PandocError NumResults -> PandocLua NumResults)
-> LuaE PandocError NumResults -> PandocLua NumResults
forall a b. (a -> b) -> a -> b
$ do
    Pusher PandocError LogMessage -> Pusher PandocError [LogMessage]
forall e a. LuaError e => Pusher e a -> Pusher e [a]
pushPandocList Pusher PandocError LogMessage
forall e. LuaError e => Pusher e LogMessage
pushLogMessage [LogMessage]
newLog
    StackIndex -> LuaE PandocError ()
forall e. StackIndex -> LuaE e ()
insert StackIndex
1
    (CInt -> NumResults
NumResults (CInt -> NumResults)
-> (StackIndex -> CInt) -> StackIndex -> NumResults
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> CInt
fromStackIndex) (StackIndex -> NumResults)
-> LuaE PandocError StackIndex -> LuaE PandocError NumResults
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LuaE PandocError StackIndex
forall e. LuaE e StackIndex
gettop