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

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
  origState <- PandocLua CommonState
forall (m :: * -> *). PandocMonad m => m CommonState
getCommonState
  let origLog = CommonState -> [LogMessage]
stLog CommonState
origState
  let origVerbosity = CommonState -> Verbosity
stVerbosity CommonState
origState
  putCommonState (origState { stLog = [], stVerbosity = ERROR })

  -- call function given as the first argument
  liftPandocLua $ do
    nargs <- (NumArgs . subtract 1 . fromStackIndex) <$> gettop
    call @PandocError nargs multret

  -- restore original log messages
  newState <- getCommonState
  let newLog = CommonState -> [LogMessage]
stLog CommonState
newState
  putCommonState (newState { stLog = origLog, stVerbosity = origVerbosity })

  liftPandocLua $ do
    pushPandocList pushLogMessage newLog
    insert 1
    (NumResults . fromStackIndex) <$> gettop