API change: use new type PandocLua for all pandoc Lua operations

The new type `PandocLua` is an instance of the `PandocMonad` typeclass
and can thus be used in a way similar to `PandocIO`.

pandoc.cabal

@@ -632,6 +632,7 @@ library
                    Text.Pandoc.Lua.Module.Types,
                    Text.Pandoc.Lua.Module.Utils,
                    Text.Pandoc.Lua.Packages,
+                   Text.Pandoc.Lua.PandocLua,
                    Text.Pandoc.Lua.Util,
                    Text.Pandoc.Lua.Walk,
                    Text.Pandoc.CSS,
@@ -736,6 +737,7 @@ test-suite test-pandoc
                   mtl >= 2.2 && < 2.3,
                   bytestring >= 0.9 && < 0.11,
                   base64-bytestring >= 0.1 && < 1.1,
+                  exceptions >= 0.8 && < 0.11,
                   text >= 1.1.1.0 && < 1.3,
                   time >= 1.5 && < 1.10,
                   directory >= 1.2.3 && < 1.4,

src/Text/Pandoc/Filter/JSON.hs

@@ -23,7 +23,6 @@ import System.Directory (executable, doesFileExist, findExecutable,
 import System.Environment (getEnvironment)
 import System.Exit (ExitCode (..))
 import System.FilePath ((</>), takeExtension)
-import Text.Pandoc.Class.PandocIO (PandocIO)
 import Text.Pandoc.Error (PandocError (PandocFilterError))
 import Text.Pandoc.Definition (Pandoc)
 import Text.Pandoc.Options (ReaderOptions)
@@ -32,11 +31,12 @@ import Text.Pandoc.Shared (pandocVersion, tshow)
 import qualified Control.Exception as E
 import qualified Text.Pandoc.UTF8 as UTF8
 
-apply :: ReaderOptions
+apply :: MonadIO m
+      => ReaderOptions
       -> [String]
       -> FilePath
       -> Pandoc
-      -> PandocIO Pandoc
+      -> m Pandoc
 apply ropts args f = liftIO . externalFilter ropts f args
 
 externalFilter :: MonadIO m

src/Text/Pandoc/Lua/Init.hs

@@ -9,9 +9,7 @@
 Functions to initialize the Lua interpreter.
 -}
 module Text.Pandoc.Lua.Init
-  ( LuaPackageParams (..)
-  , runLua
-  , luaPackageParams
+  ( runLua
   ) where
 
 import Control.Monad.Catch (try)
@@ -20,17 +18,12 @@ import Data.Data (Data, dataTypeConstrs, dataTypeOf, showConstr)
 import Foreign.Lua (Lua)
 import GHC.IO.Encoding (getForeignEncoding, setForeignEncoding, utf8)
 import Text.Pandoc.Class.PandocIO (PandocIO)
-import Text.Pandoc.Class.PandocMonad (getCommonState, getUserDataDir,
-                                      putCommonState)
 import Text.Pandoc.Error (PandocError)
-import Text.Pandoc.Lua.ErrorConversion (errorConversion)
-import Text.Pandoc.Lua.Global (Global (..), setGlobals)
-import Text.Pandoc.Lua.Packages (LuaPackageParams (..),
-                                 installPandocPackageSearcher)
-import Text.Pandoc.Lua.Util (loadScriptFromDataDir)
+import Text.Pandoc.Lua.Packages (installPandocPackageSearcher)
+import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua,
+                                  loadScriptFromDataDir, runPandocLua)
 
 import qualified Foreign.Lua as Lua
-import qualified Foreign.Lua.Module.Text as Lua
 import qualified Text.Pandoc.Definition as Pandoc
 import qualified Text.Pandoc.Lua.Module.Pandoc as ModulePandoc
 
@@ -38,65 +31,35 @@ import qualified Text.Pandoc.Lua.Module.Pandoc as ModulePandoc
 -- initialization.
 runLua :: Lua a -> PandocIO (Either PandocError a)
 runLua luaOp = do
-  luaPkgParams <- luaPackageParams
-  globals <- defaultGlobals
   enc <- liftIO $ getForeignEncoding <* setForeignEncoding utf8
