Skip to content

Commit

Permalink
[WIP] Lua: add function pandoc.init
Browse files Browse the repository at this point in the history
  • Loading branch information
tarleb committed Jun 9, 2024
1 parent d9748ef commit 4acf7e5
Show file tree
Hide file tree
Showing 9 changed files with 90 additions and 24 deletions.
3 changes: 2 additions & 1 deletion pandoc-lua-engine/src/Text/Pandoc/Lua.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 ()
4 changes: 3 additions & 1 deletion pandoc-lua-engine/src/Text/Pandoc/Lua/Custom.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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
Expand Down
6 changes: 4 additions & 2 deletions pandoc-lua-engine/src/Text/Pandoc/Lua/Engine.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 (..))
Expand Down Expand Up @@ -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

Expand Down
25 changes: 11 additions & 14 deletions pandoc-lua-engine/src/Text/Pandoc/Lua/Init.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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))
Expand Down Expand Up @@ -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 ()
Expand All @@ -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
Expand Down
2 changes: 1 addition & 1 deletion pandoc-lua-engine/src/Text/Pandoc/Lua/Marshal/Chunks.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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]>
Expand Down
31 changes: 31 additions & 0 deletions pandoc-lua-engine/src/Text/Pandoc/Lua/Marshal/CommonState.hs
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
Module : Text.Pandoc.Lua.Marshal.CommonState
Expand All @@ -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)
Expand Down Expand Up @@ -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'
25 changes: 24 additions & 1 deletion pandoc-lua-engine/src/Text/Pandoc/Lua/Module/Pandoc.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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")
Expand Down
13 changes: 10 additions & 3 deletions pandoc-lua-engine/src/Text/Pandoc/Lua/PandocLua.hs
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
Expand All @@ -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
Expand All @@ -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 (..))
Expand Down Expand Up @@ -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
Expand Down
5 changes: 4 additions & 1 deletion pandoc-lua-engine/test/Tests/Lua.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand Down Expand Up @@ -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
Expand Down

0 comments on commit 4acf7e5

Please sign in to comment.