-
-
Notifications
You must be signed in to change notification settings - Fork 3.4k
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Showing
5 changed files
with
143 additions
and
16 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
39 changes: 39 additions & 0 deletions
39
pandoc-lua-engine/src/Text/Pandoc/Lua/Marshal/LogMessage.hs
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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 |