Lua: add a pandoc.log module.

doc/lua-filters.md

@@ -4736,6 +4736,66 @@ Returns:
 
 <!-- END: AUTOGENERATED CONTENT -->
 
+<!-- BEGIN: AUTOGENERATED CONTENT for module pandoc.log -->
+
+# Module pandoc.log
+
+Access to pandoc's logging system.
+
+## Functions {#pandoc.log-functions}
+
+### info {#pandoc.log.info}
+
+`info (message)`
+
+Reports a ScriptingInfo message to pandoc's logging system.
+
+Parameters:
+
+`message`
+:   the info message (string)
+
+*Since: 3.2*
+
+### silence {#pandoc.log.silence}
+
+`silence (fn)`
+
+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.
+
+Parameters:
+
+`fn`
+:   function to be silenced (function)
+
+Returns:
+
+List of log messages triggered during the function call, and any
+value returned by the function.
+
+*Since: 3.2*
+
+### warn {#pandoc.log.warn}
+
+`warn (message)`
+
+Reports a ScriptingWarning to pandoc's logging system. The warning
+will be printed to stderr unless logging verbosity has been set to
+*ERROR*.
+
+Parameters:
+
+`message`
+:   the warning message (string)
+
+*Since: 3.2*
+
+<!-- END: AUTOGENERATED CONTENT -->
+
 <!-- BEGIN: AUTOGENERATED CONTENT for module pandoc.path -->
 
 # Module pandoc.path

pandoc-lua-engine/pandoc-lua-engine.cabal

@@ -75,6 +75,7 @@ library
                      , Text.Pandoc.Lua.Marshal.Context
                      , Text.Pandoc.Lua.Marshal.Format
                      , Text.Pandoc.Lua.Marshal.ImageSize
+                     , Text.Pandoc.Lua.Marshal.LogMessage
                      , Text.Pandoc.Lua.Marshal.PandocError
                      , Text.Pandoc.Lua.Marshal.ReaderOptions
                      , Text.Pandoc.Lua.Marshal.Reference
@@ -85,6 +86,7 @@ library
                      , Text.Pandoc.Lua.Module.Format
                      , Text.Pandoc.Lua.Module.Image
                      , Text.Pandoc.Lua.Module.JSON
+                     , Text.Pandoc.Lua.Module.Log
                      , Text.Pandoc.Lua.Module.MediaBag
                      , Text.Pandoc.Lua.Module.Pandoc
                      , Text.Pandoc.Lua.Module.Scaffolding
@@ -96,6 +98,7 @@ library
                      , Text.Pandoc.Lua.Module.Utils
                      , Text.Pandoc.Lua.Orphans
                      , Text.Pandoc.Lua.PandocLua
+                     , Text.Pandoc.Lua.SourcePos
                      , Text.Pandoc.Lua.Writer.Classic
                      , Text.Pandoc.Lua.Writer.Scaffolding
 

pandoc-lua-engine/src/Text/Pandoc/Lua/Init.hs

@@ -30,8 +30,7 @@ import Text.Pandoc.Logging (LogMessage (ScriptingWarning))
 import Text.Pandoc.Lua.Global (Global (..), setGlobals)
 import Text.Pandoc.Lua.Marshal.List (newListMetatable, pushListModule)
 import Text.Pandoc.Lua.PandocLua (PandocLua (..), liftPandocLua)
-import Text.Parsec.Pos (newPos)
-import Text.Read (readMaybe)
+import Text.Pandoc.Lua.SourcePos (luaSourcePos)
 import qualified Data.ByteString.Char8 as Char8
 import qualified Data.Text as T
 import qualified Lua.LPeg as LPeg
@@ -43,6 +42,7 @@ import qualified Text.Pandoc.Lua.Module.CLI as Pandoc.CLI
 import qualified Text.Pandoc.Lua.Module.Format as Pandoc.Format
 import qualified Text.Pandoc.Lua.Module.Image as Pandoc.Image
 import qualified Text.Pandoc.Lua.Module.JSON as Pandoc.JSON
+import qualified Text.Pandoc.Lua.Module.Log as Pandoc.Log
 import qualified Text.Pandoc.Lua.Module.MediaBag as Pandoc.MediaBag
 import qualified Text.Pandoc.Lua.Module.Pandoc as Module.Pandoc
 import qualified Text.Pandoc.Lua.Module.Scaffolding as Pandoc.Scaffolding
