[WIP] Lua: add function pandoc.init

Author: tarleb

pandoc-lua-engine/src/Text/Pandoc/Lua.hs

@@ -17,12 +17,13 @@ module Text.Pandoc.Lua
   , setGlobals
   , runLua
   , runLuaNoEnv
+  , userInit
   -- * Engine
   , getEngine
   ) where
 
 import Text.Pandoc.Lua.Engine (getEngine, applyFilter)
 import Text.Pandoc.Lua.Global (Global (..), setGlobals)
-import Text.Pandoc.Lua.Init (runLua, runLuaNoEnv)
+import Text.Pandoc.Lua.Init (runLua, runLuaNoEnv, userInit)
 import Text.Pandoc.Lua.Custom (loadCustom)
 import Text.Pandoc.Lua.Orphans ()

pandoc-lua-engine/src/Text/Pandoc/Lua/Custom.hs

@@ -18,7 +18,7 @@ import HsLua as Lua hiding (Operation (Div))
 import Text.Pandoc.Class (PandocMonad, findFileWithDataFallback)
 import Text.Pandoc.Error (PandocError)
 import Text.Pandoc.Lua.Global (Global (..), setGlobals)
-import Text.Pandoc.Lua.Init (runLuaWith)
+import Text.Pandoc.Lua.Init (runLuaWith, userInit)
 import Text.Pandoc.Lua.Marshal.Format (peekExtensionsConfig)
 import Text.Pandoc.Lua.Marshal.Pandoc (peekPandoc)
 import Text.Pandoc.Lua.Marshal.WriterOptions (pushWriterOptions)
@@ -34,10 +34,12 @@ import qualified Text.Pandoc.Class as PandocMonad
 loadCustom :: (PandocMonad m, MonadIO m)
            => FilePath -> m (CustomComponents m)
 loadCustom luaFile = do
+  initialState <- PandocMonad.getCommonState
   luaState <- liftIO newGCManagedState
   luaFile' <- fromMaybe luaFile <$>
               findFileWithDataFallback "custom"  luaFile
   either throw pure <=< runLuaWith luaState $ do