-  res <- liftIO . try . Lua.run' errorConversion $ do
-    setGlobals globals
-    initLuaState luaPkgParams
-    -- 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)
+  res <- runPandocLua . try $ do
+    initLuaState
+    liftPandocLua luaOp
   liftIO $ setForeignEncoding enc
-  case res of
-    Left err -> return $ Left err
-    Right (x, newState) -> do
-      putCommonState newState
-      return $ Right x
-
--- | Global variables which should always be set.
-defaultGlobals :: PandocIO [Global]
-defaultGlobals = do
-  commonState <- getCommonState
-  return
-    [ PANDOC_API_VERSION
-    , PANDOC_STATE commonState
-    , PANDOC_VERSION
-    ]
-
--- | Generate parameters required to setup pandoc's lua environment.
-luaPackageParams :: PandocIO LuaPackageParams
-luaPackageParams = do
-  datadir <- getUserDataDir
-  return LuaPackageParams { luaPkgDataDir = datadir }
+  return res
 
 -- | Initialize the lua state with all required values
-initLuaState :: LuaPackageParams -> Lua ()
-initLuaState pkgParams = do
-  Lua.openlibs
-  Lua.preloadTextModule "text"
-  installPandocPackageSearcher pkgParams
+initLuaState :: PandocLua ()
+initLuaState = do
+  liftPandocLua Lua.openlibs
+  installPandocPackageSearcher
   initPandocModule
-  loadScriptFromDataDir (luaPkgDataDir pkgParams) "init.lua"
+  loadScriptFromDataDir "init.lua"
  where
-  initPandocModule :: Lua ()
+  initPandocModule :: PandocLua ()
   initPandocModule = do
     -- Push module table
-    ModulePandoc.pushModule (luaPkgDataDir pkgParams)
+    ModulePandoc.pushModule
     -- register as loaded module
-    Lua.pushvalue Lua.stackTop
-    Lua.getfield Lua.registryindex Lua.loadedTableRegistryField
-    Lua.setfield (Lua.nthFromTop 2) "pandoc"
-    Lua.pop 1
+    liftPandocLua $ do
+      Lua.pushvalue Lua.stackTop
+      Lua.getfield Lua.registryindex Lua.loadedTableRegistryField
+      Lua.setfield (Lua.nthFromTop 2) "pandoc"
+      Lua.pop 1
     -- copy constructors into registry
     putConstructorsInRegistry
     -- assign module to global variable
-    Lua.setglobal "pandoc"
+    liftPandocLua $ Lua.setglobal "pandoc"
 
 -- | AST elements are marshaled via normal constructor functions in the
 -- @pandoc@ module. However, accessing Lua globals from Haskell is
@@ -106,8 +69,8 @@ initLuaState pkgParams = do
 --
 -- This function expects the @pandoc@ module to be at the top of the
 -- stack.
-putConstructorsInRegistry :: Lua ()
-putConstructorsInRegistry = do
+putConstructorsInRegistry :: PandocLua ()
+putConstructorsInRegistry = liftPandocLua $ do
   constrsToReg $ Pandoc.Pandoc mempty mempty
   constrsToReg $ Pandoc.Str mempty
   constrsToReg $ Pandoc.Para mempty

src/Text/Pandoc/Lua/Module/MediaBag.hs

@@ -14,13 +14,13 @@ module Text.Pandoc.Lua.Module.MediaBag
   ) where
 
 import Control.Monad (zipWithM_)
-import Foreign.Lua (Lua, NumResults, Optional, liftIO)
+import Foreign.Lua (Lua, NumResults, Optional)
 import Text.Pandoc.Class.CommonState (CommonState (..))
-import Text.Pandoc.Class.PandocIO (runIOorExplode)
-import Text.Pandoc.Class.PandocMonad (fetchItem, putCommonState, setMediaBag)
+import Text.Pandoc.Class.PandocMonad (fetchItem, getMediaBag, modifyCommonState,
+                                      setMediaBag)
 import Text.Pandoc.Lua.Marshaling ()
 import Text.Pandoc.Lua.Marshaling.MediaBag (pushIterator)
