From 85470c49fe52b9fec5b5d35255f94c7833670131 Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <albert@zeitkraut.de>
Date: Sat, 16 Feb 2019 12:08:22 +0100
Subject: T.P.Lua: get CommonState from Lua global
This allows more control over the common state from within Lua scripts.
---
src/Text/Pandoc/Lua/Init.hs | 30 ++++++++--------
src/Text/Pandoc/Lua/Module/MediaBag.hs | 66 +++++++++++++++++++++-------------
src/Text/Pandoc/Lua/Packages.hs | 22 +++++-------
3 files changed, 64 insertions(+), 54 deletions(-)
(limited to 'src/Text/Pandoc/Lua')
diff --git a/src/Text/Pandoc/Lua/Init.hs b/src/Text/Pandoc/Lua/Init.hs
index f05076b20..b0b506add 100644
--- a/src/Text/Pandoc/Lua/Init.hs
+++ b/src/Text/Pandoc/Lua/Init.hs
@@ -36,11 +36,10 @@ module Text.Pandoc.Lua.Init
import Prelude
import Control.Monad.Trans (MonadIO (..))
import Data.Data (Data, dataTypeConstrs, dataTypeOf, showConstr)
-import Data.IORef (newIORef, readIORef)
import Foreign.Lua (Lua)
import GHC.IO.Encoding (getForeignEncoding, setForeignEncoding, utf8)
import Text.Pandoc.Class (PandocIO, getCommonState, getUserDataDir,
- getMediaBag, setMediaBag)
+ putCommonState)
import Text.Pandoc.Lua.Global (Global (..), setGlobals)
import Text.Pandoc.Lua.Packages (LuaPackageParams (..),
installPandocPackageSearcher)
@@ -64,13 +63,20 @@ runLua luaOp = do
res <- liftIO . Lua.runEither $ do
setGlobals globals
initLuaState luaPkgParams
- luaOp
+ -- run the given Lua operation
+ opResult <- luaOp
+ -- get the (possibly modified) state back
+ Lua.getglobal "PANDOC_STATE"
+ st <- Lua.peek Lua.stackTop
+ Lua.pop 1
+ -- done
+ return (opResult, st)
liftIO $ setForeignEncoding enc
- newMediaBag <- liftIO (readIORef (luaPkgMediaBag luaPkgParams))
- setMediaBag newMediaBag
- return $ case res of
- Left (Lua.Exception msg) -> Left (LuaException msg)
- Right x -> Right x
+ case res of
+ Left (Lua.Exception msg) -> return $ Left (LuaException msg)
+ Right (x, newState) -> do
+ putCommonState newState
+ return $ Right x
-- | Global variables which should always be set.
defaultGlobals :: PandocIO [Global]
@@ -85,14 +91,8 @@ defaultGlobals = do
-- | Generate parameters required to setup pandoc's lua environment.
luaPackageParams :: PandocIO LuaPackageParams
luaPackageParams = do
- commonState <- getCommonState
datadir <- getUserDataDir
- mbRef <- liftIO . newIORef =<< getMediaBag
- return LuaPackageParams
- { luaPkgCommonState = commonState
- , luaPkgDataDir = datadir
- , luaPkgMediaBag = mbRef
- }
+ return LuaPackageParams { luaPkgDataDir = datadir }
-- | Initialize the lua state with all required values
initLuaState :: LuaPackageParams -> Lua ()
diff --git a/src/Text/Pandoc/Lua/Module/MediaBag.hs b/src/Text/Pandoc/Lua/Module/MediaBag.hs
index 3c3f59907..eabab11ed 100644
--- a/src/Text/Pandoc/Lua/Module/MediaBag.hs
+++ b/src/Text/Pandoc/Lua/Module/MediaBag.hs
@@ -32,7 +32,6 @@ module Text.Pandoc.Lua.Module.MediaBag
import Prelude
import Control.Monad (zipWithM_)
-import Data.IORef (IORef, modifyIORef', readIORef)
import Data.Maybe (fromMaybe)
import Foreign.Lua (Lua, NumResults, Optional, liftIO)
import Text.Pandoc.Class (CommonState (..), fetchItem, putCommonState,
@@ -48,30 +47,49 @@ import qualified Text.Pandoc.MediaBag as MB
--
-- MediaBag submodule
--
-pushModule :: CommonState -> IORef MB.MediaBag -> Lua NumResults
-pushModule commonState mediaBagRef = do
+pushModule :: Lua NumResults
+pushModule = do
Lua.newtable
- addFunction "insert" (insertMediaFn mediaBagRef)
- addFunction "lookup" (lookupMediaFn mediaBagRef)
- addFunction "list" (mediaDirectoryFn mediaBagRef)
- addFunction "fetch" (fetch commonState mediaBagRef)
+ addFunction "insert" insertMediaFn
+ addFunction "lookup" lookupMediaFn
+ addFunction "list" mediaDirectoryFn
+ addFunction "fetch" fetch
return 1
-insertMediaFn :: IORef MB.MediaBag
- -> FilePath
+--
+-- Port functions from Text.Pandoc.Class to the Lua monad.
+-- TODO: reuse existing functions.
+
+-- Get the current CommonState.
+getCommonState :: Lua CommonState
+getCommonState = do
+ Lua.getglobal "PANDOC_STATE"
+ Lua.peek Lua.stackTop
+
+-- Replace MediaBag in CommonState.
+setCommonState :: CommonState -> Lua ()
+setCommonState st = do
+ Lua.push st
+ Lua.setglobal "PANDOC_STATE"
+
+modifyCommonState :: (CommonState -> CommonState) -> Lua ()
+modifyCommonState f = getCommonState >>= setCommonState . f
+
+insertMediaFn :: FilePath
-> Optional MimeType
-> BL.ByteString
-> Lua NumResults
-insertMediaFn mbRef fp optionalMime contents = do
- liftIO . modifyIORef' mbRef $
- MB.insertMedia fp (Lua.fromOptional optionalMime) contents
+insertMediaFn fp optionalMime contents = do
+ modifyCommonState $ \st ->
+ let mb = MB.insertMedia fp (Lua.fromOptional optionalMime) contents
+ (stMediaBag st)
+ in st { stMediaBag = mb}
return 0
-lookupMediaFn :: IORef MB.MediaBag
- -> FilePath
+lookupMediaFn :: FilePath
-> Lua NumResults
-lookupMediaFn mbRef fp = do
- res <- MB.lookupMedia fp <$> liftIO (readIORef mbRef)
+lookupMediaFn fp = do
+ res <- MB.lookupMedia fp . stMediaBag <$> getCommonState
case res of
Nothing -> Lua.pushnil *> return 1
Just (mimeType, contents) -> do
@@ -79,10 +97,9 @@ lookupMediaFn mbRef fp = do
Lua.push contents
return 2
-mediaDirectoryFn :: IORef MB.MediaBag
- -> Lua NumResults
-mediaDirectoryFn mbRef = do
- dirContents <- MB.mediaDirectory <$> liftIO (readIORef mbRef)
+mediaDirectoryFn :: Lua NumResults
+mediaDirectoryFn = do
+ dirContents <- MB.mediaDirectory . stMediaBag <$> getCommonState
Lua.newtable
zipWithM_ addEntry [1..] dirContents
return 1
@@ -95,12 +112,11 @@ mediaDirectoryFn mbRef = do
Lua.push "length" *> Lua.push contentLength *> Lua.rawset (-3)
Lua.rawseti (-2) idx
-fetch :: CommonState
- -> IORef MB.MediaBag
- -> String
+fetch :: String
-> Lua NumResults
-fetch commonState mbRef src = do
- mediaBag <- liftIO $ readIORef mbRef
+fetch src = do
+ commonState <- getCommonState
+ let mediaBag = stMediaBag commonState
(bs, mimeType) <- liftIO . runIOorExplode $ do
putCommonState commonState
setMediaBag mediaBag
diff --git a/src/Text/Pandoc/Lua/Packages.hs b/src/Text/Pandoc/Lua/Packages.hs
index d1b679962..8a6f939da 100644
--- a/src/Text/Pandoc/Lua/Packages.hs
+++ b/src/Text/Pandoc/Lua/Packages.hs
@@ -36,10 +36,8 @@ module Text.Pandoc.Lua.Packages
import Prelude
import Control.Monad (forM_)
import Data.ByteString (ByteString)
-import Data.IORef (IORef)
import Foreign.Lua (Lua, NumResults, liftIO)
-import Text.Pandoc.Class (CommonState, readDataFile, runIO, setUserDataDir)
-import Text.Pandoc.MediaBag (MediaBag)
+import Text.Pandoc.Class (readDataFile, runIO, setUserDataDir)
import qualified Foreign.Lua as Lua
import Text.Pandoc.Lua.Module.Pandoc as Pandoc
@@ -48,9 +46,7 @@ import Text.Pandoc.Lua.Module.Utils as Utils
-- | Parameters used to create lua packages/modules.
data LuaPackageParams = LuaPackageParams
- { luaPkgCommonState :: CommonState
- , luaPkgDataDir :: Maybe FilePath
- , luaPkgMediaBag :: IORef MediaBag
+ { luaPkgDataDir :: Maybe FilePath
}
-- | Insert pandoc's package loader as the first loader, making it the default.
@@ -68,15 +64,13 @@ installPandocPackageSearcher luaPkgParams = do
-- | Load a pandoc module.
pandocPackageSearcher :: LuaPackageParams -> String -> Lua NumResults
-pandocPackageSearcher luaPkgParams pkgName =
+pandocPackageSearcher pkgParams pkgName =
case pkgName of
- "pandoc" -> let datadir = luaPkgDataDir luaPkgParams
+ "pandoc" -> let datadir = luaPkgDataDir pkgParams
in pushWrappedHsFun (Pandoc.pushModule datadir)
- "pandoc.mediabag" -> let st = luaPkgCommonState luaPkgParams
- mbRef = luaPkgMediaBag luaPkgParams
- in pushWrappedHsFun (MediaBag.pushModule st mbRef)
- "pandoc.utils" -> let datadirMb = luaPkgDataDir luaPkgParams
- in pushWrappedHsFun (Utils.pushModule datadirMb)
+ "pandoc.mediabag" -> pushWrappedHsFun MediaBag.pushModule
+ "pandoc.utils" -> let datadir = luaPkgDataDir pkgParams
+ in pushWrappedHsFun (Utils.pushModule datadir)
_ -> searchPureLuaLoader
where
pushWrappedHsFun f = do
@@ -84,7 +78,7 @@ pandocPackageSearcher luaPkgParams pkgName =
return 1
searchPureLuaLoader = do
let filename = pkgName ++ ".lua"
- modScript <- liftIO (dataDirScript (luaPkgDataDir luaPkgParams) filename)
+ modScript <- liftIO (dataDirScript (luaPkgDataDir pkgParams) filename)
case modScript of
Just script -> pushWrappedHsFun (loadStringAsPackage pkgName script)
Nothing -> do
--
cgit v1.2.3