diff options
author | John MacFarlane <jgm@berkeley.edu> | 2017-12-13 21:42:06 -0700 |
---|---|---|
committer | GitHub <noreply@github.com> | 2017-12-13 21:42:06 -0700 |
commit | 52a8116e71636f05053c959675b3abcb745e921a (patch) | |
tree | f9b7efe3a7569c689255824977b21c877ab22b16 | |
parent | 440533643e768b584194aaac59e26e35d53f6745 (diff) | |
parent | 4c64af4407776e6ceb2fcc8a803b83568b4c1964 (diff) | |
download | pandoc-52a8116e71636f05053c959675b3abcb745e921a.tar.gz |
Merge pull request #4153 from tarleb/unify-lua-init
Unify lua initalization
-rw-r--r-- | pandoc.cabal | 3 | ||||
-rw-r--r-- | src/Text/Pandoc/App.hs | 4 | ||||
-rw-r--r-- | src/Text/Pandoc/Lua.hs | 67 | ||||
-rw-r--r-- | src/Text/Pandoc/Lua/Init.hs | 79 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/Custom.hs | 149 | ||||
-rw-r--r-- | test/Tests/Lua.hs | 31 |
6 files changed, 184 insertions, 149 deletions
diff --git a/pandoc.cabal b/pandoc.cabal index fa02ebfd9..0d05172d5 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -523,9 +523,10 @@ library Text.Pandoc.Readers.Org.ParserState, Text.Pandoc.Readers.Org.Parsing, Text.Pandoc.Readers.Org.Shared, + Text.Pandoc.Lua.Filter, + Text.Pandoc.Lua.Init, Text.Pandoc.Lua.Packages, Text.Pandoc.Lua.PandocModule, - Text.Pandoc.Lua.Filter, Text.Pandoc.Lua.StackInstances, Text.Pandoc.Lua.Util, Text.Pandoc.CSS, 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 7132ad718..a56e89511 100644 --- a/src/Text/Pandoc/Lua.hs +++ b/src/Text/Pandoc/Lua.hs @@ -1,9 +1,3 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} {- Copyright © 2017 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> @@ -29,48 +23,36 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de> Stability : alpha -Pandoc lua utils. +Running pandoc Lua filters. -} module Text.Pandoc.Lua ( LuaException (..) - , LuaPackageParams (..) - , pushPandocModule , runLuaFilter - , initLuaState - , luaPackageParams + , runPandocLua + , pushPandocModule ) where import Control.Monad (when, (>=>)) -import Control.Monad.Identity (Identity) -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 @@ -90,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 @@ -117,6 +81,3 @@ pushGlobalFilter = do runAll :: [LuaFilter] -> Pandoc -> Lua Pandoc runAll = foldr ((>=>) . walkMWithLuaFilter) return - -instance (FromLuaStack a) => FromLuaStack (Identity a) where - peek = fmap return . peek 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 87b97dcee..72f443ed0 100644 --- a/src/Text/Pandoc/Writers/Custom.hs +++ b/src/Text/Pandoc/Writers/Custom.hs @@ -1,11 +1,5 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} -{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} -#if MIN_VERSION_base(4,8,0) -#else -{-# LANGUAGE OverlappingInstances #-} -#endif {- Copyright (C) 2012-2017 John MacFarlane <jgm@berkeley.edu> This program is free software; you can redistribute it and/or modify @@ -36,19 +30,23 @@ Conversion of 'Pandoc' documents to custom markup using a lua writer. -} 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.Util (addValue) +import Text.Pandoc.Lua.Init (runPandocLua) +import Text.Pandoc.Lua.StackInstances () +import Text.Pandoc.Lua.Util (addValue, dostring') import Text.Pandoc.Options import Text.Pandoc.Templates import qualified Text.Pandoc.UTF8 as UTF8 @@ -60,43 +58,31 @@ attrToMap (id',classes,keyvals) = M.fromList : ("class", unwords classes) : keyvals -instance ToLuaStack Double where - push = push . (realToFrac :: Double -> LuaNumber) - -instance ToLuaStack Int where - push = push . (fromIntegral :: Int -> LuaInteger) - -instance ToLuaStack Format where - push (Format f) = push (map toLower f) - -#if MIN_VERSION_base(4,8,0) -instance {-# OVERLAPS #-} ToLuaStack [Inline] where -#else -instance ToLuaStack [Inline] where -#endif - push ils = push =<< inlineListToCustom ils - -#if MIN_VERSION_base(4,8,0) -instance {-# OVERLAPS #-} ToLuaStack [Block] where -#else -instance ToLuaStack [Block] where -#endif - push ils = push =<< blockListToCustom ils - -instance ToLuaStack MetaValue where - push (MetaMap m) = push m - push (MetaList xs) = push xs - push (MetaBool x) = push x - push (MetaString s) = push s - push (MetaInlines ils) = push ils - push (MetaBlocks bs) = push bs - -instance ToLuaStack Citation where - push cit = do +newtype Stringify a = Stringify a + +instance ToLuaStack (Stringify Format) where + push (Stringify (Format f)) = push (map toLower f) + +instance ToLuaStack (Stringify [Inline]) where + push (Stringify ils) = push =<< inlineListToCustom ils + +instance ToLuaStack (Stringify [Block]) where + push (Stringify blks) = push =<< blockListToCustom blks + +instance ToLuaStack (Stringify MetaValue) where + push (Stringify (MetaMap m)) = push (fmap Stringify m) + push (Stringify (MetaList xs)) = push (map Stringify xs) + push (Stringify (MetaBool x)) = push x + push (Stringify (MetaString s)) = push s + push (Stringify (MetaInlines ils)) = push (Stringify ils) + push (Stringify (MetaBlocks bs)) = push (Stringify bs) + +instance ToLuaStack (Stringify Citation) where + push (Stringify cit) = do createtable 6 0 addValue "citationId" $ citationId cit - addValue "citationPrefix" $ citationPrefix cit - addValue "citationSuffix" $ citationSuffix cit + addValue "citationPrefix" . Stringify $ citationPrefix cit + addValue "citationSuffix" . Stringify $ citationSuffix cit addValue "citationMode" $ show (citationMode cit) addValue "citationNoteNum" $ citationNoteNum cit addValue "citationHash" $ citationHash cit @@ -107,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) $ @@ -127,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 -> @@ -138,7 +123,7 @@ writeCustom luaFile opts doc@(Pandoc meta _) = do docToCustom :: WriterOptions -> Pandoc -> Lua String docToCustom opts (Pandoc (Meta metamap) blocks) = do body <- blockListToCustom blocks - callFunc "Doc" body metamap (writerVariables opts) + callFunc "Doc" body (fmap Stringify metamap) (writerVariables opts) -- | Convert Pandoc block element to Custom. blockToCustom :: Block -- ^ Block element @@ -146,41 +131,45 @@ blockToCustom :: Block -- ^ Block element blockToCustom Null = return "" -blockToCustom (Plain inlines) = callFunc "Plain" inlines +blockToCustom (Plain inlines) = callFunc "Plain" (Stringify inlines) blockToCustom (Para [Image attr txt (src,tit)]) = - callFunc "CaptionedImage" src tit txt (attrToMap attr) + callFunc "CaptionedImage" src tit (Stringify txt) (attrToMap attr) -blockToCustom (Para inlines) = callFunc "Para" inlines +blockToCustom (Para inlines) = callFunc "Para" (Stringify inlines) -blockToCustom (LineBlock linesList) = callFunc "LineBlock" linesList +blockToCustom (LineBlock linesList) = callFunc "LineBlock" (map Stringify linesList) blockToCustom (RawBlock format str) = - callFunc "RawBlock" format str + callFunc "RawBlock" (Stringify format) str blockToCustom HorizontalRule = callFunc "HorizontalRule" blockToCustom (Header level attr inlines) = - callFunc "Header" level inlines (attrToMap attr) + callFunc "Header" level (Stringify inlines) (attrToMap attr) blockToCustom (CodeBlock attr str) = callFunc "CodeBlock" str (attrToMap attr) -blockToCustom (BlockQuote blocks) = callFunc "BlockQuote" blocks +blockToCustom (BlockQuote blocks) = callFunc "BlockQuote" (Stringify blocks) -blockToCustom (Table capt aligns widths headers rows') = - callFunc "Table" capt (map show aligns) widths headers rows' +blockToCustom (Table capt aligns widths headers rows) = + let aligns' = map show aligns + capt' = Stringify capt + headers' = map Stringify headers + rows' = map (map Stringify) rows + in callFunc "Table" capt' aligns' widths headers' rows' -blockToCustom (BulletList items) = callFunc "BulletList" items +blockToCustom (BulletList items) = callFunc "BulletList" (map Stringify items) blockToCustom (OrderedList (num,sty,delim) items) = - callFunc "OrderedList" items num (show sty) (show delim) + callFunc "OrderedList" (map Stringify items) num (show sty) (show delim) blockToCustom (DefinitionList items) = - callFunc "DefinitionList" items + callFunc "DefinitionList" (map (Stringify *** map Stringify) items) blockToCustom (Div attr items) = - callFunc "Div" items (attrToMap attr) + callFunc "Div" (Stringify items) (attrToMap attr) -- | Convert list of Pandoc block elements to Custom. blockListToCustom :: [Block] -- ^ List of block elements @@ -205,23 +194,23 @@ inlineToCustom Space = callFunc "Space" inlineToCustom SoftBreak = callFunc "SoftBreak" -inlineToCustom (Emph lst) = callFunc "Emph" lst +inlineToCustom (Emph lst) = callFunc "Emph" (Stringify lst) -inlineToCustom (Strong lst) = callFunc "Strong" lst +inlineToCustom (Strong lst) = callFunc "Strong" (Stringify lst) -inlineToCustom (Strikeout lst) = callFunc "Strikeout" lst +inlineToCustom (Strikeout lst) = callFunc "Strikeout" (Stringify lst) -inlineToCustom (Superscript lst) = callFunc "Superscript" lst +inlineToCustom (Superscript lst) = callFunc "Superscript" (Stringify lst) -inlineToCustom (Subscript lst) = callFunc "Subscript" lst +inlineToCustom (Subscript lst) = callFunc "Subscript" (Stringify lst) -inlineToCustom (SmallCaps lst) = callFunc "SmallCaps" lst +inlineToCustom (SmallCaps lst) = callFunc "SmallCaps" (Stringify lst) -inlineToCustom (Quoted SingleQuote lst) = callFunc "SingleQuoted" lst +inlineToCustom (Quoted SingleQuote lst) = callFunc "SingleQuoted" (Stringify lst) -inlineToCustom (Quoted DoubleQuote lst) = callFunc "DoubleQuoted" lst +inlineToCustom (Quoted DoubleQuote lst) = callFunc "DoubleQuoted" (Stringify lst) -inlineToCustom (Cite cs lst) = callFunc "Cite" lst cs +inlineToCustom (Cite cs lst) = callFunc "Cite" (Stringify lst) (map Stringify cs) inlineToCustom (Code attr str) = callFunc "Code" str (attrToMap attr) @@ -233,17 +222,17 @@ inlineToCustom (Math InlineMath str) = callFunc "InlineMath" str inlineToCustom (RawInline format str) = - callFunc "RawInline" format str + callFunc "RawInline" (Stringify format) str inlineToCustom LineBreak = callFunc "LineBreak" inlineToCustom (Link attr txt (src,tit)) = - callFunc "Link" txt src tit (attrToMap attr) + callFunc "Link" (Stringify txt) src tit (attrToMap attr) inlineToCustom (Image attr alt (src,tit)) = - callFunc "Image" alt src tit (attrToMap attr) + callFunc "Image" (Stringify alt) src tit (attrToMap attr) -inlineToCustom (Note contents) = callFunc "Note" contents +inlineToCustom (Note contents) = callFunc "Note" (Stringify contents) inlineToCustom (Span attr items) = - callFunc "Span" items (attrToMap attr) + callFunc "Span" (Stringify items) (attrToMap attr) diff --git a/test/Tests/Lua.hs b/test/Tests/Lua.hs index eaa7eb405..4f14a834b 100644 --- a/test/Tests/Lua.hs +++ b/test/Tests/Lua.hs @@ -10,9 +10,9 @@ import Text.Pandoc.Arbitrary () import Text.Pandoc.Builder (bulletList, divWith, doc, doubleQuoted, emph, header, linebreak, para, plain, rawBlock, singleQuoted, space, str, strong, (<>)) -import Text.Pandoc.Class (runIOorExplode) +import Text.Pandoc.Class (runIOorExplode, setUserDataDir) import Text.Pandoc.Definition (Block, Inline, Meta, Pandoc) -import Text.Pandoc.Lua (initLuaState, runLuaFilter, luaPackageParams) +import Text.Pandoc.Lua (runLuaFilter, runPandocLua) import qualified Foreign.Lua as Lua @@ -95,8 +95,9 @@ tests = map (localOption (QuickCheckTests 20)) assertFilterConversion :: String -> FilePath -> Pandoc -> Pandoc -> Assertion assertFilterConversion msg filterPath docIn docExpected = do - docEither <- runIOorExplode $ - runLuaFilter (Just "../data") ("lua" </> filterPath) [] docIn + docEither <- runIOorExplode $ do + setUserDataDir (Just "../data") + runLuaFilter ("lua" </> filterPath) [] docIn case docEither of Left _ -> fail "lua filter failed" Right docRes -> assertEqual msg docExpected docRes @@ -105,14 +106,18 @@ roundtripEqual :: (Eq a, Lua.FromLuaStack a, Lua.ToLuaStack a) => a -> IO Bool roundtripEqual x = (x ==) <$> roundtripped where roundtripped :: (Lua.FromLuaStack a, Lua.ToLuaStack a) => IO a - roundtripped = Lua.runLua $ do - initLuaState =<< Lua.liftIO (runIOorExplode (luaPackageParams (Just "../data"))) - oldSize <- Lua.gettop - Lua.push x - size <- Lua.gettop - when (size - oldSize /= 1) $ - error ("not exactly one additional element on the stack: " ++ show size) - res <- Lua.peekEither (-1) + roundtripped = runIOorExplode $ do + setUserDataDir (Just "../data") + res <- runPandocLua $ do + oldSize <- Lua.gettop + Lua.push x + size <- Lua.gettop + when (size - oldSize /= 1) $ + error ("not exactly one additional element on the stack: " ++ show size) + res <- Lua.peekEither (-1) + case res of + Left _ -> error "could not read from stack" + Right y -> return y case res of - Left _ -> error "could not read from stack" + Left e -> error (show e) Right y -> return y |