-import Text.Pandoc.Lua.Util (addFunction)
+import Text.Pandoc.Lua.PandocLua (PandocLua (..), liftPandocLua, addFunction)
 import Text.Pandoc.MIME (MimeType)
 
 import qualified Data.ByteString.Lazy as BL
@@ -31,9 +31,9 @@ import qualified Text.Pandoc.MediaBag as MB
 --
 -- MediaBag submodule
 --
-pushModule :: Lua NumResults
+pushModule :: PandocLua NumResults
 pushModule = do
-  Lua.newtable
+  liftPandocLua Lua.newtable
   addFunction "delete" delete
   addFunction "empty" empty
   addFunction "insert" insertMediaFn
@@ -43,66 +43,46 @@ pushModule = do
   addFunction "fetch" fetch
   return 1
 
---
--- 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
-
 -- | Delete a single item from the media bag.
-delete :: FilePath -> Lua NumResults
+delete :: FilePath -> PandocLua NumResults
 delete fp = 0 <$ modifyCommonState
   (\st -> st { stMediaBag = MB.deleteMedia fp (stMediaBag st) })
 
 -- | Delete all items from the media bag.
-empty :: Lua NumResults
+empty :: PandocLua NumResults
 empty = 0 <$ modifyCommonState (\st -> st { stMediaBag = mempty })
 
 -- | Insert a new item into the media bag.
 insertMediaFn :: FilePath
               -> Optional MimeType
               -> BL.ByteString
-              -> Lua NumResults
+              -> PandocLua NumResults
 insertMediaFn fp optionalMime contents = do
-  modifyCommonState $ \st ->
-    let mb = MB.insertMedia fp (Lua.fromOptional optionalMime) contents
-                               (stMediaBag st)
-    in st { stMediaBag = mb }
-  return 0
+  mb <- getMediaBag
+  setMediaBag $ MB.insertMedia fp (Lua.fromOptional optionalMime) contents mb
+  return (Lua.NumResults 0)
 
 -- | Returns iterator values to be used with a Lua @for@ loop.
-items :: Lua NumResults
-items = getCommonState >>= pushIterator . stMediaBag
+items :: PandocLua NumResults
+items = getMediaBag >>= liftPandocLua . pushIterator
 
 lookupMediaFn :: FilePath
-              -> Lua NumResults
+              -> PandocLua NumResults
 lookupMediaFn fp = do
-  res <- MB.lookupMedia fp . stMediaBag <$> getCommonState
-  case res of
+  res <- MB.lookupMedia fp <$> getMediaBag
+  liftPandocLua $ case res of
     Nothing -> 1 <$ Lua.pushnil
     Just (mimeType, contents) -> do
       Lua.push mimeType
       Lua.push contents
       return 2
 
-mediaDirectoryFn :: Lua NumResults
+mediaDirectoryFn :: PandocLua NumResults
 mediaDirectoryFn = do
-  dirContents <- MB.mediaDirectory . stMediaBag <$> getCommonState
-  Lua.newtable
-  zipWithM_ addEntry [1..] dirContents
+  dirContents <- MB.mediaDirectory <$> getMediaBag
+  liftPandocLua $ do
+    Lua.newtable
+    zipWithM_ addEntry [1..] dirContents
   return 1
  where
   addEntry :: Lua.Integer -> (FilePath, MimeType, Int) -> Lua ()
@@ -114,14 +94,9 @@ mediaDirectoryFn = do
     Lua.rawseti (-2) idx
 
 fetch :: T.Text
-      -> Lua NumResults
+      -> PandocLua NumResults
 fetch src = do
-  commonState <- getCommonState
-  let mediaBag = stMediaBag commonState
-  (bs, mimeType) <- liftIO . runIOorExplode $ do
-    putCommonState commonState
-    setMediaBag mediaBag
-    fetchItem src
-  Lua.push $ maybe "" T.unpack mimeType
-  Lua.push bs
+  (bs, mimeType) <- fetchItem src
+  liftPandocLua . Lua.push $ maybe "" T.unpack mimeType
+  liftPandocLua $ Lua.push bs
   return 2 -- returns 2 values: contents, mimetype

src/Text/Pandoc/Lua/Module/Pandoc.hs