+    userInit initialState
     let globals = [ PANDOC_SCRIPT_FILE luaFile' ]
     setGlobals globals
     dofileTrace (Just luaFile') >>= \case

pandoc-lua-engine/src/Text/Pandoc/Lua/Engine.hs

@@ -17,13 +17,13 @@ import Control.Exception (throw)
 import Control.Monad ((>=>))
 import Control.Monad.IO.Class (MonadIO (liftIO))
 import HsLua.Core (getglobal, openlibs, run, top, tostring)
-import Text.Pandoc.Class (PandocMonad)
+import Text.Pandoc.Class (PandocMonad (getCommonState))
 import Text.Pandoc.Definition (Pandoc)
 import Text.Pandoc.Filter (Environment (..))
 import Text.Pandoc.Error (PandocError (PandocFilterError, PandocLuaError))
 import Text.Pandoc.Lua.Filter (runFilterFile)
 import Text.Pandoc.Lua.Global (Global (..), setGlobals)
-import Text.Pandoc.Lua.Init (runLua)
+import Text.Pandoc.Lua.Init (runLua, userInit)
 import Text.Pandoc.Lua.Custom (loadCustom)
 import Text.Pandoc.Lua.Orphans ()
 import Text.Pandoc.Scripting (ScriptingEngine (..))
@@ -60,7 +60,9 @@ applyFilter fenv args fp doc = do
                 , PANDOC_WRITER_OPTIONS (envWriterOptions fenv)
                 , PANDOC_SCRIPT_FILE fp
                 ]
+  st <- getCommonState
   runLua >=> forceResult fp $ do
+    userInit st
     setGlobals globals
     runFilterFile fp doc
 

pandoc-lua-engine/src/Text/Pandoc/Lua/Init.hs

@@ -15,13 +15,14 @@ module Text.Pandoc.Lua.Init
   ( runLua
   , runLuaNoEnv
   , runLuaWith
+  , userInit
   ) where
 
 import Control.Monad (when)
 import Control.Monad.Catch (throwM, try)
 import Control.Monad.Trans (MonadIO (..))
 import HsLua as Lua hiding (status, try)
-import Text.Pandoc.Class (PandocMonad (..), report)
+import Text.Pandoc.Class (CommonState, PandocMonad (..), report)
 import Text.Pandoc.Data (readDataFile)
 import Text.Pandoc.Error (PandocError (PandocLuaError))
 import Text.Pandoc.Logging (LogMessage (ScriptingWarning))
@@ -67,7 +68,12 @@ initLuaState = do
   liftPandocLua Lua.openlibs
   setWarnFunction
   initModules
-  liftPandocLua runInitScript
+
+-- | Initialize the user-configured pandoc state and run the init script.
+userInit :: CommonState -> LuaE PandocError ()
+userInit st = do
+  unPandocLua $ putCommonState st
+  runInitScript
 
 -- | Run the @init.lua@ data file as a Lua script.
 runInitScript :: LuaE PandocError ()
@@ -92,26 +98,17 @@ runPandocLuaWith :: (PandocMonad m, MonadIO m)
                  -> PandocLua a
                  -> m a
 runPandocLuaWith runner pLua = do
-  origState <- getCommonState
-  globals <- defaultGlobals
   (result, newState) <- liftIO . runner . unPandocLua $ do
-    putCommonState origState
-    liftPandocLua $ setGlobals globals
+    liftPandocLua $ setGlobals defaultGlobals
     r <- pLua
     c <- getCommonState
     return (r, c)
   putCommonState newState
   return result
 
 -- | Global variables which should always be set.
-defaultGlobals :: PandocMonad m => m [Global]
-defaultGlobals = do
-  commonState <- getCommonState
-  return
-    [ PANDOC_API_VERSION
-    , PANDOC_STATE commonState
-    , PANDOC_VERSION
-    ]
+defaultGlobals :: [Global]
+defaultGlobals = [PANDOC_API_VERSION, PANDOC_VERSION]
 
 setWarnFunction :: PandocLua ()
 setWarnFunction = liftPandocLua . setwarnf' $ \msg -> do

pandoc-lua-engine/src/Text/Pandoc/Lua/Marshal/Chunks.hs

@@ -2,7 +2,7 @@
 {-# LANGUAGE OverloadedStrings    #-}
 {- |
    Module      : Text.Pandoc.Lua.Marshal.Chunks
-   Copyright   : © 2022 Albert Krewinkel
+   Copyright   : © 2022-2024 Albert Krewinkel
    License     : GPL-2.0-or-later
    Maintainer  : Albert Krewinkel <[email protected]>
 

pandoc-lua-engine/src/Text/Pandoc/Lua/Marshal/CommonState.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase           #-}
 {-# LANGUAGE OverloadedStrings    #-}
 {- |
    Module      : Text.Pandoc.Lua.Marshal.CommonState
@@ -13,8 +14,10 @@ module Text.Pandoc.Lua.Marshal.CommonState
   ( typeCommonState
   , peekCommonState
   , pushCommonState
+  , peekCommonStateFromTable
   ) where
 
+import Data.Default (def)
 import HsLua
 import Text.Pandoc.Class (CommonState (..))
 import Text.Pandoc.Lua.Marshal.List (pushPandocList)
@@ -57,3 +60,31 @@ peekCommonState = peekUD typeCommonState
 
 pushCommonState :: LuaError e => Pusher e CommonState
 pushCommonState = pushUD typeCommonState
+
+peekCommonStateFromTable :: LuaError e => Peeker e CommonState
+peekCommonStateFromTable idx = do
+  absidx <- liftLua $ absindex idx
+  let setnext st = do
+        liftLua (next absidx) >>= \case
+          False -> pure st
+          True -> do
+            prop <- peekName (nth 2)
+            case lookup prop setters of
+              Just setter -> setnext =<< setter top st `lastly` pop 1
+              Nothing -> failPeek ("Unknown field " <> fromName prop)
+                         `lastly` pop 1
+  liftLua pushnil
+  setnext def
+
+setters :: LuaError e
+        => [ (Name, StackIndex -> CommonState -> Peek e CommonState)]
+setters =
+  [ ("input_files", mkS (peekList peekString) (\st x -> st{stInputFiles = x}))
+  , ("output_file", mkS (peekNilOr peekString) (\st x -> st{stOutputFile = x}))
+  , ("request_headers", mkS (peekList (peekPair peekText peekText))
+                            (\st x -> st{ stRequestHeaders = x }))
+  , ("user_data_dir", mkS (peekNilOr peekString) (\st x -> st{stUserDataDir = x}))
+  , ("trace", mkS peekBool (\st x -> st{stTrace = x}))
+  ]
+  where
+    mkS peekX setValue idx' st = setValue st <$> peekX idx'

pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Pandoc.hs

@@ -28,11 +28,13 @@ import Data.Proxy (Proxy (Proxy))
 import Data.Text.Encoding.Error (UnicodeException)
 import HsLua
 import System.Exit (ExitCode (..))
+import Text.Pandoc.Class (PandocMonad(putCommonState))
 import Text.Pandoc.Definition
 import Text.Pandoc.Error (PandocError (..))
 import Text.Pandoc.Format (parseFlavoredFormat)
 import Text.Pandoc.Lua.Orphans ()
 import Text.Pandoc.Lua.Marshal.AST
+import Text.Pandoc.Lua.Marshal.CommonState (peekCommonStateFromTable)
 import Text.Pandoc.Lua.Marshal.Format (peekFlavoredFormat)
 import Text.Pandoc.Lua.Marshal.Filter (peekFilter)
 import Text.Pandoc.Lua.Marshal.ReaderOptions ( peekReaderOptions
@@ -194,7 +196,28 @@ stringConstants =
 
 functions :: [DocumentedFunction PandocError]
 functions =
-  [ defun "pipe"
+  [ defun "init"
+    ### (\newCommonState -> do
+            getfield registryindex "PANDOC_STATE" >>= \case
+              TypeNil -> True <$ unPandocLua (putCommonState newCommonState)
+              _ -> pure False)
+    <#> parameter peekCommonStateFromTable "table" "props"
+          "pandoc state properties"
+    =#> boolResult "Whether the initialization succeeded."
+    #? T.unlines
+    [ "Initialize the pandoc state. This function should be called at most"
+    , "once, as further invocations won't have any effect. The state is set"
+    , "only if it hasn't been initialized yet."
+    , ""
+    , "Note that the state is always already initialized in filters and in"
+    , "custom readers or writers. The function is most useful in standalone"
+    , "pandoc Lua programs."
+    , ""
+    , "Returns `true` if the initialization succeeded, and `false` if the Lua"
+    , "state had been initialized before."
+    ]
+
+  , defun "pipe"
     ### (\command args input -> do
             (ec, output) <- Lua.liftIO $ pipeProcess Nothing command args input
                             `catch` (throwM . PandocIOError "pipe")

pandoc-lua-engine/src/Text/Pandoc/Lua/PandocLua.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
@@ -11,7 +12,7 @@
    License     : GPL-2.0-or-later
    Maintainer  : Albert Krewinkel <[email protected]>
 
-PandocMonad instance which allows execution of Lua operations and which
+PandocMonad instance that allows execution of Lua operations; it
 uses Lua to handle state.
 -}
 module Text.Pandoc.Lua.PandocLua
@@ -22,6 +23,7 @@ module Text.Pandoc.Lua.PandocLua
 import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
 import Control.Monad.Except (MonadError (catchError, throwError))
 import Control.Monad.IO.Class (MonadIO)
+import Data.Default (def)
 import HsLua as Lua
 import Text.Pandoc.Class (PandocMonad (..))
 import Text.Pandoc.Error (PandocError (..))
@@ -77,8 +79,13 @@ instance PandocMonad PandocLua where
   getModificationTime = IO.getModificationTime
 
   getCommonState = PandocLua $ do
-    Lua.getfield registryindex "PANDOC_STATE"
-    forcePeek $ peekCommonState Lua.top `lastly` pop 1
+    -- initialize with the default value if is hadn't been initialized yet.
+    Lua.getfield registryindex "PANDOC_STATE" >>= \case
+      TypeNil -> do
+        pop 1 -- pop nil
+        unPandocLua $ putCommonState def
+        return def
+      _       -> forcePeek $ peekCommonState Lua.top `lastly` pop 1
   putCommonState cst = PandocLua $ do
     pushCommonState cst
     Lua.pushvalue Lua.top

pandoc-lua-engine/test/Tests/Lua.hs

@@ -25,12 +25,13 @@ import Text.Pandoc.Builder (bulletList, definitionList, displayMath, divWith,
                             singleQuoted, space, str, strong,
                             HasMeta (setMeta))
 import Text.Pandoc.Class ( CommonState (stVerbosity)
+                         , PandocMonad (getCommonState)
                          , modifyCommonState, runIOorExplode, setUserDataDir)
 import Text.Pandoc.Definition (Attr, Block (BlockQuote, Div, Para), Pandoc,
                                Inline (Emph, Str), pandocTypesVersion)
 import Text.Pandoc.Error (PandocError (PandocLuaError))
 import Text.Pandoc.Logging (Verbosity (ERROR))
-import Text.Pandoc.Lua (Global (..), applyFilter, runLua, setGlobals)
+import Text.Pandoc.Lua (Global (..), applyFilter, runLua, setGlobals, userInit)
 import Text.Pandoc.Options (def)
 import Text.Pandoc.Version (pandocVersionText)
 
@@ -243,7 +244,9 @@ runLuaTest op = runIOorExplode $ do
   -- Disable printing of warnings on stderr: some tests will generate
   -- warnings, we don't want to see those messages.
   modifyCommonState $ \st -> st { stVerbosity = ERROR }
+  st <- getCommonState
   res <- runLua $ do
+    userInit st
     setGlobals [ PANDOC_WRITER_OPTIONS def ]
     op
   case res of