@@ -94,6 +94,7 @@ loadedModules =
   , Pandoc.Format.documentedModule
   , Pandoc.Image.documentedModule
   , Pandoc.JSON.documentedModule
+  , Pandoc.Log.documentedModule
   , Pandoc.MediaBag.documentedModule
   , Pandoc.Scaffolding.documentedModule
   , Pandoc.Structure.documentedModule
@@ -247,10 +248,5 @@ setWarnFunction = liftPandocLua . setwarnf' $ \msg -> do
   -- 1: userdata wrapper function for the hook,
   -- 2: warn,
   -- 3: function calling warn.
-  where' 3
-  loc <- UTF8.toText <$> tostring' top
-  unPandocLua . report $ ScriptingWarning (UTF8.toText msg) (toSourcePos loc)
- where
-   toSourcePos loc = (T.breakOnEnd ":" <$> T.stripSuffix ": " loc)
-     >>= (\(prfx, sfx) -> (,) <$> T.unsnoc prfx <*> readMaybe (T.unpack sfx))
-     >>= \((source, _), line) -> Just $ newPos (T.unpack source) line 1
+  pos <- luaSourcePos 3
+  unPandocLua . report $ ScriptingWarning (UTF8.toText msg) pos

pandoc-lua-engine/src/Text/Pandoc/Lua/Marshal/CommonState.hs

@@ -17,9 +17,8 @@ module Text.Pandoc.Lua.Marshal.CommonState
 
 import HsLua
 import Text.Pandoc.Class (CommonState (..))
-import Text.Pandoc.Logging (LogMessage, showLogMessage)
 import Text.Pandoc.Lua.Marshal.List (pushPandocList)
-import qualified Data.Aeson as Aeson
+import Text.Pandoc.Lua.Marshal.LogMessage (pushLogMessage)
 
 -- | Lua type used for the @CommonState@ object.
 typeCommonState :: LuaError e => DocumentedType e CommonState
@@ -31,7 +30,7 @@ typeCommonState = deftype "pandoc CommonState" []
       (maybe pushnil pushString, stOutputFile)
 
   , readonly "log" "list of log messages"
-      (pushPandocList (pushUD typeLogMessage), stLog)
+      (pushPandocList pushLogMessage, stLog)
 
   , readonly "request_headers" "headers to add for HTTP requests"
       (pushPandocList (pushPair pushText pushText), stRequestHeaders)
@@ -58,16 +57,3 @@ peekCommonState = peekUD typeCommonState
 
 pushCommonState :: LuaError e => Pusher e CommonState
 pushCommonState = pushUD typeCommonState
-
-typeLogMessage :: LuaError e => DocumentedType e LogMessage
-typeLogMessage = deftype "pandoc LogMessage"
-  [ operation Index $ defun "__tostring"
-      ### liftPure showLogMessage
-      <#> udparam typeLogMessage "msg" "object"
-      =#> functionResult pushText "string" "stringified log message"
-  , operation (CustomOperation "__tojson") $ lambda
-      ### liftPure Aeson.encode
-      <#> udparam typeLogMessage "msg" "object"
-      =#> functionResult pushLazyByteString "string" "JSON encoded object"
-  ]
-  mempty -- no members

pandoc-lua-engine/src/Text/Pandoc/Lua/Marshal/LogMessage.hs

