From 4cb2fea9d09c2c9044fd9c49f50b293b87ddf7f5 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sat, 11 Feb 2017 01:29:42 +0100 Subject: [PATCH 01/10] Add rudimentary support for lua filters Allows to run a very basic lua script. --- pandoc.cabal | 2 ++ pandoc.hs | 1 - src/Text/Pandoc/App.hs | 16 ++++++++++ src/Text/Pandoc/Lua.hs | 70 ++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 88 insertions(+), 1 deletion(-) create mode 100644 src/Text/Pandoc/Lua.hs diff --git a/pandoc.cabal b/pandoc.cabal index 68722dfac972..e9385b1a4b49 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -282,6 +282,7 @@ Library pandoc-types >= 1.17 && < 1.18, aeson >= 0.7 && < 1.2, aeson-pretty >= 0.8 && < 0.9, + hslua-aeson >= 0.1.0 && < 1, tagsoup >= 0.13.7 && < 0.15, base64-bytestring >= 0.1 && < 1.1, zlib >= 0.5 && < 0.7, @@ -396,6 +397,7 @@ Library Text.Pandoc.Writers.Muse, Text.Pandoc.Writers.Math, Text.Pandoc.Writers.Shared, + Text.Pandoc.Lua, Text.Pandoc.PDF, Text.Pandoc.UTF8, Text.Pandoc.Templates, diff --git a/pandoc.hs b/pandoc.hs index abee2ac50758..f4fcd328a3c5 100644 --- a/pandoc.hs +++ b/pandoc.hs @@ -37,4 +37,3 @@ import Text.Pandoc.App (convertWithOpts, defaultOpts, options, parseOptions) main :: IO () main = parseOptions options defaultOpts >>= convertWithOpts - diff --git a/src/Text/Pandoc/App.hs b/src/Text/Pandoc/App.hs index 34eadb6e03b9..d555f6f5f1be 100644 --- a/src/Text/Pandoc/App.hs +++ b/src/Text/Pandoc/App.hs @@ -69,6 +69,7 @@ import Text.Pandoc import Text.Pandoc.Builder (setMeta) import Text.Pandoc.Class (PandocIO, getLog, withMediaBag) import Text.Pandoc.Highlighting (highlightingStyles) +import Text.Pandoc.Lua ( runLuaFilter ) import Text.Pandoc.MediaBag (MediaBag, extractMediaBag, mediaDirectory) import Text.Pandoc.PDF (makePDF) import Text.Pandoc.Process (pipeProcess) @@ -389,6 +390,7 @@ convertWithOpts opts = do doc' <- (maybe return (extractMedia media) (optExtractMedia opts) >=> return . flip (foldr addMetadata) (optMetadata opts) >=> applyTransforms transforms >=> + applyLuaFilters datadir (optLuaFilters opts) [format] >=> applyFilters datadir filters' [format]) doc case writer of @@ -514,6 +516,7 @@ data Opt = Opt , optWrapText :: WrapOption -- ^ Options for wrapping text , optColumns :: Int -- ^ Line length in characters , optFilters :: [FilePath] -- ^ Filters to apply + , optLuaFilters :: [FilePath] -- ^ Lua filters to apply , optEmailObfuscation :: ObfuscationMethod , optIdentifierPrefix :: String , optIndentedCodeClasses :: [String] -- ^ Default classes for indented code blocks @@ -580,6 +583,7 @@ defaultOpts = Opt , optWrapText = WrapAuto , optColumns = 72 , optFilters = [] + , optLuaFilters = [] , optEmailObfuscation = NoObfuscation , optIdentifierPrefix = "" , optIndentedCodeClasses = [] @@ -725,6 +729,12 @@ expandFilterPath mbDatadir fp = liftIO $ do else return fp _ -> return fp +applyLuaFilters :: MonadIO m + => Maybe FilePath -> [FilePath] -> [String] -> Pandoc -> m Pandoc +applyLuaFilters mbDatadir filters args d = do + expandedFilters <- mapM (expandFilterPath mbDatadir) filters + foldrM ($) d $ map (flip runLuaFilter args) expandedFilters + applyFilters :: MonadIO m => Maybe FilePath -> [FilePath] -> [String] -> Pandoc -> m Pandoc applyFilters mbDatadir filters args d = do @@ -814,6 +824,12 @@ options = "PROGRAM") "" -- "External JSON filter" + , Option "" ["lua-filter"] + (ReqArg + (\arg opt -> return opt { optLuaFilters = arg : optLuaFilters opt }) + "SCRIPTPATH") + "" -- "Lua filter" + , Option "p" ["preserve-tabs"] (NoArg (\opt -> return opt { optPreserveTabs = True })) diff --git a/src/Text/Pandoc/Lua.hs b/src/Text/Pandoc/Lua.hs new file mode 100644 index 000000000000..1e4cadc7f91a --- /dev/null +++ b/src/Text/Pandoc/Lua.hs @@ -0,0 +1,70 @@ +{- +Copyright © 2017 Albert Krewinkel + +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 +-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{- | + Module : Text.Pandoc.Lua + Copyright : Copyright © 2017 Albert Krewinkel + License : GNU GPL, version 2 or above + + Maintainer : Albert Krewinkel + Stability : alpha + +Pandoc lua utils. +-} +module Text.Pandoc.Lua ( runLuaFilter ) where + +import Control.Monad.Trans ( MonadIO(..) ) +import Data.Aeson ( ToJSON(..), fromJSON, Value, Result(..) ) +import Data.Text ( pack, unpack ) +import Data.Text.Encoding ( decodeUtf8 ) +import Scripting.Lua ( StackValue(..) ) +import Scripting.Lua.Aeson () +import Text.Pandoc.Definition ( Pandoc ) + +import qualified Scripting.Lua as Lua +import qualified Scripting.Lua as LuaAeson + +runLuaFilter :: (MonadIO m) + => FilePath -> [String] -> Pandoc -> m Pandoc +runLuaFilter filterPath args pd = liftIO $ do + lua <- LuaAeson.newstate + Lua.openlibs lua + status <- Lua.loadfile lua filterPath + if (status /= 0) + then do + luaErrMsg <- unpack . decodeUtf8 <$> Lua.tostring lua 1 + error luaErrMsg + else do + Lua.call lua 0 0 + doc <- Lua.callfunc lua "run_filter" pd (map pack args) + Lua.close lua + return doc + +instance StackValue Pandoc where + push lua = Lua.push lua . toJSON + peek lua i = maybeFromJson <$> peek lua i + valuetype _ = Lua.TTABLE + +maybeFromJson :: Maybe Value -> Maybe Pandoc +maybeFromJson = \case + Nothing -> Nothing + Just v -> case fromJSON v of + Success pd -> Just pd + _ -> Nothing From a25027ca11608c88ad963c1ed7500fef57b04471 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sat, 11 Feb 2017 20:40:11 +0100 Subject: [PATCH 02/10] Lua filter: use walkM to modify document --- src/Text/Pandoc/Lua.hs | 51 ++++++++++++++++++++++++++++++++++-------- 1 file changed, 42 insertions(+), 9 deletions(-) diff --git a/src/Text/Pandoc/Lua.hs b/src/Text/Pandoc/Lua.hs index 1e4cadc7f91a..982f8fec5dea 100644 --- a/src/Text/Pandoc/Lua.hs +++ b/src/Text/Pandoc/Lua.hs @@ -15,8 +15,10 @@ 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 -} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {- | Module : Text.Pandoc.Lua @@ -30,13 +32,15 @@ Pandoc lua utils. -} module Text.Pandoc.Lua ( runLuaFilter ) where +import Control.Monad ( (>=>) ) import Control.Monad.Trans ( MonadIO(..) ) -import Data.Aeson ( ToJSON(..), fromJSON, Value, Result(..) ) +import Data.Aeson ( FromJSON(..), ToJSON(..), Result(..), Value, fromJSON ) import Data.Text ( pack, unpack ) import Data.Text.Encoding ( decodeUtf8 ) import Scripting.Lua ( StackValue(..) ) import Scripting.Lua.Aeson () -import Text.Pandoc.Definition ( Pandoc ) +import Text.Pandoc.Definition ( Block(..), Inline(..), Pandoc(..) ) +import Text.Pandoc.Walk import qualified Scripting.Lua as Lua import qualified Scripting.Lua as LuaAeson @@ -53,18 +57,47 @@ runLuaFilter filterPath args pd = liftIO $ do error luaErrMsg else do Lua.call lua 0 0 - doc <- Lua.callfunc lua "run_filter" pd (map pack args) + Lua.push lua (map pack args) + Lua.setglobal lua "PandocParameters" + doc <- luaFilter (undefined::Pandoc) lua "filter_doc" >=> + luaFilter (undefined::Block) lua "filter_block" >=> + luaFilter (undefined::Inline) lua "filter_inline" $ + pd Lua.close lua return doc +luaFilter :: forall a. (StackValue a, Walkable a Pandoc) + => a -> Lua.LuaState -> String -> Pandoc -> IO Pandoc +luaFilter _ lua luaFn x = do + fnExists <- isLuaFunction lua luaFn + if fnExists + then walkM (Lua.callfunc lua luaFn :: a -> IO a) x + else return x + +isLuaFunction :: Lua.LuaState -> String -> IO Bool +isLuaFunction lua fnName = do + Lua.getglobal lua fnName + ltype <- Lua.ltype lua (-1) + Lua.pop lua (-1) + return $ ltype == Lua.TFUNCTION + +maybeFromJson :: (FromJSON a) => Maybe Value -> Maybe a +maybeFromJson mv = fromJSON <$> mv >>= \case + Success x -> Just x + _ -> Nothing + instance StackValue Pandoc where push lua = Lua.push lua . toJSON peek lua i = maybeFromJson <$> peek lua i valuetype _ = Lua.TTABLE -maybeFromJson :: Maybe Value -> Maybe Pandoc -maybeFromJson = \case - Nothing -> Nothing - Just v -> case fromJSON v of - Success pd -> Just pd - _ -> Nothing +instance StackValue Block where + push lua = Lua.push lua . toJSON + peek lua i = maybeFromJson <$> peek lua i + valuetype _ = Lua.TTABLE + +instance StackValue Inline where + push lua = Lua.push lua . toJSON + peek lua i = maybeFromJson <$> peek lua i + valuetype _ = Lua.TTABLE + From d4d35908ff32229ba50b777e127a4b4302d1ff19 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sat, 11 Feb 2017 23:07:20 +0100 Subject: [PATCH 03/10] Add hslua-aeson to stack's extra-deps --- stack.yaml | 1 + 1 file changed, 1 insertion(+) diff --git a/stack.yaml b/stack.yaml index fbc9338b316e..df4edf7b0cea 100644 --- a/stack.yaml +++ b/stack.yaml @@ -8,6 +8,7 @@ flags: packages: - '.' extra-deps: +- hslua-aeson-0.1.0.0 - skylighting-0.3.1 - texmath-0.9.3 resolver: lts-8.4 From 38160949e590c09fa037502f6f003004e9941ae6 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sun, 12 Feb 2017 23:57:10 +0100 Subject: [PATCH 04/10] Offload constructor comparison from Lua to Haskell --- src/Text/Pandoc/Lua.hs | 142 +++++++++++++++++++++++++++++++++++++---- 1 file changed, 128 insertions(+), 14 deletions(-) diff --git a/src/Text/Pandoc/Lua.hs b/src/Text/Pandoc/Lua.hs index 982f8fec5dea..e5d40aee3ced 100644 --- a/src/Text/Pandoc/Lua.hs +++ b/src/Text/Pandoc/Lua.hs @@ -32,16 +32,19 @@ Pandoc lua utils. -} module Text.Pandoc.Lua ( runLuaFilter ) where -import Control.Monad ( (>=>) ) +import Control.Monad ( (>=>), when ) import Control.Monad.Trans ( MonadIO(..) ) import Data.Aeson ( FromJSON(..), ToJSON(..), Result(..), Value, fromJSON ) -import Data.Text ( pack, unpack ) +import Data.HashMap.Lazy ( HashMap ) +import Data.Maybe ( fromMaybe ) +import Data.Text ( Text, pack, unpack ) import Data.Text.Encoding ( decodeUtf8 ) -import Scripting.Lua ( StackValue(..) ) +import Scripting.Lua ( LuaState, StackValue(..) ) import Scripting.Lua.Aeson () import Text.Pandoc.Definition ( Block(..), Inline(..), Pandoc(..) ) import Text.Pandoc.Walk +import qualified Data.HashMap.Lazy as HashMap import qualified Scripting.Lua as Lua import qualified Scripting.Lua as LuaAeson @@ -50,36 +53,147 @@ runLuaFilter :: (MonadIO m) runLuaFilter filterPath args pd = liftIO $ do lua <- LuaAeson.newstate Lua.openlibs lua + Lua.newtable lua + Lua.setglobal lua "PANDOC_FILTER_FUNCTIONS" -- hack, store functions here status <- Lua.loadfile lua filterPath if (status /= 0) then do luaErrMsg <- unpack . decodeUtf8 <$> Lua.tostring lua 1 error luaErrMsg else do - Lua.call lua 0 0 + Lua.call lua 0 1 + Just luaFilters <- Lua.peek lua (-1) Lua.push lua (map pack args) Lua.setglobal lua "PandocParameters" - doc <- luaFilter (undefined::Pandoc) lua "filter_doc" >=> - luaFilter (undefined::Block) lua "filter_block" >=> - luaFilter (undefined::Inline) lua "filter_inline" $ - pd + doc <- runAll luaFilters >=> documentFilter lua "filter_doc" $ pd Lua.close lua return doc -luaFilter :: forall a. (StackValue a, Walkable a Pandoc) - => a -> Lua.LuaState -> String -> Pandoc -> IO Pandoc -luaFilter _ lua luaFn x = do +runAll :: [LuaFilter] -> Pandoc -> IO Pandoc +runAll [] = return +runAll (x:xs) = walkMWithLuaFilter x >=> runAll xs + +luaFilter :: Lua.LuaState -> String -> Pandoc -> IO Pandoc +luaFilter lua luaFn x = do fnExists <- isLuaFunction lua luaFn if fnExists - then walkM (Lua.callfunc lua luaFn :: a -> IO a) x + then walkM (Lua.callfunc lua luaFn :: Pandoc -> IO Pandoc) x else return x +walkMWithLuaFilter :: LuaFilter -> Pandoc -> IO Pandoc +walkMWithLuaFilter lf doc = case lf of + InlineLuaFilter lua fnMap -> walkM (execInlineLuaFilter lua fnMap) doc + BlockLuaFilter lua fnMap -> walkM (execBlockLuaFilter lua fnMap) doc + +data LuaFilter + = InlineLuaFilter LuaState (HashMap Text (LuaFilterFunction Inline)) + | BlockLuaFilter LuaState (HashMap Text (LuaFilterFunction Block)) + +newtype LuaFilterFunction a = LuaFilterFunction { functionIndex :: Int } + +execBlockLuaFilter :: LuaState + -> HashMap Text (LuaFilterFunction Block) + -> Block -> IO Block +execBlockLuaFilter lua fnMap x = do + let filterOrId constr = case HashMap.lookup constr fnMap of + Nothing -> return x + Just fn -> runLuaFilterFunction lua fn x + case x of + Plain _ -> filterOrId "Plain" + Para _ -> filterOrId "Para" + LineBlock _ -> filterOrId "LineBlock" + CodeBlock _ _ -> filterOrId "CodeBlock" + RawBlock _ _ -> filterOrId "RawBlock" + BlockQuote _ -> filterOrId "BlockQuote" + OrderedList _ _ -> filterOrId "OrderedList" + BulletList _ -> filterOrId "BulletList" + DefinitionList _ -> filterOrId "DefinitionList" + Header _ _ _ -> filterOrId "Header" + HorizontalRule -> filterOrId "HorizontalRule" + Table _ _ _ _ _ -> filterOrId "Table" + Div _ _ -> filterOrId "Div" + Null -> filterOrId "Null" + +execInlineLuaFilter :: LuaState + -> HashMap Text (LuaFilterFunction Inline) + -> Inline -> IO Inline +execInlineLuaFilter lua fnMap x = do + let filterOrId constr = case HashMap.lookup constr fnMap of + Nothing -> return x + Just fn -> runLuaFilterFunction lua fn x + case x of + Str _ -> filterOrId "Str" + Emph _ -> filterOrId "Emph" + Strong _ -> filterOrId "Strong" + Strikeout _ -> filterOrId "Strikeout" + Superscript _ -> filterOrId "Superscript" + Subscript _ -> filterOrId "Subscript" + SmallCaps _ -> filterOrId "SmallCaps" + Quoted _ _ -> filterOrId "Quoted" + Cite _ _ -> filterOrId "Cite" + Code _ _ -> filterOrId "Code" + Space -> filterOrId "Space" + SoftBreak -> filterOrId "SoftBreak" + LineBreak -> filterOrId "LineBreak" + Math _ _ -> filterOrId "Math" + RawInline _ _ -> filterOrId "RawInline" + Link _ _ _ -> filterOrId "Link" + Image _ _ _ -> filterOrId "Image" + Note _ -> filterOrId "Note" + Span _ _ -> filterOrId "Span" + +instance StackValue LuaFilter where + valuetype _ = Lua.TTABLE + push lua (InlineLuaFilter _ fnMap) = Lua.push lua fnMap + push lua (BlockLuaFilter _ fnMap) = Lua.push lua fnMap + peek lua i = do + Lua.getmetatable lua i + Lua.rawgeti lua (-1) 1 + (mtMarker :: Text) <- fromMaybe (error "No filter type set") <$> peek lua (-1) + Lua.pop lua 2 + case mtMarker of + "Inline" -> fmap (InlineLuaFilter lua) <$> Lua.peek lua i + "Block" -> fmap (BlockLuaFilter lua) <$> Lua.peek lua i + _ -> error "Unknown filter type" + +runLuaFilterFunction :: (StackValue a) + => LuaState -> LuaFilterFunction a -> a -> IO a +runLuaFilterFunction lua lf inline = do + pushFilterFunction lua lf + Lua.push lua inline + Lua.call lua 1 1 + Just res <- Lua.peek lua (-1) + Lua.pop lua 1 + return res + +-- FIXME: use registry +pushFilterFunction :: Lua.LuaState -> LuaFilterFunction a -> IO () +pushFilterFunction lua lf = do + Lua.getglobal lua "PANDOC_FILTER_FUNCTIONS" + Lua.rawgeti lua (-1) (functionIndex lf) + Lua.remove lua (-2) -- remove global from stack + +instance StackValue (LuaFilterFunction a) where + valuetype _ = Lua.TFUNCTION + push lua v = pushFilterFunction lua v + peek lua i = do + isFn <- Lua.isfunction lua i + when (not isFn) (error $ "Not a function at index " ++ (show i)) + Lua.pushvalue lua i + Lua.getglobal lua "PANDOC_FILTER_FUNCTIONS" + len <- Lua.objlen lua (-1) + Lua.insert lua (-2) + Lua.rawseti lua (-2) (len + 1) + Lua.pop lua 1 + return . Just $ LuaFilterFunction (len + 1) + + isLuaFunction :: Lua.LuaState -> String -> IO Bool isLuaFunction lua fnName = do Lua.getglobal lua fnName - ltype <- Lua.ltype lua (-1) + res <- Lua.isfunction lua (-1) Lua.pop lua (-1) - return $ ltype == Lua.TFUNCTION + return res maybeFromJson :: (FromJSON a) => Maybe Value -> Maybe a maybeFromJson mv = fromJSON <$> mv >>= \case From 194281a7c86e8786cf7f6ce1191976b7385061f9 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sat, 11 Mar 2017 19:54:54 +0100 Subject: [PATCH 05/10] Allow inline and block filter within the same table --- src/Text/Pandoc/Lua.hs | 56 ++++++++++++++++++------------------------ 1 file changed, 24 insertions(+), 32 deletions(-) diff --git a/src/Text/Pandoc/Lua.hs b/src/Text/Pandoc/Lua.hs index e5d40aee3ced..80529b58234e 100644 --- a/src/Text/Pandoc/Lua.hs +++ b/src/Text/Pandoc/Lua.hs @@ -36,7 +36,6 @@ import Control.Monad ( (>=>), when ) import Control.Monad.Trans ( MonadIO(..) ) import Data.Aeson ( FromJSON(..), ToJSON(..), Result(..), Value, fromJSON ) import Data.HashMap.Lazy ( HashMap ) -import Data.Maybe ( fromMaybe ) import Data.Text ( Text, pack, unpack ) import Data.Text.Encoding ( decodeUtf8 ) import Scripting.Lua ( LuaState, StackValue(..) ) @@ -65,7 +64,7 @@ runLuaFilter filterPath args pd = liftIO $ do Just luaFilters <- Lua.peek lua (-1) Lua.push lua (map pack args) Lua.setglobal lua "PandocParameters" - doc <- runAll luaFilters >=> documentFilter lua "filter_doc" $ pd + doc <- runAll luaFilters >=> luaFilter lua "filter_doc" $ pd Lua.close lua return doc @@ -81,13 +80,13 @@ luaFilter lua luaFn x = do else return x walkMWithLuaFilter :: LuaFilter -> Pandoc -> IO Pandoc -walkMWithLuaFilter lf doc = case lf of - InlineLuaFilter lua fnMap -> walkM (execInlineLuaFilter lua fnMap) doc - BlockLuaFilter lua fnMap -> walkM (execBlockLuaFilter lua fnMap) doc +walkMWithLuaFilter (LuaFilter lua inlineFnMap blockFnMap) = + walkM (execInlineLuaFilter lua inlineFnMap) >=> + walkM (execBlockLuaFilter lua blockFnMap) -data LuaFilter - = InlineLuaFilter LuaState (HashMap Text (LuaFilterFunction Inline)) - | BlockLuaFilter LuaState (HashMap Text (LuaFilterFunction Block)) +type InlineFunctionMap = HashMap Text (LuaFilterFunction Inline) +type BlockFunctionMap = HashMap Text (LuaFilterFunction Block) +data LuaFilter = LuaFilter LuaState InlineFunctionMap BlockFunctionMap newtype LuaFilterFunction a = LuaFilterFunction { functionIndex :: Int } @@ -122,39 +121,33 @@ execInlineLuaFilter lua fnMap x = do Nothing -> return x Just fn -> runLuaFilterFunction lua fn x case x of - Str _ -> filterOrId "Str" - Emph _ -> filterOrId "Emph" - Strong _ -> filterOrId "Strong" - Strikeout _ -> filterOrId "Strikeout" - Superscript _ -> filterOrId "Superscript" - Subscript _ -> filterOrId "Subscript" - SmallCaps _ -> filterOrId "SmallCaps" - Quoted _ _ -> filterOrId "Quoted" Cite _ _ -> filterOrId "Cite" Code _ _ -> filterOrId "Code" - Space -> filterOrId "Space" - SoftBreak -> filterOrId "SoftBreak" + Emph _ -> filterOrId "Emph" + Image _ _ _ -> filterOrId "Image" LineBreak -> filterOrId "LineBreak" - Math _ _ -> filterOrId "Math" - RawInline _ _ -> filterOrId "RawInline" Link _ _ _ -> filterOrId "Link" - Image _ _ _ -> filterOrId "Image" + Math _ _ -> filterOrId "Math" Note _ -> filterOrId "Note" + Quoted _ _ -> filterOrId "Quoted" + RawInline _ _ -> filterOrId "RawInline" + SmallCaps _ -> filterOrId "SmallCaps" + SoftBreak -> filterOrId "SoftBreak" + Space -> filterOrId "Space" Span _ _ -> filterOrId "Span" + Str _ -> filterOrId "Str" + Strikeout _ -> filterOrId "Strikeout" + Strong _ -> filterOrId "Strong" + Subscript _ -> filterOrId "Subscript" + Superscript _ -> filterOrId "Superscript" instance StackValue LuaFilter where valuetype _ = Lua.TTABLE - push lua (InlineLuaFilter _ fnMap) = Lua.push lua fnMap - push lua (BlockLuaFilter _ fnMap) = Lua.push lua fnMap + push = undefined peek lua i = do - Lua.getmetatable lua i - Lua.rawgeti lua (-1) 1 - (mtMarker :: Text) <- fromMaybe (error "No filter type set") <$> peek lua (-1) - Lua.pop lua 2 - case mtMarker of - "Inline" -> fmap (InlineLuaFilter lua) <$> Lua.peek lua i - "Block" -> fmap (BlockLuaFilter lua) <$> Lua.peek lua i - _ -> error "Unknown filter type" + inlineFnMap <- Lua.peek lua i + blockFnMap <- Lua.peek lua i + return $ LuaFilter lua <$> inlineFnMap <*> blockFnMap runLuaFilterFunction :: (StackValue a) => LuaState -> LuaFilterFunction a -> a -> IO a @@ -214,4 +207,3 @@ instance StackValue Inline where push lua = Lua.push lua . toJSON peek lua i = maybeFromJson <$> peek lua i valuetype _ = Lua.TTABLE - From 43d67cd9933a8e791a5fc7f46c91c5669905c2cc Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sun, 19 Mar 2017 15:48:05 +0100 Subject: [PATCH 06/10] Lua filters: make `pandoc` module available --- data/pandoc.lua | 134 ++++++++++++++++++++++++++++ pandoc.cabal | 3 + src/Text/Pandoc/Lua.hs | 3 + src/Text/Pandoc/Lua/PandocModule.hs | 47 ++++++++++ 4 files changed, 187 insertions(+) create mode 100644 data/pandoc.lua create mode 100644 src/Text/Pandoc/Lua/PandocModule.hs diff --git a/data/pandoc.lua b/data/pandoc.lua new file mode 100644 index 000000000000..d44df2e87baf --- /dev/null +++ b/data/pandoc.lua @@ -0,0 +1,134 @@ +--[[ +pandoc.lua + +Copyright (c) 2017 Albert Krewinkel + +Permission to use, copy, modify, and/or distribute this software for any purpose +with or without fee is hereby granted, provided that the above copyright notice +and this permission notice appear in all copies. + +THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH +REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND +FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, +INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS +OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER +TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF +THIS SOFTWARE. +]] + +--- The module +local M = { + _version = "0.1.0" +} + +--- Create a new set of attributes (Attr). +function M.Attributes(id, classes, key_values) + return {id, classes, key_values} +end + +local Element = {} +--- Create a new element subtype +function Element:make_subtype(o) + o = o or {} + setmetatable(o, self) + self.__index = self + return o +end +--- Create a new element given its tag and arguments +function Element:new(tag, ...) + local element = { t = tag } + local content = {...} + -- special case for unary constructors + if #content == 1 then + element.c = content[1] + -- Don't set 'c' field if no further arguments were given. This is important + -- for nullary constructors like `Space` and `HorizontalRule`. + elseif #content > 0 then + element.c = content + end + setmetatable(element, self) + self.__index = self + return element +end + +local Inline = Element:make_subtype{} +local Block = Element:make_subtype{} + +M.block_types = { + "BlockQuote", + "BulletList", + "CodeBlock", + "DefinitionList", + "Div", + "Header", + "HorizontalRule", + "HorizontalRule", + "LineBlock", + "Null", + "OrderedList", + "Para", + "Plain", + "RawBlock", + "Table", +} + +M.inline_types = { + "Cite", + "Code", + "DisplayMath", + "DoubleQuoted", + "Emph", + "Image", + "InlineMath", + "LineBreak", + "Link", + "Math", + "Note", + "Quoted", + "RawInline", + "SingleQuoted", + "SmallCaps", + "SoftBreak", + "Space", + "Span", + "Str", + "Strikeout", + "Strong", + "Subscript", + "Superscript" +} + +for _, block_type in pairs(M.block_types) do + M[block_type] = function(...) + return Block:new(block_type, ...) + end +end + +for _, inline_type in pairs(M.inline_types) do + M[inline_type] = function(...) + return Inline:new(inline_type, ...) + end +end + +--- Arrays to provide fast lookup of element types +local set_of_inline_types = {} +local set_of_block_types = {} + +for i = 1, #M.inline_types do + set_of_inline_types[M.inline_types[i]] = true +end +for i = 1, #M.block_types do + set_of_block_types[M.block_types[i]] = true +end + +function M.global_filter() + local res = {} + for k, v in pairs(_G) do + if set_of_inline_types[k] or set_of_block_types[k] then + res[k] = v + end + end + return res +end + +return M diff --git a/pandoc.cabal b/pandoc.cabal index e9385b1a4b49..2edd719c4a82 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -104,6 +104,8 @@ Data-Files: data/abbreviations -- sample lua custom writer data/sample.lua + -- pandoc lua module + data/pandoc.lua -- bash completion template data/bash_completion.tpl -- documentation @@ -436,6 +438,7 @@ Library Text.Pandoc.Readers.Org.ParserState, Text.Pandoc.Readers.Org.Parsing, Text.Pandoc.Readers.Org.Shared, + Text.Pandoc.Lua.PandocModule, Text.Pandoc.CSS, Text.Pandoc.UUID, Text.Pandoc.Slides, diff --git a/src/Text/Pandoc/Lua.hs b/src/Text/Pandoc/Lua.hs index 80529b58234e..77dd4ff72c2f 100644 --- a/src/Text/Pandoc/Lua.hs +++ b/src/Text/Pandoc/Lua.hs @@ -41,6 +41,7 @@ import Data.Text.Encoding ( decodeUtf8 ) import Scripting.Lua ( LuaState, StackValue(..) ) import Scripting.Lua.Aeson () import Text.Pandoc.Definition ( Block(..), Inline(..), Pandoc(..) ) +import Text.Pandoc.Lua.PandocModule import Text.Pandoc.Walk import qualified Data.HashMap.Lazy as HashMap @@ -54,6 +55,8 @@ runLuaFilter filterPath args pd = liftIO $ do Lua.openlibs lua Lua.newtable lua Lua.setglobal lua "PANDOC_FILTER_FUNCTIONS" -- hack, store functions here + pushPandocModule lua + Lua.setglobal lua "pandoc" status <- Lua.loadfile lua filterPath if (status /= 0) then do diff --git a/src/Text/Pandoc/Lua/PandocModule.hs b/src/Text/Pandoc/Lua/PandocModule.hs new file mode 100644 index 000000000000..5b2e82103099 --- /dev/null +++ b/src/Text/Pandoc/Lua/PandocModule.hs @@ -0,0 +1,47 @@ +{- +Copyright © 2017 Albert Krewinkel + +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.PandocModule + Copyright : Copyright © 2017 Albert Krewinkel + License : GNU GPL, version 2 or above + + Maintainer : Albert Krewinkel + Stability : alpha + +Pandoc module for lua. +-} +module Text.Pandoc.Lua.PandocModule ( pushPandocModule ) where + +import Data.ByteString.Char8 ( unpack ) +import Scripting.Lua ( LuaState, loadstring, call) +import Text.Pandoc.Shared ( readDataFile ) + + +-- | Push the "pandoc" on the lua stack. +pushPandocModule :: LuaState -> IO () +pushPandocModule lua = do + script <- pandocModuleScript + status <- loadstring lua script "cn" + if (status /= 0) + then return () + else do + call lua 0 1 + +-- | Get the string representation of the pandoc module +pandocModuleScript :: IO String +pandocModuleScript = unpack <$> readDataFile Nothing "pandoc.lua" From ad64112c0a04606c7930f8ef1d263cfb9d862bc6 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sun, 19 Mar 2017 17:26:15 +0100 Subject: [PATCH 07/10] Add rudimentary tests for lua filters --- pandoc.cabal | 2 ++ test/Tests/Lua.hs | 28 ++++++++++++++++++++++++++++ test/lua/plain-to-para.lua | 6 ++++++ test/lua/strmacro.lua | 10 ++++++++++ test/test-pandoc.hs | 2 ++ 5 files changed, 48 insertions(+) create mode 100644 test/Tests/Lua.hs create mode 100644 test/lua/plain-to-para.lua create mode 100644 test/lua/strmacro.lua diff --git a/pandoc.cabal b/pandoc.cabal index 2edd719c4a82..44c3c962969d 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -234,6 +234,7 @@ Extra-Source-Files: test/odt/odt/*.odt test/odt/markdown/*.md test/odt/native/*.native + test/lua/strmacro.lua Source-repository head type: git location: git://github.com/jgm/pandoc.git @@ -527,6 +528,7 @@ Test-Suite test-pandoc Other-Modules: Tests.Old Tests.Command Tests.Helpers + Tests.Lua Tests.Shared Tests.Readers.LaTeX Tests.Readers.HTML diff --git a/test/Tests/Lua.hs b/test/Tests/Lua.hs new file mode 100644 index 000000000000..6f1e62c831f6 --- /dev/null +++ b/test/Tests/Lua.hs @@ -0,0 +1,28 @@ +{-# Language OverloadedStrings #-} +module Tests.Lua ( tests ) where + +import System.FilePath (()) +import Test.Tasty (TestTree) +import Test.Tasty.HUnit (Assertion, assertEqual, testCase) +import Text.Pandoc.Builder +import Text.Pandoc.Lua + +tests :: [TestTree] +tests = + [ testCase "macro expansion via filter" $ + assertFilterConversion "a '{{helloworld}}' string is expanded" + "strmacro.lua" + (doc . para $ str "{{helloworld}}") + (doc . para . emph $ str "Hello, World") + + , testCase "convert all plains to paras" $ + assertFilterConversion "plains become para" + "plain-to-para.lua" + (doc $ bulletList [plain (str "alfa"), plain (str "bravo")]) + (doc $ bulletList [para (str "alfa"), para (str "bravo")]) + ] + +assertFilterConversion :: String -> FilePath -> Pandoc -> Pandoc -> Assertion +assertFilterConversion msg filterPath docIn docExpected = do + docRes <- runLuaFilter ("lua" filterPath) [] docIn + assertEqual msg docExpected docRes diff --git a/test/lua/plain-to-para.lua b/test/lua/plain-to-para.lua new file mode 100644 index 000000000000..747257411138 --- /dev/null +++ b/test/lua/plain-to-para.lua @@ -0,0 +1,6 @@ +return { + { Plain = function (blk) + return pandoc.Para(blk.c) + end, + } +} diff --git a/test/lua/strmacro.lua b/test/lua/strmacro.lua new file mode 100644 index 000000000000..1b28801be964 --- /dev/null +++ b/test/lua/strmacro.lua @@ -0,0 +1,10 @@ +return { + { Str = function (inline) + if inline.c == "{{helloworld}}" then + return pandoc.Emph {pandoc.Str "Hello, World"} + else + return inline + end + end, + } +} diff --git a/test/test-pandoc.hs b/test/test-pandoc.hs index 396c0f478207..97ad3183f4cd 100644 --- a/test/test-pandoc.hs +++ b/test/test-pandoc.hs @@ -5,6 +5,7 @@ module Main where import GHC.IO.Encoding import Test.Tasty import qualified Tests.Command +import qualified Tests.Lua import qualified Tests.Old import qualified Tests.Readers.Docx import qualified Tests.Readers.EPUB @@ -61,6 +62,7 @@ tests = testGroup "pandoc tests" [ Tests.Command.tests , testGroup "Txt2Tags" Tests.Readers.Txt2Tags.tests , testGroup "EPUB" Tests.Readers.EPUB.tests ] + , testGroup "Lua filters" Tests.Lua.tests ] main :: IO () From c9119c5f3222a98f619991ad5409b544ce83656c Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Mon, 20 Mar 2017 09:13:22 +0100 Subject: [PATCH 08/10] Document `--lua-filter` option in MANUAL --- MANUAL.txt | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) diff --git a/MANUAL.txt b/MANUAL.txt index b8954ea24509..12e3b2f9eb7d 100644 --- a/MANUAL.txt +++ b/MANUAL.txt @@ -457,6 +457,31 @@ Reader options 3. `$PATH` (executable only) +`--lua-filter=`*SCRIPT* + +: Transform the document in a similar fashion as JSON filters (see + `--filter`), but use pandoc's build-in lua filtering system. The given + lua script is expected to return a list of lua filters which will be + applied in order. Each lua filter must contain element-transforming + functions indexed by the name of the AST element on which the filter + function should be applied. + + The `pandoc` lua module provides helper functions for element + creation. It is always loaded into the script's lua environment. + + The following is an example lua script for macro-expansion: + + function expand_hello_world(inline) + if inline.c == '{{helloworld}}' then + return pandoc.Emph{ pandoc.Str "Hello, World" } + else + return inline + end + end + + return {{Str = expand_hello_world}} + + `-M` *KEY*[`=`*VAL*], `--metadata=`*KEY*[`:`*VAL*] : Set the metadata field *KEY* to the value *VAL*. A value specified From 88f0c91825db19474e9f7568df56a5f71357cd29 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Mon, 20 Mar 2017 10:31:26 +0100 Subject: [PATCH 09/10] Support lua filters acting on the whole document --- data/pandoc.lua | 12 +++++++++++- src/Text/Pandoc/Lua.hs | 22 ++++++++++++++++++---- test/Tests/Lua.hs | 6 ++++++ test/lua/hello-world-doc.lua | 10 ++++++++++ 4 files changed, 45 insertions(+), 5 deletions(-) create mode 100644 test/lua/hello-world-doc.lua diff --git a/data/pandoc.lua b/data/pandoc.lua index d44df2e87baf..79729fc35705 100644 --- a/data/pandoc.lua +++ b/data/pandoc.lua @@ -51,6 +51,14 @@ function Element:new(tag, ...) return element end +local function Doc(blocks, meta) + return { + ["blocks"] = blocks, + ["meta"] = meta, + ["pandoc-api-version"] = {1,17,0,5}, + } +end + local Inline = Element:make_subtype{} local Block = Element:make_subtype{} @@ -124,11 +132,13 @@ end function M.global_filter() local res = {} for k, v in pairs(_G) do - if set_of_inline_types[k] or set_of_block_types[k] then + if set_of_inline_types[k] or set_of_block_types[k] or k == "Doc" then res[k] = v end end return res end +M["Doc"] = Doc + return M diff --git a/src/Text/Pandoc/Lua.hs b/src/Text/Pandoc/Lua.hs index 77dd4ff72c2f..6fa6b2020b9b 100644 --- a/src/Text/Pandoc/Lua.hs +++ b/src/Text/Pandoc/Lua.hs @@ -83,16 +83,28 @@ luaFilter lua luaFn x = do else return x walkMWithLuaFilter :: LuaFilter -> Pandoc -> IO Pandoc -walkMWithLuaFilter (LuaFilter lua inlineFnMap blockFnMap) = +walkMWithLuaFilter (LuaFilter lua inlineFnMap blockFnMap docFnMap) = walkM (execInlineLuaFilter lua inlineFnMap) >=> - walkM (execBlockLuaFilter lua blockFnMap) + walkM (execBlockLuaFilter lua blockFnMap) >=> + walkM (execDocLuaFilter lua docFnMap) type InlineFunctionMap = HashMap Text (LuaFilterFunction Inline) type BlockFunctionMap = HashMap Text (LuaFilterFunction Block) -data LuaFilter = LuaFilter LuaState InlineFunctionMap BlockFunctionMap +type DocFunctionMap = HashMap Text (LuaFilterFunction Pandoc) +data LuaFilter = + LuaFilter LuaState InlineFunctionMap BlockFunctionMap DocFunctionMap newtype LuaFilterFunction a = LuaFilterFunction { functionIndex :: Int } +execDocLuaFilter :: LuaState + -> HashMap Text (LuaFilterFunction Pandoc) + -> Pandoc -> IO Pandoc +execDocLuaFilter lua fnMap x = do + let docFnName = "Doc" + case HashMap.lookup docFnName fnMap of + Nothing -> return x + Just fn -> runLuaFilterFunction lua fn x + execBlockLuaFilter :: LuaState -> HashMap Text (LuaFilterFunction Block) -> Block -> IO Block @@ -148,9 +160,11 @@ instance StackValue LuaFilter where valuetype _ = Lua.TTABLE push = undefined peek lua i = do + -- TODO: find a more efficient way of doing this in a typesafe manner. inlineFnMap <- Lua.peek lua i blockFnMap <- Lua.peek lua i - return $ LuaFilter lua <$> inlineFnMap <*> blockFnMap + docFnMap <- Lua.peek lua i + return $ LuaFilter lua <$> inlineFnMap <*> blockFnMap <*> docFnMap runLuaFilterFunction :: (StackValue a) => LuaState -> LuaFilterFunction a -> a -> IO a diff --git a/test/Tests/Lua.hs b/test/Tests/Lua.hs index 6f1e62c831f6..4f8bd46d84f0 100644 --- a/test/Tests/Lua.hs +++ b/test/Tests/Lua.hs @@ -20,6 +20,12 @@ tests = "plain-to-para.lua" (doc $ bulletList [plain (str "alfa"), plain (str "bravo")]) (doc $ bulletList [para (str "alfa"), para (str "bravo")]) + + , testCase "make hello world document" $ + assertFilterConversion "Document contains 'Hello, World!'" + "hello-world-doc.lua" + (doc . para $ str "Hey!" <> linebreak <> str "What's up?") + (doc . para $ str "Hello," <> space <> str "World!") ] assertFilterConversion :: String -> FilePath -> Pandoc -> Pandoc -> Assertion diff --git a/test/lua/hello-world-doc.lua b/test/lua/hello-world-doc.lua new file mode 100644 index 000000000000..221321a60b8b --- /dev/null +++ b/test/lua/hello-world-doc.lua @@ -0,0 +1,10 @@ +return { + { + Doc = function(doc) + local meta = {} + local hello = { pandoc.Str "Hello,", pandoc.Space(), pandoc.Str "World!" } + local blocks = { pandoc.Para(hello) } + return pandoc.Doc(blocks, meta) + end + } +} From 0f771ed94ae24b8ea49153e794d8c9cce2a2de33 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Mon, 20 Mar 2017 11:31:13 +0100 Subject: [PATCH 10/10] Bump minimum version of hslua-aeson The new version fixes compatibility problems with older GHC versions. --- pandoc.cabal | 2 +- stack.yaml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/pandoc.cabal b/pandoc.cabal index 44c3c962969d..a05543445464 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -285,7 +285,7 @@ Library pandoc-types >= 1.17 && < 1.18, aeson >= 0.7 && < 1.2, aeson-pretty >= 0.8 && < 0.9, - hslua-aeson >= 0.1.0 && < 1, + hslua-aeson >= 0.1.0.2 && < 1, tagsoup >= 0.13.7 && < 0.15, base64-bytestring >= 0.1 && < 1.1, zlib >= 0.5 && < 0.7, diff --git a/stack.yaml b/stack.yaml index df4edf7b0cea..1cee6bbe97e6 100644 --- a/stack.yaml +++ b/stack.yaml @@ -8,7 +8,7 @@ flags: packages: - '.' extra-deps: -- hslua-aeson-0.1.0.0 +- hslua-aeson-0.1.0.2 - skylighting-0.3.1 - texmath-0.9.3 resolver: lts-8.4