diff options
author | Albert Krewinkel <albert@zeitkraut.de> | 2017-12-13 21:15:41 +0100 |
---|---|---|
committer | Albert Krewinkel <albert@zeitkraut.de> | 2017-12-13 21:15:41 +0100 |
commit | 4c64af4407776e6ceb2fcc8a803b83568b4c1964 (patch) | |
tree | 4903cad8f3892a41133f62dd5a36f477aaf7ca7f /src/Text | |
parent | f9d0e1c89cf8deca97a005d8cd6d2d601e422e24 (diff) | |
download | pandoc-4c64af4407776e6ceb2fcc8a803b83568b4c1964.tar.gz |
Custom writer: use init file to setup Lua interpreter
The same init file (`data/init`) that is used to setup the Lua
interpreter for Lua filters is also used to setup the interpreter of
custom writers.lua.
Diffstat (limited to 'src/Text')
-rw-r--r-- | src/Text/Pandoc/App.hs | 4 | ||||
-rw-r--r-- | src/Text/Pandoc/Lua.hs | 55 | ||||
-rw-r--r-- | src/Text/Pandoc/Lua/Init.hs | 79 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/Custom.hs | 23 |
4 files changed, 106 insertions, 55 deletions
diff --git a/src/Text/Pandoc/App.hs b/src/Text/Pandoc/App.hs index f7d6450cc..e70b606a9 100644 --- a/src/Text/Pandoc/App.hs +++ b/src/Text/Pandoc/App.hs @@ -223,7 +223,7 @@ convertWithOpts opts = do if ".lua" `isSuffixOf` format -- note: use non-lowercased version writerName then return (TextWriter - (\o d -> liftIO $ writeCustom writerName o d) + (\o d -> writeCustom writerName o d) :: Writer PandocIO, mempty) else case getWriter writerName of Left e -> E.throwIO $ PandocAppError $ @@ -846,7 +846,7 @@ applyLuaFilters :: Maybe FilePath -> [FilePath] -> String -> Pandoc applyLuaFilters mbDatadir filters format d = do expandedFilters <- mapM (expandFilterPath mbDatadir) filters let go f d' = do - res <- runLuaFilter mbDatadir f format d' + res <- runLuaFilter f format d' case res of Right x -> return x Left (LuaException s) -> E.throw (PandocFilterError f s) diff --git a/src/Text/Pandoc/Lua.hs b/src/Text/Pandoc/Lua.hs index 696f4de44..a56e89511 100644 --- a/src/Text/Pandoc/Lua.hs +++ b/src/Text/Pandoc/Lua.hs @@ -27,43 +27,32 @@ Running pandoc Lua filters. -} module Text.Pandoc.Lua ( LuaException (..) - , LuaPackageParams (..) - , pushPandocModule , runLuaFilter - , initLuaState - , luaPackageParams + , runPandocLua + , pushPandocModule ) where import Control.Monad (when, (>=>)) -import Control.Monad.Trans (MonadIO (..)) -import Data.IORef (newIORef, readIORef) import Foreign.Lua (FromLuaStack (peek), Lua, LuaException (..), Status (OK), ToLuaStack (push)) -import Text.Pandoc.Class (PandocIO, getCommonState, getMediaBag, setMediaBag) -import Text.Pandoc.Definition +import Text.Pandoc.Class (PandocIO) +import Text.Pandoc.Definition (Pandoc) import Text.Pandoc.Lua.Filter (LuaFilter, walkMWithLuaFilter) -import Text.Pandoc.Lua.Packages (LuaPackageParams (..), - installPandocPackageSearcher) +import Text.Pandoc.Lua.Init (runPandocLua) import Text.Pandoc.Lua.PandocModule (pushPandocModule) -- TODO: remove -import Text.Pandoc.Lua.Util (loadScriptFromDataDir) import qualified Foreign.Lua as Lua -import qualified Foreign.Lua.Module.Text as Lua -runLuaFilter :: Maybe FilePath -> FilePath -> String +-- | Run the Lua filter in @filterPath@ for a transformation to target +-- format @format@. Pandoc uses Lua init files to setup the Lua +-- interpreter. +runLuaFilter :: FilePath -> String -> Pandoc -> PandocIO (Either LuaException Pandoc) -runLuaFilter datadir filterPath format pd = do - luaPkgParams <- luaPackageParams datadir - res <- liftIO . Lua.runLuaEither $ - runLuaFilter' luaPkgParams filterPath format pd - newMediaBag <- liftIO (readIORef (luaPkgMediaBag luaPkgParams)) - setMediaBag newMediaBag - return res +runLuaFilter filterPath format doc = + runPandocLua (runLuaFilter' filterPath format doc) -runLuaFilter' :: LuaPackageParams - -> FilePath -> String +runLuaFilter' :: FilePath -> String -> Pandoc -> Lua Pandoc -runLuaFilter' luaPkgOpts filterPath format pd = do - initLuaState luaPkgOpts +runLuaFilter' filterPath format pd = do -- store module in global "pandoc" registerFormat top <- Lua.gettop @@ -83,24 +72,6 @@ runLuaFilter' luaPkgOpts filterPath format pd = do push format Lua.setglobal "FORMAT" -luaPackageParams :: Maybe FilePath -> PandocIO LuaPackageParams -luaPackageParams datadir = do - commonState <- getCommonState - mbRef <- liftIO . newIORef =<< getMediaBag - return LuaPackageParams - { luaPkgCommonState = commonState - , luaPkgDataDir = datadir - , luaPkgMediaBag = mbRef - } - --- Initialize the lua state with all required values -initLuaState :: LuaPackageParams -> Lua () -initLuaState luaPkgParams = do - Lua.openlibs - Lua.preloadTextModule "text" - installPandocPackageSearcher luaPkgParams - loadScriptFromDataDir (luaPkgDataDir luaPkgParams) "init.lua" - pushGlobalFilter :: Lua () pushGlobalFilter = do Lua.newtable diff --git a/src/Text/Pandoc/Lua/Init.hs b/src/Text/Pandoc/Lua/Init.hs new file mode 100644 index 000000000..a2bfa3801 --- /dev/null +++ b/src/Text/Pandoc/Lua/Init.hs @@ -0,0 +1,79 @@ +{- +Copyright © 2017 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +-} +{- | + Module : Text.Pandoc.Lua + Copyright : Copyright © 2017 Albert Krewinkel + License : GNU GPL, version 2 or above + + Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> + Stability : alpha + +Functions to initialize the Lua interpreter. +-} +module Text.Pandoc.Lua.Init + ( LuaException (..) + , LuaPackageParams (..) + , runPandocLua + , initLuaState + , luaPackageParams + ) where + +import Control.Monad.Trans (MonadIO (..)) +import Data.IORef (newIORef, readIORef) +import Foreign.Lua (Lua, LuaException (..)) +import GHC.IO.Encoding (getForeignEncoding, setForeignEncoding, utf8) +import Text.Pandoc.Class (PandocIO, getCommonState, getUserDataDir, getMediaBag, + setMediaBag) +import Text.Pandoc.Lua.Packages (LuaPackageParams (..), + installPandocPackageSearcher) +import Text.Pandoc.Lua.Util (loadScriptFromDataDir) + +import qualified Foreign.Lua as Lua +import qualified Foreign.Lua.Module.Text as Lua + +-- | Run the lua interpreter, using pandoc's default way of environment +-- initalization. +runPandocLua :: Lua a -> PandocIO (Either LuaException a) +runPandocLua luaOp = do + datadir <- getUserDataDir + luaPkgParams <- luaPackageParams datadir + enc <- liftIO $ getForeignEncoding <* setForeignEncoding utf8 + res <- liftIO $ Lua.runLuaEither (initLuaState luaPkgParams *> luaOp) + liftIO $ setForeignEncoding enc + newMediaBag <- liftIO (readIORef (luaPkgMediaBag luaPkgParams)) + setMediaBag newMediaBag + return res + +-- | Generate parameters required to setup pandoc's lua environment. +luaPackageParams :: Maybe FilePath -> PandocIO LuaPackageParams +luaPackageParams datadir = do + commonState <- getCommonState + mbRef <- liftIO . newIORef =<< getMediaBag + return LuaPackageParams + { luaPkgCommonState = commonState + , luaPkgDataDir = datadir + , luaPkgMediaBag = mbRef + } + +-- Initialize the lua state with all required values +initLuaState :: LuaPackageParams -> Lua () +initLuaState luaPkgParams = do + Lua.openlibs + Lua.preloadTextModule "text" + installPandocPackageSearcher luaPkgParams + loadScriptFromDataDir (luaPkgDataDir luaPkgParams) "init.lua" diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs index ffe637966..72f443ed0 100644 --- a/src/Text/Pandoc/Writers/Custom.hs +++ b/src/Text/Pandoc/Writers/Custom.hs @@ -33,18 +33,20 @@ module Text.Pandoc.Writers.Custom ( writeCustom ) where import Control.Arrow ((***)) import Control.Exception import Control.Monad (when) +import Control.Monad.Trans (MonadIO (liftIO)) import Data.Char (toLower) import Data.List (intersperse) import qualified Data.Map as M import Data.Text (Text, pack) import Data.Typeable -import Foreign.Lua (Lua, ToLuaStack (..), callFunc, runLua) +import Foreign.Lua (Lua, ToLuaStack (..), callFunc) import Foreign.Lua.Api -import GHC.IO.Encoding (getForeignEncoding, setForeignEncoding, utf8) +import Text.Pandoc.Class (PandocIO) import Text.Pandoc.Definition import Text.Pandoc.Error +import Text.Pandoc.Lua.Init (runPandocLua) import Text.Pandoc.Lua.StackInstances () -import Text.Pandoc.Lua.Util (addValue) +import Text.Pandoc.Lua.Util (addValue, dostring') import Text.Pandoc.Options import Text.Pandoc.Templates import qualified Text.Pandoc.UTF8 as UTF8 @@ -91,14 +93,11 @@ data PandocLuaException = PandocLuaException String instance Exception PandocLuaException -- | Convert Pandoc to custom markup. -writeCustom :: FilePath -> WriterOptions -> Pandoc -> IO Text +writeCustom :: FilePath -> WriterOptions -> Pandoc -> PandocIO Text writeCustom luaFile opts doc@(Pandoc meta _) = do - luaScript <- UTF8.readFile luaFile - enc <- getForeignEncoding - setForeignEncoding utf8 - (body, context) <- runLua $ do - openlibs - stat <- loadstring luaScript + luaScript <- liftIO $ UTF8.readFile luaFile + res <- runPandocLua $ do + stat <- dostring' luaScript -- check for error in lua script (later we'll change the return type -- to handle this more gracefully): when (stat /= OK) $ @@ -111,7 +110,9 @@ writeCustom luaFile opts doc@(Pandoc meta _) = do inlineListToCustom meta return (rendered, context) - setForeignEncoding enc + let (body, context) = case res of + Left e -> throw (PandocLuaException (show e)) + Right x -> x case writerTemplate opts of Nothing -> return $ pack body Just tpl -> |