@@ -24,6 +24,8 @@ import Text.Pandoc.Class.PandocIO (runIO)
 import Text.Pandoc.Definition (Block, Inline)
 import Text.Pandoc.Lua.Filter (walkInlines, walkBlocks, LuaFilter, SingletonsList (..))
 import Text.Pandoc.Lua.Marshaling ()
+import Text.Pandoc.Lua.PandocLua (PandocLua, addFunction, liftPandocLua,
+                                  loadScriptFromDataDir)
 import Text.Pandoc.Walk (Walkable)
 import Text.Pandoc.Options (ReaderOptions (readerExtensions))
 import Text.Pandoc.Process (pipeProcess)
@@ -38,28 +40,28 @@ import Text.Pandoc.Error
 
 -- | Push the "pandoc" on the lua stack. Requires the `list` module to be
 -- loaded.
-pushModule :: Maybe FilePath -> Lua NumResults
-pushModule datadir = do
-  LuaUtil.loadScriptFromDataDir datadir "pandoc.lua"
-  LuaUtil.addFunction "read" readDoc
-  LuaUtil.addFunction "pipe" pipeFn
-  LuaUtil.addFunction "walk_block" walkBlock
-  LuaUtil.addFunction "walk_inline" walkInline
+pushModule :: PandocLua NumResults
+pushModule = do
+  loadScriptFromDataDir "pandoc.lua"
+  addFunction "read" readDoc
+  addFunction "pipe" pipeFn
+  addFunction "walk_block" walkBlock
+  addFunction "walk_inline" walkInline
   return 1
 
 walkElement :: (Walkable (SingletonsList Inline) a,
                 Walkable (SingletonsList Block) a)
-            => a -> LuaFilter -> Lua a
-walkElement x f = walkInlines f x >>= walkBlocks f
+            => a -> LuaFilter -> PandocLua a
+walkElement x f = liftPandocLua $ walkInlines f x >>= walkBlocks f
 
-walkInline :: Inline -> LuaFilter -> Lua Inline
+walkInline :: Inline -> LuaFilter -> PandocLua Inline
 walkInline = walkElement
 
-walkBlock :: Block -> LuaFilter -> Lua Block
+walkBlock :: Block -> LuaFilter -> PandocLua Block
 walkBlock = walkElement
 
-readDoc :: T.Text -> Optional T.Text -> Lua NumResults
-readDoc content formatSpecOrNil = do
+readDoc :: T.Text -> Optional T.Text -> PandocLua NumResults
+readDoc content formatSpecOrNil = liftPandocLua $ do
   let formatSpec = fromMaybe "markdown" (Lua.fromOptional formatSpecOrNil)
   res <- Lua.liftIO . runIO $
            getReader formatSpec >>= \(rdr,es) ->
@@ -80,8 +82,8 @@ readDoc content formatSpecOrNil = do
 pipeFn :: String
        -> [String]
        -> BL.ByteString
-       -> Lua NumResults
-pipeFn command args input = do
+       -> PandocLua NumResults
+pipeFn command args input = liftPandocLua $ do
   (ec, output) <- Lua.liftIO $ pipeProcess Nothing command args input
   case ec of
     ExitSuccess -> 1 <$ Lua.push output

src/Text/Pandoc/Lua/Module/Utils.hs

@@ -18,13 +18,11 @@ import Control.Monad.Catch (try)
 import Data.Default (def)
 import Data.Version (Version)
 import Foreign.Lua (Peekable, Lua, NumResults)
-import Text.Pandoc.Class.PandocIO (runIO)
-import Text.Pandoc.Class.PandocMonad (setUserDataDir)
 import Text.Pandoc.Definition ( Pandoc, Meta, MetaValue (..), Block, Inline
                               , Citation, Attr, ListAttributes)
 import Text.Pandoc.Error (PandocError)
 import Text.Pandoc.Lua.Marshaling ()
-import Text.Pandoc.Lua.Util (addFunction)
+import Text.Pandoc.Lua.PandocLua (PandocLua, addFunction, liftPandocLua)
 
 import qualified Data.Digest.Pure.SHA as SHA
 import qualified Data.ByteString.Lazy as BSL
