From 62cf21cbaa9ac3fbc2ba7218a3037208364c80a4 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Mon, 3 Dec 2018 08:24:28 +0100 Subject: 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`. --- src/Text/Pandoc/Filter/JSON.hs | 6 +- src/Text/Pandoc/Lua/Init.hs | 83 ++++++-------------- src/Text/Pandoc/Lua/Module/MediaBag.hs | 77 +++++++------------ src/Text/Pandoc/Lua/Module/Pandoc.hs | 32 ++++---- src/Text/Pandoc/Lua/Module/Utils.hs | 38 ++++------ src/Text/Pandoc/Lua/Packages.hs | 64 ++++++---------- src/Text/Pandoc/Lua/PandocLua.hs | 134 +++++++++++++++++++++++++++++++++ src/Text/Pandoc/Lua/Util.hs | 17 +---- 8 files changed, 244 insertions(+), 207 deletions(-) create mode 100644 src/Text/Pandoc/Lua/PandocLua.hs (limited to 'src/Text/Pandoc') 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 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 + 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. -- cgit v1.2.3