diff --git a/pandoc-lua-engine/pandoc-lua-engine.cabal b/pandoc-lua-engine/pandoc-lua-engine.cabal index 27cfb75cc6472..87d4d78fee287 100644 --- a/pandoc-lua-engine/pandoc-lua-engine.cabal +++ b/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 diff --git a/pandoc-lua-engine/src/Text/Pandoc/Lua/Init.hs b/pandoc-lua-engine/src/Text/Pandoc/Lua/Init.hs index 0ea04b63556ab..b2258b5b427c7 100644 --- a/pandoc-lua-engine/src/Text/Pandoc/Lua/Init.hs +++ b/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 diff --git a/pandoc-lua-engine/src/Text/Pandoc/Lua/Marshal/CommonState.hs b/pandoc-lua-engine/src/Text/Pandoc/Lua/Marshal/CommonState.hs index 376f2dd74ba73..81fe85ceab28a 100644 --- a/pandoc-lua-engine/src/Text/Pandoc/Lua/Marshal/CommonState.hs +++ b/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 diff --git a/pandoc-lua-engine/src/Text/Pandoc/Lua/Marshal/LogMessage.hs b/pandoc-lua-engine/src/Text/Pandoc/Lua/Marshal/LogMessage.hs new file mode 100644 index 0000000000000..580b80134aac0 --- /dev/null +++ b/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 + +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 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 0000000000000..8301e24421281 --- /dev/null +++ b/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 + +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