@@ -35,14 +33,14 @@ import qualified Text.Pandoc.Filter.JSON as JSONFilter
 import qualified Text.Pandoc.Shared as Shared
 
 -- | Push the "pandoc.utils" module to the lua stack.
-pushModule :: Maybe FilePath -> Lua NumResults
-pushModule mbDatadir = do
-  Lua.newtable
+pushModule :: PandocLua NumResults
+pushModule = do
+  liftPandocLua Lua.newtable
   addFunction "blocks_to_inlines" blocksToInlines
   addFunction "equals" equals
   addFunction "make_sections" makeSections
   addFunction "normalize_date" normalizeDate
-  addFunction "run_json_filter" (runJSONFilter mbDatadir)
+  addFunction "run_json_filter" runJSONFilter
   addFunction "sha1" sha1
   addFunction "stringify" stringify
   addFunction "to_roman_numeral" toRomanNumeral
@@ -50,8 +48,8 @@ pushModule mbDatadir = do
   return 1
 
 -- | Squashes a list of blocks into inlines.
-blocksToInlines :: [Block] -> Lua.Optional [Inline] -> Lua [Inline]
-blocksToInlines blks optSep = do
+blocksToInlines :: [Block] -> Lua.Optional [Inline] -> PandocLua [Inline]
+blocksToInlines blks optSep = liftPandocLua $ do
   let sep = case Lua.fromOptional optSep of
               Just x -> B.fromList x
               Nothing -> Shared.defaultBlocksSeparator
@@ -70,23 +68,17 @@ normalizeDate :: T.Text -> Lua (Lua.Optional T.Text)
 normalizeDate = return . Lua.Optional . Shared.normalizeDate
 
 -- | Run a JSON filter on the given document.
-runJSONFilter :: Maybe FilePath
-              -> Pandoc
+runJSONFilter :: Pandoc
               -> FilePath
               -> Lua.Optional [String]
-              -> Lua NumResults
-runJSONFilter mbDatadir doc filterFile optArgs = do
+              -> PandocLua Pandoc
+runJSONFilter doc filterFile optArgs = do
   args <- case Lua.fromOptional optArgs of
             Just x -> return x
-            Nothing -> do
+            Nothing -> liftPandocLua $ do
               Lua.getglobal "FORMAT"
               (:[]) <$> Lua.popValue
-  filterRes <- Lua.liftIO . runIO $ do
-    setUserDataDir mbDatadir
-    JSONFilter.apply def args filterFile doc
-  case filterRes of
-    Left err -> Lua.raiseError (show err)
-    Right d -> (1 :: NumResults) <$ Lua.push d
+  JSONFilter.apply def args filterFile doc
 
 -- | Calculate the hash of the given contents.
 sha1 :: BSL.ByteString
@@ -96,7 +88,7 @@ sha1 = return . T.pack . SHA.showDigest . SHA.sha1
 -- | Convert pandoc structure to a string with formatting removed.
 -- Footnotes are skipped (since we don't want their contents in link
 -- labels).
-stringify :: AstElement -> Lua T.Text
+stringify :: AstElement -> PandocLua T.Text
 stringify el = return $ case el of
   PandocElement pd -> Shared.stringify pd
   InlineElement i  -> Shared.stringify i
@@ -112,7 +104,7 @@ stringifyMetaValue mv = case mv of
   MetaString s -> s
   _            -> Shared.stringify mv
 
-equals :: AstElement -> AstElement -> Lua Bool
+equals :: AstElement -> AstElement -> PandocLua Bool
 equals e1 e2 = return (e1 == e2)
 
 data AstElement
@@ -141,5 +133,5 @@ instance Peekable AstElement where
         "Expected an AST element, but could not parse value as such."
 
 -- | Convert a number < 4000 to uppercase roman numeral.
-toRomanNumeral :: Lua.Integer -> Lua T.Text
+toRomanNumeral :: Lua.Integer -> PandocLua T.Text
 toRomanNumeral = return . Shared.toRomanNumeral . fromIntegral

src/Text/Pandoc/Lua/Packages.hs

@@ -8,37 +8,32 @@
    Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
    Stability   : alpha
 
