diff options
Diffstat (limited to 'src/Text/Pandoc')
-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 |
4 files changed, 164 insertions, 135 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 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) |