{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications  #-}
{- |
   Module      : Text.Pandoc.Lua.Module.Log
   Copyright   : © 2024 Albert Krewinkel
   License     : GPL-2.0-or-later
   Maintainer  : Albert Krewinkel <albert+pandoc@tarleb.com>

Logging module.
-}
module Text.Pandoc.Lua.Module.Log
  ( documentedModule
  ) where

import Data.Version (makeVersion)
import HsLua
import Text.Pandoc.Class (report, runSilently)
import Text.Pandoc.Error (PandocError)
import Text.Pandoc.Logging (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 PandocError
documentedModule = Module
  { moduleName :: Name
moduleName = Name
"pandoc.log"
  , moduleDescription :: Text
moduleDescription =
      Text
"Access to pandoc's logging system."
  , moduleFields :: [Field PandocError]
moduleFields = []
  , moduleFunctions :: [DocumentedFunction PandocError]
moduleFunctions =
      [ Name
-> (ByteString -> LuaE PandocError ())
-> HsFnPrecursor PandocError (ByteString -> LuaE PandocError ())
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"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)
        HsFnPrecursor PandocError (ByteString -> LuaE PandocError ())
-> Parameter PandocError ByteString
-> HsFnPrecursor PandocError (LuaE PandocError ())
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker PandocError ByteString
-> TypeSpec -> Text -> Text -> Parameter PandocError ByteString
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker PandocError ByteString
forall e. Peeker e ByteString
peekByteString TypeSpec
"string" Text
"message" Text
"the info message"
        HsFnPrecursor PandocError (LuaE PandocError ())
-> FunctionResults PandocError () -> DocumentedFunction PandocError
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> []
        #? "Reports a ScriptingInfo message to pandoc's logging system."
        DocumentedFunction PandocError
-> Version -> DocumentedFunction PandocError
forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` [Int] -> Version
makeVersion [Int
3, Int
2]

      , Name
-> (StackIndex -> LuaE PandocError NumResults)
-> HsFnPrecursor
     PandocError (StackIndex -> LuaE PandocError NumResults)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"silence"
        ### const silence
        HsFnPrecursor
  PandocError (StackIndex -> LuaE PandocError NumResults)
-> Parameter PandocError StackIndex
-> HsFnPrecursor PandocError (LuaE PandocError NumResults)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker PandocError StackIndex
-> TypeSpec -> Text -> Text -> Parameter PandocError StackIndex
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker PandocError StackIndex
forall a. a -> Peek PandocError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeSpec
"function" Text
"fn"
              Text
"function to be silenced"
        HsFnPrecursor PandocError (LuaE PandocError NumResults)
-> Text -> DocumentedFunction PandocError
forall e.
HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
=?> (Text
"List of log messages triggered during the function call, " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
             Text
"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."
           ]
        DocumentedFunction PandocError
-> Version -> DocumentedFunction PandocError
forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` [Int] -> Version
makeVersion [Int
3, Int
2]

      , Name
-> (ByteString -> LuaE PandocError ())
-> HsFnPrecursor PandocError (ByteString -> LuaE PandocError ())
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"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)
        HsFnPrecursor PandocError (ByteString -> LuaE PandocError ())
-> Parameter PandocError ByteString
-> HsFnPrecursor PandocError (LuaE PandocError ())
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker PandocError ByteString
-> TypeSpec -> Text -> Text -> Parameter PandocError ByteString
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker PandocError ByteString
forall e. Peeker e ByteString
peekByteString TypeSpec
"string" Text
"message"
              Text
"the warning message"
        HsFnPrecursor PandocError (LuaE PandocError ())
-> FunctionResults PandocError () -> DocumentedFunction PandocError
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> []
        #? 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*."
           ]
        DocumentedFunction PandocError
-> Version -> DocumentedFunction PandocError
forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` [Int] -> Version
makeVersion [Int
3, Int
2]
      ]
  , moduleOperations :: [(Operation, DocumentedFunction PandocError)]
moduleOperations = []
  , moduleTypeInitializers :: [LuaE PandocError Name]
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 :: LuaE PandocError NumResults
silence = PandocLua NumResults -> LuaE PandocError NumResults
forall a. PandocLua a -> LuaE PandocError a
unPandocLua (PandocLua NumResults -> LuaE PandocError NumResults)
-> PandocLua NumResults -> LuaE PandocError NumResults
forall a b. (a -> b) -> a -> b
$ do
  -- call function given as the first argument
  ((), messages) <- PandocLua () -> PandocLua ((), [LogMessage])
forall (m :: * -> *) a. PandocMonad m => m a -> m (a, [LogMessage])
runSilently (PandocLua () -> PandocLua ((), [LogMessage]))
-> (LuaE PandocError () -> PandocLua ())
-> LuaE PandocError ()
-> PandocLua ((), [LogMessage])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LuaE PandocError () -> PandocLua ()
forall a. LuaE PandocError a -> PandocLua a
liftPandocLua (LuaE PandocError () -> PandocLua ((), [LogMessage]))
-> LuaE PandocError () -> PandocLua ((), [LogMessage])
forall a b. (a -> b) -> a -> b
$ do
    nargs <- (CInt -> NumArgs
NumArgs (CInt -> NumArgs) -> (StackIndex -> CInt) -> StackIndex -> NumArgs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
subtract CInt
1 (CInt -> CInt) -> (StackIndex -> CInt) -> StackIndex -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> CInt
fromStackIndex) (StackIndex -> NumArgs)
-> LuaE PandocError StackIndex -> LuaE PandocError NumArgs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LuaE PandocError StackIndex
forall e. LuaE e StackIndex
gettop
    call @PandocError nargs multret

  liftPandocLua $ do
    pushPandocList pushLogMessage messages
    insert 1
    (NumResults . fromStackIndex) <$> gettop