-Pandoc module for lua.
+Pandoc module for Lua.
 -}
 module Text.Pandoc.Lua.Packages
-  ( LuaPackageParams (..)
-  , installPandocPackageSearcher
+  ( installPandocPackageSearcher
   ) where
 
 import Control.Monad (forM_)
 import Data.ByteString (ByteString)
-import Foreign.Lua (Lua, NumResults, liftIO)
-import Text.Pandoc.Class.PandocIO (runIO)
-import Text.Pandoc.Class.PandocMonad (readDataFile, setUserDataDir)
+import Foreign.Lua (Lua, NumResults)
+import Text.Pandoc.Class.PandocMonad (readDataFile)
+import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua)
 
 import qualified Foreign.Lua as Lua
-import Text.Pandoc.Lua.Module.Pandoc as Pandoc
-import Text.Pandoc.Lua.Module.MediaBag as MediaBag
-import Text.Pandoc.Lua.Module.System as System
-import Text.Pandoc.Lua.Module.Types as Types
-import Text.Pandoc.Lua.Module.Utils as Utils
-
--- | Parameters used to create lua packages/modules.
-data LuaPackageParams = LuaPackageParams
-  { luaPkgDataDir :: Maybe FilePath
-  }
+import qualified Foreign.Lua.Module.Text as Text
+import qualified Text.Pandoc.Lua.Module.Pandoc as Pandoc
+import qualified Text.Pandoc.Lua.Module.MediaBag as MediaBag
+import qualified Text.Pandoc.Lua.Module.System as System
+import qualified Text.Pandoc.Lua.Module.Types as Types
+import qualified Text.Pandoc.Lua.Module.Utils as Utils
 
 -- | Insert pandoc's package loader as the first loader, making it the default.
-installPandocPackageSearcher :: LuaPackageParams -> Lua ()
-installPandocPackageSearcher luaPkgParams = do
+installPandocPackageSearcher :: PandocLua ()
+installPandocPackageSearcher = liftPandocLua $ do
   Lua.getglobal' "package.searchers"
   shiftArray
-  Lua.pushHaskellFunction (pandocPackageSearcher luaPkgParams)
+  Lua.pushHaskellFunction pandocPackageSearcher
   Lua.rawseti (Lua.nthFromTop 2) 1
   Lua.pop 1           -- remove 'package.searchers' from stack
  where
@@ -47,29 +42,24 @@ installPandocPackageSearcher luaPkgParams = do
     Lua.rawseti (-2) (i + 1)
 
 -- | Load a pandoc module.
-pandocPackageSearcher :: LuaPackageParams -> String -> Lua NumResults
-pandocPackageSearcher pkgParams pkgName =
+pandocPackageSearcher :: String -> PandocLua NumResults
+pandocPackageSearcher pkgName =
   case pkgName of
-    "pandoc"          -> let datadir = luaPkgDataDir pkgParams
-                         in pushWrappedHsFun (Pandoc.pushModule datadir)
+    "pandoc"          -> pushWrappedHsFun Pandoc.pushModule
     "pandoc.mediabag" -> pushWrappedHsFun MediaBag.pushModule
     "pandoc.system"   -> pushWrappedHsFun System.pushModule
     "pandoc.types"    -> pushWrappedHsFun Types.pushModule
-    "pandoc.utils"    -> let datadir = luaPkgDataDir pkgParams
-                         in pushWrappedHsFun (Utils.pushModule datadir)
-    _ -> searchPureLuaLoader
+    "pandoc.utils"    -> pushWrappedHsFun Utils.pushModule
+    "text"            -> pushWrappedHsFun Text.pushModule
+    _                 -> searchPureLuaLoader
  where
-  pushWrappedHsFun f = do
+  pushWrappedHsFun f = liftPandocLua $ do
     Lua.pushHaskellFunction f
     return 1
   searchPureLuaLoader = do
     let filename = pkgName ++ ".lua"
-    modScript <- liftIO (dataDirScript (luaPkgDataDir pkgParams) filename)
-    case modScript of
-      Just script -> pushWrappedHsFun (loadStringAsPackage pkgName script)
-      Nothing -> do
-        Lua.push ("\n\tno file '" ++ filename ++ "' in pandoc's datadir")
-        return 1
+    script <- readDataFile filename
+    pushWrappedHsFun (loadStringAsPackage pkgName script)
 
 loadStringAsPackage :: String -> ByteString -> Lua NumResults
 loadStringAsPackage pkgName script = do
