T.P.Lua: get CommonState from Lua global

This allows more control over the common state from within Lua scripts.

3 files changed, 64 insertions, 54 deletions

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