From 672a4bdd1d4a587feaa38613fce64335adaad76d Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Wed, 15 Jan 2020 23:26:00 +0100 Subject: Lua filters: allow filtering of element lists (#6040) Lists of Inline and Block elements can now be filtered via `Inlines` and `Blocks` functions, respectively. This is helpful if a filter conversion depends on the order of elements rather than a single element. For example, the following filter can be used to remove all spaces before a citation: function isSpaceBeforeCite (spc, cite) return spc and spc.t == 'Space' and cite and cite.t == 'Cite' end function Inlines (inlines) for i = #inlines-1,1,-1 do if isSpaceBeforeCite(inlines[i], inlines[i+1]) then inlines:remove(i) end end return inlines end Closes: #6038 --- src/Text/Pandoc/Lua/Filter.hs | 97 ++++++++++++++++++++++++---------- src/Text/Pandoc/Lua/Init.hs | 1 + src/Text/Pandoc/Lua/Marshaling/List.hs | 45 ++++++++++++++++ 3 files changed, 114 insertions(+), 29 deletions(-) create mode 100644 src/Text/Pandoc/Lua/Marshaling/List.hs (limited to 'src/Text') diff --git a/src/Text/Pandoc/Lua/Filter.hs b/src/Text/Pandoc/Lua/Filter.hs index 74c7058f3..beef492d7 100644 --- a/src/Text/Pandoc/Lua/Filter.hs +++ b/src/Text/Pandoc/Lua/Filter.hs @@ -2,8 +2,8 @@ {-# LANGUAGE NoImplicitPrelude #-} {- | Module : Text.Pandoc.Lua.Filter -Copyright : © 2012–2019 John MacFarlane, - © 2017-2019 Albert Krewinkel +Copyright : © 2012–2020 John MacFarlane, + © 2017-2020 Albert Krewinkel License : GNU GPL, version 2 or above Maintainer : Albert Krewinkel Stability : alpha @@ -13,25 +13,23 @@ Types and functions for running Lua filters. module Text.Pandoc.Lua.Filter ( LuaFilterFunction , LuaFilter , runFilterFile - , tryFilter - , runFilterFunction - , walkMWithLuaFilter , walkInlines , walkBlocks - , blockElementNames - , inlineElementNames , module Text.Pandoc.Lua.Walk ) where import Prelude +import Control.Applicative ((<|>)) import Control.Monad (mplus, (>=>)) import Control.Monad.Catch (finally) import Data.Data (Data, DataType, dataTypeConstrs, dataTypeName, dataTypeOf, showConstr, toConstr, tyconUQname) import Data.Foldable (foldrM) import Data.Map (Map) +import Data.Maybe (fromMaybe) import Foreign.Lua (Lua, Peekable, Pushable) import Text.Pandoc.Definition import Text.Pandoc.Lua.Marshaling () +import Text.Pandoc.Lua.Marshaling.List (List (..)) import Text.Pandoc.Lua.Walk (SingletonsList (..)) import Text.Pandoc.Walk (Walkable (walkM)) @@ -67,7 +65,9 @@ newtype LuaFilter = LuaFilter (Map String LuaFilterFunction) instance Peekable LuaFilter where peek idx = do - let constrs = metaFilterName + let constrs = listOfInlinesFilterName + : listOfBlocksFilterName + : metaFilterName : pandocFilterNames ++ blockElementNames ++ inlineElementNames @@ -109,22 +109,34 @@ elementOrList x = do Right res -> [res] <$ Lua.pop 1 Left _ -> Lua.peekList topOfStack `finally` Lua.pop 1 --- | Try running a filter for the given element -tryFilter :: (Data a, Peekable a, Pushable a) - => LuaFilter -> a -> Lua [a] -tryFilter (LuaFilter fnMap) x = - let filterFnName = showConstr (toConstr x) - catchAllName = tyconUQname $ dataTypeName (dataTypeOf x) - in - case Map.lookup filterFnName fnMap `mplus` Map.lookup catchAllName fnMap of - Just fn -> runFilterFunction fn x *> elementOrList x - Nothing -> return [x] - --- | Apply filter on a sequence of AST elements. +-- | Pop and return a value from the stack; if the value at the top of +-- the stack is @nil@, return the fallback element. +popOption :: Peekable a => a -> Lua a +popOption fallback = fromMaybe fallback . Lua.fromOptional <$> Lua.popValue + +-- | Apply filter on a sequence of AST elements. Both lists and single +-- value are accepted as filter function return values. runOnSequence :: (Data a, Peekable a, Pushable a) => LuaFilter -> SingletonsList a -> Lua (SingletonsList a) -runOnSequence lf (SingletonsList xs) = - SingletonsList <$> mconcatMapM (tryFilter lf) xs +runOnSequence (LuaFilter fnMap) (SingletonsList xs) = + SingletonsList <$> mconcatMapM tryFilter xs + where + tryFilter :: (Data a, Peekable a, Pushable a) => a -> Lua [a] + tryFilter x = + let filterFnName = showConstr (toConstr x) + catchAllName = tyconUQname $ dataTypeName (dataTypeOf x) + in case Map.lookup filterFnName fnMap <|> Map.lookup catchAllName fnMap of + Just fn -> runFilterFunction fn x *> elementOrList x + Nothing -> return [x] + +-- | Try filtering the given value without type error corrections on +-- the return value. +runOnValue :: (Data a, Peekable a, Pushable a) + => String -> LuaFilter -> a -> Lua a +runOnValue filterFnName (LuaFilter fnMap) x = + case Map.lookup filterFnName fnMap of + Just fn -> runFilterFunction fn x *> popOption x + Nothing -> return x -- | Push a value to the stack via a lua filter function. The filter function is -- called with given element as argument and is expected to return an element. @@ -138,7 +150,12 @@ runFilterFunction lf x = do walkMWithLuaFilter :: LuaFilter -> Pandoc -> Lua Pandoc walkMWithLuaFilter f = - walkInlines f >=> walkBlocks f >=> walkMeta f >=> walkPandoc f + walkInlines f + >=> walkInlineLists f + >=> walkBlocks f + >=> walkBlockLists f + >=> walkMeta f + >=> walkPandoc f mconcatMapM :: (Monad m) => (a -> m [a]) -> [a] -> m [a] mconcatMapM f = fmap mconcat . mapM f @@ -146,6 +163,9 @@ mconcatMapM f = fmap mconcat . mapM f hasOneOf :: LuaFilter -> [String] -> Bool hasOneOf (LuaFilter fnMap) = any (\k -> Map.member k fnMap) +contains :: LuaFilter -> String -> Bool +contains (LuaFilter fnMap) = (`Map.member` fnMap) + walkInlines :: Walkable (SingletonsList Inline) a => LuaFilter -> a -> Lua a walkInlines lf = let f :: SingletonsList Inline -> Lua (SingletonsList Inline) @@ -154,6 +174,14 @@ walkInlines lf = then walkM f else return +walkInlineLists :: Walkable (List Inline) a => LuaFilter -> a -> Lua a +walkInlineLists lf = + let f :: List Inline -> Lua (List Inline) + f = runOnValue listOfInlinesFilterName lf + in if lf `contains` listOfInlinesFilterName + then walkM f + else return + walkBlocks :: Walkable (SingletonsList Block) a => LuaFilter -> a -> Lua a walkBlocks lf = let f :: SingletonsList Block -> Lua (SingletonsList Block) @@ -162,13 +190,18 @@ walkBlocks lf = then walkM f else return +walkBlockLists :: Walkable (List Block) a => LuaFilter -> a -> Lua a +walkBlockLists lf = + let f :: List Block -> Lua (List Block) + f = runOnValue listOfBlocksFilterName lf + in if lf `contains` listOfBlocksFilterName + then walkM f + else return + walkMeta :: LuaFilter -> Pandoc -> Lua Pandoc -walkMeta (LuaFilter fnMap) = - case Map.lookup "Meta" fnMap of - Just fn -> walkM (\(Pandoc meta blocks) -> do - meta' <- runFilterFunction fn meta *> singleElement meta - return $ Pandoc meta' blocks) - Nothing -> return +walkMeta lf (Pandoc m bs) = do + m' <- runOnValue "Meta" lf m + return $ Pandoc m' bs walkPandoc :: LuaFilter -> Pandoc -> Lua Pandoc walkPandoc (LuaFilter fnMap) = @@ -185,6 +218,12 @@ inlineElementNames = "Inline" : constructorsFor (dataTypeOf (Str mempty)) blockElementNames :: [String] blockElementNames = "Block" : constructorsFor (dataTypeOf (Para [])) +listOfInlinesFilterName :: String +listOfInlinesFilterName = "Inlines" + +listOfBlocksFilterName :: String +listOfBlocksFilterName = "Blocks" + metaFilterName :: String metaFilterName = "Meta" diff --git a/src/Text/Pandoc/Lua/Init.hs b/src/Text/Pandoc/Lua/Init.hs index cf6c71231..5ade83e4d 100644 --- a/src/Text/Pandoc/Lua/Init.hs +++ b/src/Text/Pandoc/Lua/Init.hs @@ -119,6 +119,7 @@ putConstructorsInRegistry = do constrsToReg $ Pandoc.Citation mempty mempty mempty Pandoc.AuthorInText 0 0 putInReg "Attr" -- used for Attr type alias putInReg "ListAttributes" -- used for ListAttributes type alias + putInReg "List" -- pandoc.List where constrsToReg :: Data a => a -> Lua () constrsToReg = mapM_ (putInReg . showConstr) . dataTypeConstrs . dataTypeOf diff --git a/src/Text/Pandoc/Lua/Marshaling/List.hs b/src/Text/Pandoc/Lua/Marshaling/List.hs new file mode 100644 index 000000000..e4fbfc200 --- /dev/null +++ b/src/Text/Pandoc/Lua/Marshaling/List.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE UndecidableInstances #-} +{- | +Module : Text.Pandoc.Lua.Marshaling.List +Copyright : © 2012-2020 John MacFarlane + © 2017-2020 Albert Krewinkel +License : GNU GPL, version 2 or above +Maintainer : Albert Krewinkel +Stability : alpha + +Marshaling/unmarshaling instances for @pandoc.List@s. +-} +module Text.Pandoc.Lua.Marshaling.List + ( List (..) + ) where + +import Prelude +import Data.Data (Data) +import Foreign.Lua (Peekable, Pushable) +import Text.Pandoc.Walk (Walkable (..)) +import Text.Pandoc.Lua.Util (defineHowTo, pushViaConstructor) + +import qualified Foreign.Lua as Lua + +-- | List wrapper which is marshalled as @pandoc.List@. +newtype List a = List { fromList :: [a] } + deriving (Data, Eq, Show) + +instance Pushable a => Pushable (List a) where + push (List xs) = + pushViaConstructor "List" xs + +instance Peekable a => Peekable (List a) where + peek idx = defineHowTo "get List" $ do + xs <- Lua.peek idx + return $ List xs + +-- List is just a wrapper, so we can reuse the walk instance for +-- unwrapped Hasekll lists. +instance Walkable [a] b => Walkable (List a) b where + walkM f = walkM (fmap fromList . f . List) + query f = query (f . List) -- cgit v1.2.3