@@ -79,11 +69,3 @@ loadStringAsPackage pkgName script = do
     else do
       msg <- Lua.popValue
       Lua.raiseError ("Error while loading `" <> pkgName <> "`.\n" <> msg)
-
--- | Get the ByteString representation of the pandoc module.
-dataDirScript :: Maybe FilePath -> FilePath -> IO (Maybe ByteString)
-dataDirScript datadir moduleFile = do
-  res <- runIO $ setUserDataDir datadir >> readDataFile moduleFile
-  return $ case res of
-    Left _ -> Nothing
-    Right s -> Just s

src/Text/Pandoc/Lua/PandocLua.hs

@@ -0,0 +1,134 @@
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{- |
+   Module      : Text.Pandoc.Lua.PandocLua
+   Copyright   : Copyright © 2020 Albert Krewinkel
+   License     : GNU GPL, version 2 or above
+
+   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+   Stability   : alpha
+
+PandocMonad instance which allows execution of Lua operations and which
+uses Lua to handle state.
+-}
+module Text.Pandoc.Lua.PandocLua
+  ( PandocLua (..)
+  , runPandocLua
+  , liftPandocLua
+  , addFunction
+  , loadScriptFromDataDir
+  ) where
+
+import Control.Monad (when)
+import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
+import Control.Monad.Except (MonadError (catchError, throwError))
+import Control.Monad.IO.Class (MonadIO (liftIO))
+import Foreign.Lua (Lua (..), NumResults, Pushable, ToHaskellFunction)
+import Text.Pandoc.Class.PandocIO (PandocIO)
+import Text.Pandoc.Class.PandocMonad (PandocMonad (..), readDataFile)
+import Text.Pandoc.Error (PandocError)
+import Text.Pandoc.Lua.Global (Global (..), setGlobals)
+import Text.Pandoc.Lua.ErrorConversion (errorConversion)
+
+import qualified Control.Monad.Catch as Catch
+import qualified Foreign.Lua as Lua
+import qualified Text.Pandoc.Class.IO as IO
+import qualified Text.Pandoc.Lua.Util as LuaUtil
+
+-- | Type providing access to both, pandoc and Lua operations.
+newtype PandocLua a = PandocLua { unPandocLua :: Lua a }
+  deriving
+    ( Applicative
+    , Functor
+    , Monad
+    , MonadCatch
+    , MonadIO
+    , MonadMask
+    , MonadThrow
+    )
+
+-- | Lift a @'Lua'@ operation into the @'PandocLua'@ type.
+liftPandocLua :: Lua a -> PandocLua a
+liftPandocLua = PandocLua
+
+-- | Evaluate a @'PandocLua'@ computation, running all contained Lua
+-- operations..
+runPandocLua :: PandocLua a -> PandocIO a
+runPandocLua pLua = do
+  origState <- getCommonState
+  globals <- defaultGlobals
+  (result, newState) <- liftIO . Lua.run' errorConversion . unPandocLua $ do
+    putCommonState origState
+    liftPandocLua $ setGlobals globals
+    r <- pLua
+    c <- getCommonState
+    return (r, c)
+  putCommonState newState
+  return result
+
+instance {-# OVERLAPPING #-} ToHaskellFunction (PandocLua NumResults) where
+  toHsFun _narg = unPandocLua
+
+instance Pushable a => ToHaskellFunction (PandocLua a) where
+  toHsFun _narg x = 1 <$ (unPandocLua x >>= Lua.push)
+
+-- | Add a function to the table at the top of the stack, using the given name.
+addFunction :: ToHaskellFunction a => String -> a -> PandocLua ()
+addFunction name fn = liftPandocLua $ do
+  Lua.push name
+  Lua.pushHaskellFunction fn
+  Lua.rawset (-3)
+
+-- | Load a file from pandoc's data directory.
+loadScriptFromDataDir :: FilePath -> PandocLua ()
+loadScriptFromDataDir scriptFile = do
+  script <- readDataFile scriptFile
+  status <- liftPandocLua $ Lua.dostring script
+  when (status /= Lua.OK) . liftPandocLua $
+    LuaUtil.throwTopMessageAsError'
+      (("Couldn't load '" ++ scriptFile ++ "'.\n") ++)
+
+-- | Global variables which should always be set.
+defaultGlobals :: PandocIO [Global]
+defaultGlobals = do
+  commonState <- getCommonState
+  return
+    [ PANDOC_API_VERSION
+    , PANDOC_STATE commonState
+    , PANDOC_VERSION
+    ]
+
+instance MonadError PandocError PandocLua where
+  catchError = Catch.catch
+  throwError = Catch.throwM
+
+instance PandocMonad PandocLua where
+  lookupEnv = IO.lookupEnv
+  getCurrentTime = IO.getCurrentTime
+  getCurrentTimeZone = IO.getCurrentTimeZone
+  newStdGen = IO.newStdGen
+  newUniqueHash = IO.newUniqueHash
+
+  openURL = IO.openURL
+
+  readFileLazy = IO.readFileLazy
+  readFileStrict = IO.readFileStrict
+
+  glob = IO.glob
+  fileExists = IO.fileExists
+  getDataFileName = IO.getDataFileName
+  getModificationTime = IO.getModificationTime
+
+  getCommonState = PandocLua $ do
+    Lua.getglobal "PANDOC_STATE"
+    Lua.peek Lua.stackTop
+  putCommonState = PandocLua . setGlobals . (:[]) . PANDOC_STATE
+
+  logOutput = IO.logOutput

src/Text/Pandoc/Lua/Util.hs

@@ -19,7 +19,6 @@ module Text.Pandoc.Lua.Util
   , addFunction
   , addValue
   , pushViaConstructor
-  , loadScriptFromDataDir
   , defineHowTo
   , throwTopMessageAsError'
   , callWithTraceback
@@ -27,13 +26,11 @@ module Text.Pandoc.Lua.Util
   ) where
 
 import Control.Monad (unless, when)
