Lua: add a pandoc.log moddule.

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

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

@@ -43,6 +43,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 +95,7 @@ loadedModules =
  , Pandoc.Format.documentedModule
  , Pandoc.Image.documentedModule
  , Pandoc.JSON.documentedModule
+ , Pandoc.Log.documentedModule
  , Pandoc.MediaBag.documentedModule
  , Pandoc.Scaffolding.documentedModule
  , Pandoc.Structure.documentedModule

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,98 @@
+{-# 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]>
+
+Command line helpers
+-}
+module Text.Pandoc.Lua.Module.Log
+ ( documentedModule
+ ) where
+
+import Data.Version (makeVersion)
+import HsLua
+import Text.Pandoc.Class
+import Text.Pandoc.Error (PandocError)
+import Text.Pandoc.Logging (Verbosity (ERROR), LogMessage (ScriptingWarning))
+import Text.Pandoc.Lua.Marshal.List (pushPandocList)
+import Text.Pandoc.Lua.Marshal.LogMessage (pushLogMessage)
+import Text.Pandoc.Lua.PandocLua (liftPandocLua, unPandocLua)
+import Text.Read (readMaybe)
+import Text.Parsec.Pos (newPos)
+import qualified Data.Text as T
+import qualified Text.Pandoc.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 "silence"
+ ### const silence
+ <#> parameter pure "function" "fn"
+ "function to be silenced"
+ =?> "Function which will not trigger pandoc log messages."
+ #? T.unlines
+ [ "Applies the function to the given arguments while"
+ , "preventing log messages from being added to the log."
+ ]
+ `since` makeVersion [3, 2]
+
+ , defun "warn"
+ ### (\msg -> do
+ warning <- do
+ -- 0: this hook,
+ -- 1: userdata wrapper function for the hook,
+ -- 2: function calling warn.
+ where' 2
+ loc <- UTF8.toText <$> tostring' top
+ let srcpos = (T.breakOnEnd ":" <$> T.stripSuffix ": " loc)
+ >>= (\(prfx, sfx) -> (,) <$> T.unsnoc prfx <*> readMaybe (T.unpack sfx))
+ >>= \((source, _), line) -> Just $ newPos (T.unpack source) line 1
+ pure $ ScriptingWarning (UTF8.toText msg) srcpos
+ unPandocLua $ report warning)
+ <#> parameter peekByteString "string" "message"
+ "the warning message"
+ =#> []
+ #? T.unlines
+ [ "Raises a ScriptingWarning in 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