@@ -0,0 +1,39 @@
+{-# LANGUAGE OverloadedStrings    #-}
+{- |
+   Module      : Text.Pandoc.Lua.Marshal.LogMessage
+   Copyright   : © 2017-2023 Albert Krewinkel
+   License     : GPL-2.0-or-later
+   Maintainer  : Albert Krewinkel <[email protected]>
+
+Pushing and retrieving of pandoc log messages.
+-}
+module Text.Pandoc.Lua.Marshal.LogMessage
+  ( peekLogMessage
+  , pushLogMessage
+  , typeLogMessage
+  ) where
+
+import HsLua
+import Text.Pandoc.Logging (LogMessage, showLogMessage)
+import qualified Data.Aeson as Aeson
+
+-- | Type definition for pandoc log messages.
+typeLogMessage :: LuaError e => DocumentedType e LogMessage
+typeLogMessage = deftype "pandoc LogMessage"
+  [ operation Index $ defun "__tostring"
+      ### liftPure showLogMessage
+      <#> udparam typeLogMessage "msg" "object"
+      =#> functionResult pushText "string" "stringified log message"
+  , operation (CustomOperation "__tojson") $ lambda
+      ### liftPure Aeson.encode
+      <#> udparam typeLogMessage "msg" "object"
+      =#> functionResult pushLazyByteString "string" "JSON encoded object"
+  ]
+  mempty -- no members
+
+-- | Pushes a LogMessage to the stack.
+pushLogMessage :: LuaError e => Pusher e LogMessage
+pushLogMessage = pushUD typeLogMessage
+
+peekLogMessage :: LuaError e => Peeker e LogMessage
+peekLogMessage  = peekUD typeLogMessage

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

pandoc-lua-engine/src/Text/Pandoc/Lua/SourcePos.hs

@@ -0,0 +1,41 @@
+{-# LANGUAGE OverloadedStrings #-}
+{- |
+   Module      : Text.Pandoc.Lua.SourcePos
+   Copyright   : © 2024 Albert Krewinkel
+   License     : GPL-2.0-or-later
+   Maintainer  : Albert Krewinkel <[email protected]>
+
+Helper function to retrieve the 'SourcePos' in a Lua script.
+-}
+module Text.Pandoc.Lua.SourcePos
+  ( luaSourcePos
+  ) where
+
+import HsLua
+import Text.Parsec.Pos (SourcePos, newPos)
+import Text.Read (readMaybe)
+import qualified Data.Text as T
+import qualified HsLua.Core.Utf8 as UTF8
+
+-- | Returns the current position in a Lua script.
+--
+-- The reporting level is the level of the call stack, for which the
+-- position should be reported. There might not always be a position
+-- available, e.g., in C functions.
+luaSourcePos :: LuaError e
+             => Int                -- ^ reporting level
+             -> LuaE e (Maybe SourcePos)
+luaSourcePos lvl = do
+  -- reporting levels:
+  -- 0: this hook,
+  -- 1: userdata wrapper function for the hook,
+  -- 2: warn,
+  -- 3: function calling warn.
+  where' lvl
+  locStr <- UTF8.toText <$> tostring' top
+  return $ do
+    (prfx, sfx) <- T.breakOnEnd ":" <$> T.stripSuffix ": " locStr
+    (source, _) <- T.unsnoc prfx
+    line <- readMaybe (T.unpack sfx)
+    -- We have no column information, so always use column 1
+    Just $ newPos (T.unpack source) line 1

pandoc-lua-engine/test/Tests/Lua.hs

@@ -24,10 +24,12 @@ import Text.Pandoc.Builder (bulletList, definitionList, displayMath, divWith,
                             linebreak, math, orderedList, para, plain, rawBlock,
                             singleQuoted, space, str, strong,
                             HasMeta (setMeta))
-import Text.Pandoc.Class (runIOorExplode, setUserDataDir)
+import Text.Pandoc.Class ( CommonState (stVerbosity)
+                         , modifyCommonState, runIOorExplode, setUserDataDir)
 import Text.Pandoc.Definition (Attr, Block (BlockQuote, Div, Para), Pandoc,
                                Inline (Emph, Str), pandocTypesVersion)
 import Text.Pandoc.Error (PandocError (PandocLuaError))
+import Text.Pandoc.Logging (Verbosity (ERROR))
 import Text.Pandoc.Lua (Global (..), applyFilter, runLua, setGlobals)
 import Text.Pandoc.Options (def)
 import Text.Pandoc.Version (pandocVersionText)
@@ -238,6 +240,9 @@ assertFilterConversion msg filterPath docIn expectedDoc = do
 
 runLuaTest :: HasCallStack => Lua.LuaE PandocError a -> IO a
 runLuaTest op = runIOorExplode $ do
+  -- Disable printing of warnings on stderr: some tests will generate
+  -- warnings, we don't want to see those messages.
+  modifyCommonState $ \st -> st { stVerbosity = ERROR }
   res <- runLua $ do
     setGlobals [ PANDOC_WRITER_OPTIONS def ]
     op

pandoc-lua-engine/test/Tests/Lua/Module.hs

@@ -29,6 +29,8 @@ tests =
                   ("lua" </> "module" </> "pandoc-image.lua")
   , testPandocLua "pandoc.json"
                   ("lua" </> "module" </> "pandoc-json.lua")
+  , testPandocLua "pandoc.log"
+                  ("lua" </> "module" </> "pandoc-log.lua")
   , testPandocLua "pandoc.mediabag"
                   ("lua" </> "module" </> "pandoc-mediabag.lua")
   , testPandocLua "pandoc.path"