1 files changed, 114 insertions, 0 deletions
diff --git a/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Log.hs b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Log.hs
new file mode 100644
index 000000000..6c5cd9ef5
--- /dev/null
+++ b/pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Log.hs
@@ -0,0 +1,114 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications  #-}
+{- |
+   Module      : Text.Pandoc.Lua.Module.Log
+   Copyright   : © 2024 Albert Krewinkel
+   License     : GPL-2.0-or-later
+   Maintainer  : Albert Krewinkel <[email protected]>
+
+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
+  { moduleName = "pandoc.log"
+  , moduleDescription =
+      "Access to pandoc's logging system."
+  , moduleFields = []
+  , moduleFunctions =
+      [ defun "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)
+        <#> parameter peekByteString "string" "message" "the info message"
+        =#> []
+        #? "Reports a ScriptingInfo message to pandoc's logging system."
+        `since` makeVersion [3, 2]
+
+      , defun "silence"
+        ### const silence
+        <#> parameter pure "function" "fn"
+              "function to be silenced"
+        =?> ("List of log messages triggered during the function call, " <>
+             "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."
+           ]
+        `since` makeVersion [3, 2]
+
+      , defun "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)
+        <#> parameter peekByteString "string" "message"
+              "the warning message"
+        =#> []
+        #? 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*."
+           ]
+        `since` makeVersion [3, 2]
+      ]
+  , moduleOperations = []
+  , 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 = unPandocLua $ do
+  -- get current log messages
+  origState <- getCommonState
+  let origLog = stLog origState
+  let origVerbosity = stVerbosity 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 = stLog newState
+  putCommonState (newState { stLog = origLog, stVerbosity = origVerbosity })
+
+  liftPandocLua $ do
+    pushPandocList pushLogMessage newLog
+    insert 1
+    (NumResults . fromStackIndex) <$> gettop