+import Data.Text (Text)
 import Foreign.Lua ( Lua, NumArgs, NumResults, Peekable, Pushable, StackIndex
                    , Status, ToHaskellFunction )
-import Text.Pandoc.Class.PandocIO (runIOorExplode)
-import Text.Pandoc.Class.PandocMonad (readDataFile, setUserDataDir)
 import qualified Foreign.Lua as Lua
 import qualified Text.Pandoc.UTF8 as UTF8
-import Data.Text (Text)
 
 -- | Get value behind key from table at given index.
 rawField :: Peekable a => StackIndex -> String -> Lua a
@@ -87,15 +84,6 @@ pushViaCall fn = pushViaCall' fn (return ()) 0
 pushViaConstructor :: PushViaCall a => String -> a
 pushViaConstructor pandocFn = pushViaCall ("pandoc." ++ pandocFn)
 
--- | Load a file from pandoc's data directory.
-loadScriptFromDataDir :: Maybe FilePath -> FilePath -> Lua ()
-loadScriptFromDataDir datadir scriptFile = do
-  script <- Lua.liftIO . runIOorExplode $
-            setUserDataDir datadir >> readDataFile scriptFile
-  status <- Lua.dostring script
-  when (status /= Lua.OK) $
-    throwTopMessageAsError' (("Couldn't load '" ++ scriptFile ++ "'.\n") ++)
-
 -- | Get the tag of a value. This is an optimized and specialized version of
 -- @Lua.getfield idx "tag"@. It only checks for the field on the table at index
 -- @idx@ and on its metatable, also ignoring any @__index@ value on the
@@ -144,7 +132,8 @@ pcallWithTraceback nargs nresults = do
 callWithTraceback :: NumArgs -> NumResults -> Lua ()
 callWithTraceback nargs nresults = do
   result <- pcallWithTraceback nargs nresults
-  when (result /= Lua.OK) Lua.throwTopMessage
+  when (result /= Lua.OK)
+    Lua.throwTopMessage
 
 -- | Run the given string as a Lua program, while also adding a traceback to the
 -- error message if an error occurs.