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
7 changed files
with
264 additions
and
25 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
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 <tarleb+pandoc@moltkeplatz.de> | ||
| 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,114 @@ | ||
| {-# LANGUAGE OverloadedStrings #-} | ||
| {-# LANGUAGE TypeApplications #-} | ||
| {- | | ||
| Module : Text.Pandoc.Lua.Module.Log | ||
| Copyright : © 2024 Albert Krewinkel | ||
| License : GPL-2.0-or-later | ||
| Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> | ||
| 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 |
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,41 @@ | ||
| {-# LANGUAGE OverloadedStrings #-} | ||
| {- | | ||
| Module : Text.Pandoc.Lua.SourcePos | ||
| Copyright : © 2024 Albert Krewinkel | ||
| License : GPL-2.0-or-later | ||
| Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> | ||
| 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 |