aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Text/Pandoc/Filter/JSON.hs6
-rw-r--r--src/Text/Pandoc/Lua/Init.hs83
-rw-r--r--src/Text/Pandoc/Lua/Module/MediaBag.hs77
-rw-r--r--src/Text/Pandoc/Lua/Module/Pandoc.hs32
-rw-r--r--src/Text/Pandoc/Lua/Module/Utils.hs38
-rw-r--r--src/Text/Pandoc/Lua/Packages.hs64
-rw-r--r--src/Text/Pandoc/Lua/PandocLua.hs134
-rw-r--r--src/Text/Pandoc/Lua/Util.hs17
8 files changed, 244 insertions, 207 deletions
diff --git a/src/Text/Pandoc/Filter/JSON.hs b/src/Text/Pandoc/Filter/JSON.hs
index 7e27f7d94..83ec9a97c 100644
--- a/src/Text/Pandoc/Filter/JSON.hs
+++ b/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
diff --git a/src/Text/Pandoc/Lua/Init.hs b/src/Text/Pandoc/Lua/Init.hs
index 76a7d0bdc..a5e513a1f 100644
--- a/src/Text/Pandoc/Lua/Init.hs
+++ b/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
diff --git a/src/Text/Pandoc/Lua/Module/MediaBag.hs b/src/Text/Pandoc/Lua/Module/MediaBag.hs
index 3a296ef46..e5a10217a 100644
--- a/src/Text/Pandoc/Lua/Module/MediaBag.hs
+++ b/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
diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs
index f376d0044..3886568b7 100644
--- a/src/Text/Pandoc/Lua/Module/Pandoc.hs
+++ b/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
diff --git a/src/Text/Pandoc/Lua/Module/Utils.hs b/src/Text/Pandoc/Lua/Module/Utils.hs
index 36bb2f59c..4fe5e255d 100644
--- a/src/Text/Pandoc/Lua/Module/Utils.hs
+++ b/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
diff --git a/src/Text/Pandoc/Lua/Packages.hs b/src/Text/Pandoc/Lua/Packages.hs
index ad338f4bd..79d42a6d7 100644
--- a/src/Text/Pandoc/Lua/Packages.hs
+++ b/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
diff --git a/src/Text/Pandoc/Lua/PandocLua.hs b/src/Text/Pandoc/Lua/PandocLua.hs
new file mode 100644
index 000000000..6c3b410dd
--- /dev/null
+++ b/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
diff --git a/src/Text/Pandoc/Lua/Util.hs b/src/Text/Pandoc/Lua/Util.hs
index 66bba5a34..c6639e94c 100644
--- a/src/Text/Pandoc/Lua/Util.hs
+++ b/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.
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-05 21:50:07 +0000