Skip to content

Commit

Permalink
Lua: add a pandoc.log moddule.
Browse files Browse the repository at this point in the history
  • Loading branch information
tarleb committed Apr 18, 2024
1 parent 3d90234 commit 9e77bb6
Show file tree
Hide file tree
Showing 5 changed files with 143 additions and 16 deletions.
2 changes: 2 additions & 0 deletions pandoc-lua-engine/pandoc-lua-engine.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down
2 changes: 2 additions & 0 deletions pandoc-lua-engine/src/Text/Pandoc/Lua/Init.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
18 changes: 2 additions & 16 deletions pandoc-lua-engine/src/Text/Pandoc/Lua/Marshal/CommonState.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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)
Expand All @@ -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
39 changes: 39 additions & 0 deletions pandoc-lua-engine/src/Text/Pandoc/Lua/Marshal/LogMessage.hs
Original file line number Diff line number Diff line change
@@ -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
98 changes: 98 additions & 0 deletions pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Log.hs
Original file line number Diff line number Diff line change
@@ -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

0 comments on commit 9e77bb6

Please sign in to comment.