From fa643ba6d78fd97f0a779840dca32bfea3b296f8 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Mon, 6 Dec 2021 16:55:19 +0100 Subject: Lua: update to latest pandoc-lua-marshal (0.1.1) - `walk` methods are added to `Block` and `Inline` values; the methods are similar to `pandoc.utils.walk_block` and `pandoc.utils.walk_inline`, but apply to filter also to the element itself, and therefore return a list of element instead of a single element. - Functions of name `Doc` are no longer accepted as alternatives for `Pandoc` filter functions. This functionality was undocumented. --- src/Text/Pandoc/Lua/Filter.hs | 238 +++-------------------------------- src/Text/Pandoc/Lua/Module/Pandoc.hs | 28 ++--- src/Text/Pandoc/Lua/Walk.hs | 183 --------------------------- 3 files changed, 26 insertions(+), 423 deletions(-) delete mode 100644 src/Text/Pandoc/Lua/Walk.hs (limited to 'src') diff --git a/src/Text/Pandoc/Lua/Filter.hs b/src/Text/Pandoc/Lua/Filter.hs index ba5a14a0d..9910424d8 100644 --- a/src/Text/Pandoc/Lua/Filter.hs +++ b/src/Text/Pandoc/Lua/Filter.hs @@ -12,242 +12,36 @@ Stability : alpha Types and functions for running Lua filters. -} -module Text.Pandoc.Lua.Filter ( LuaFilterFunction - , LuaFilter - , peekLuaFilter - , runFilterFile - , walkInlines - , walkInlineLists - , walkBlocks - , walkBlockLists - , module Text.Pandoc.Lua.Walk - ) where -import Control.Applicative ((<|>)) -import Control.Monad (mplus, (>=>), (<$!>)) -import Data.Data (Data, DataType, dataTypeConstrs, dataTypeName, dataTypeOf, - showConstr, toConstr, tyconUQname) -import Data.Foldable (foldrM) -import Data.List (foldl') -import Data.Map (Map) -import Data.String (IsString (fromString)) +module Text.Pandoc.Lua.Filter + ( runFilterFile + ) where +import Control.Monad ((>=>), (<$!>)) import HsLua as Lua import Text.Pandoc.Definition import Text.Pandoc.Error (PandocError) +import Text.Pandoc.Lua.ErrorConversion () import Text.Pandoc.Lua.Marshal.AST -import Text.Pandoc.Lua.Orphans () -import Text.Pandoc.Lua.Walk (List (..), SingletonsList (..)) -import Text.Pandoc.Walk (Walkable (walkM)) +import Text.Pandoc.Lua.Marshal.Filter -import qualified Data.Map.Strict as Map import qualified Text.Pandoc.Lua.Util as LuaUtil -- | Transform document using the filter defined in the given file. runFilterFile :: FilePath -> Pandoc -> LuaE PandocError Pandoc runFilterFile filterPath doc = do - oldtop <- Lua.gettop + oldtop <- gettop stat <- LuaUtil.dofileWithTraceback filterPath if stat /= Lua.OK - then Lua.throwErrorAsException + then throwErrorAsException else do - newtop <- Lua.gettop + newtop <- gettop -- Use the returned filters, or the implicitly defined global -- filter if nothing was returned. - luaFilters <- if newtop - oldtop >= 1 - then Lua.peek Lua.top - else Lua.pushglobaltable *> fmap (:[]) Lua.popValue + luaFilters <- forcePeek $ + if newtop - oldtop >= 1 + then peekList peekFilter top + else (:[]) <$!> (liftLua pushglobaltable *> peekFilter top) + settop oldtop runAll luaFilters doc -runAll :: [LuaFilter] -> Pandoc -> LuaE PandocError Pandoc -runAll = foldr ((>=>) . walkMWithLuaFilter) return - --- | Filter function stored in the registry -newtype LuaFilterFunction = LuaFilterFunction Lua.Reference - --- | Collection of filter functions (at most one function per element --- constructor) -newtype LuaFilter = LuaFilter (Map Name LuaFilterFunction) - -instance Peekable LuaFilter where - peek = Lua.forcePeek . peekLuaFilter - --- | Retrieves a LuaFilter object from the stack. -peekLuaFilter :: LuaError e => Peeker e LuaFilter -peekLuaFilter idx = do - let constrs = listOfInlinesFilterName - : listOfBlocksFilterName - : metaFilterName - : pandocFilterNames - ++ blockElementNames - ++ inlineElementNames - let go constr acc = Lua.liftLua $ do - Lua.getfield idx constr - filterFn <- registerFilterFunction - return $ case filterFn of - Nothing -> acc - Just fn -> Map.insert constr fn acc - LuaFilter <$!> foldrM go Map.empty constrs - --- | Register the function at the top of the stack as a filter function in the --- registry. -registerFilterFunction :: LuaError e => LuaE e (Maybe LuaFilterFunction) -registerFilterFunction = do - isFn <- Lua.isfunction Lua.top - if isFn - then Just . LuaFilterFunction <$> Lua.ref Lua.registryindex - else Nothing <$ Lua.pop 1 - --- | Retrieve filter function from registry and push it to the top of the stack. -pushFilterFunction :: LuaFilterFunction -> LuaE PandocError () -pushFilterFunction (LuaFilterFunction fnRef) = - Lua.getref Lua.registryindex fnRef - --- | Fetch either a list of elements from the stack. If there is a single --- element instead of a list, fetch that element as a singleton list. If the top --- of the stack is nil, return the default element that was passed to this --- function. If none of these apply, raise an error. -elementOrList :: Peeker PandocError a -> a -> LuaE PandocError [a] -elementOrList p x = do - elementUnchanged <- Lua.isnil top - if elementUnchanged - then [x] <$ pop 1 - else forcePeek . (`lastly` pop 1) $ (((:[]) <$!> p top) <|> peekList p top) - --- | Fetches a single element; returns the fallback if the value is @nil@. -singleElement :: forall a e. (LuaError e) => Peeker e a -> a -> LuaE e a -singleElement p x = do - elementUnchanged <- Lua.isnil top - if elementUnchanged - then x <$ Lua.pop 1 - else forcePeek $ p top `lastly` pop 1 - --- | Pop and return a value from the stack; if the value at the top of --- the stack is @nil@, return the fallback element. -popOption :: Peeker PandocError a -> a -> LuaE PandocError a -popOption peeker fallback = forcePeek . (`lastly` pop 1) $ - (fallback <$ peekNil top) <|> peeker top - --- | Apply filter on a sequence of AST elements. Both lists and single --- value are accepted as filter function return values. -runOnSequence :: forall a. (Data a, Pushable a) - => Peeker PandocError a -> LuaFilter -> SingletonsList a - -> LuaE PandocError (SingletonsList a) -runOnSequence peeker (LuaFilter fnMap) (SingletonsList xs) = - SingletonsList <$> mconcatMapM tryFilter xs - where - tryFilter :: a -> LuaE PandocError [a] - tryFilter x = - let filterFnName = fromString $ showConstr (toConstr x) - catchAllName = fromString . tyconUQname $ dataTypeName (dataTypeOf x) - in case Map.lookup filterFnName fnMap <|> Map.lookup catchAllName fnMap of - Just fn -> runFilterFunction fn x *> elementOrList peeker x - Nothing -> return [x] - --- | Try filtering the given value without type error corrections on --- the return value. -runOnValue :: (Data a, Pushable a) - => Name -> Peeker PandocError a - -> LuaFilter -> a - -> LuaE PandocError a -runOnValue filterFnName peeker (LuaFilter fnMap) x = - case Map.lookup filterFnName fnMap of - Just fn -> runFilterFunction fn x *> popOption peeker x - Nothing -> return x - --- | Push a value to the stack via a Lua filter function. The filter --- function is called with the given element as argument and is expected --- to return an element. Alternatively, the function can return nothing --- or nil, in which case the element is left unchanged. -runFilterFunction :: Pushable a - => LuaFilterFunction -> a -> LuaE PandocError () -runFilterFunction lf x = do - pushFilterFunction lf - Lua.push x - LuaUtil.callWithTraceback 1 1 - -walkMWithLuaFilter :: LuaFilter -> Pandoc -> LuaE PandocError Pandoc -walkMWithLuaFilter 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 - -hasOneOf :: LuaFilter -> [Name] -> Bool -hasOneOf (LuaFilter fnMap) = any (`Map.member` fnMap) - -contains :: LuaFilter -> Name -> Bool -contains (LuaFilter fnMap) = (`Map.member` fnMap) - -walkInlines :: Walkable (SingletonsList Inline) a - => LuaFilter -> a -> LuaE PandocError a -walkInlines lf = - let f :: SingletonsList Inline -> LuaE PandocError (SingletonsList Inline) - f = runOnSequence peekInline lf - in if lf `hasOneOf` inlineElementNames - then walkM f - else return - -walkInlineLists :: Walkable (List Inline) a - => LuaFilter -> a -> LuaE PandocError a -walkInlineLists lf = - let f :: List Inline -> LuaE PandocError (List Inline) - f = runOnValue listOfInlinesFilterName peekListOfInlines lf - peekListOfInlines idx = List <$!> (peekInlinesFuzzy idx) - in if lf `contains` listOfInlinesFilterName - then walkM f - else return - -walkBlocks :: Walkable (SingletonsList Block) a - => LuaFilter -> a -> LuaE PandocError a -walkBlocks lf = - let f :: SingletonsList Block -> LuaE PandocError (SingletonsList Block) - f = runOnSequence peekBlock lf - in if lf `hasOneOf` blockElementNames - then walkM f - else return - -walkBlockLists :: Walkable (List Block) a - => LuaFilter -> a -> LuaE PandocError a -walkBlockLists lf = - let f :: List Block -> LuaE PandocError (List Block) - f = runOnValue listOfBlocksFilterName peekListOfBlocks lf - peekListOfBlocks idx = List <$!> (peekBlocksFuzzy idx) - in if lf `contains` listOfBlocksFilterName - then walkM f - else return - -walkMeta :: LuaFilter -> Pandoc -> LuaE PandocError Pandoc -walkMeta lf (Pandoc m bs) = do - m' <- runOnValue "Meta" peekMeta lf m - return $ Pandoc m' bs - -walkPandoc :: LuaFilter -> Pandoc -> LuaE PandocError Pandoc -walkPandoc (LuaFilter fnMap) = - case foldl' mplus Nothing (map (`Map.lookup` fnMap) pandocFilterNames) of - Just fn -> \x -> runFilterFunction fn x *> singleElement peekPandoc x - Nothing -> return - -constructorsFor :: DataType -> [Name] -constructorsFor x = map (fromString . show) (dataTypeConstrs x) - -inlineElementNames :: [Name] -inlineElementNames = "Inline" : constructorsFor (dataTypeOf (Str mempty)) - -blockElementNames :: [Name] -blockElementNames = "Block" : constructorsFor (dataTypeOf (Para [])) - -listOfInlinesFilterName :: Name -listOfInlinesFilterName = "Inlines" - -listOfBlocksFilterName :: Name -listOfBlocksFilterName = "Blocks" - -metaFilterName :: Name -metaFilterName = "Meta" - -pandocFilterNames :: [Name] -pandocFilterNames = ["Pandoc", "Doc"] +runAll :: [Filter] -> Pandoc -> LuaE PandocError Pandoc +runAll = foldr ((>=>) . applyFully) return diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs index e932ca59a..529a28cf8 100644 --- a/src/Text/Pandoc/Lua/Module/Pandoc.hs +++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs @@ -31,20 +31,16 @@ import HsLua.Class.Peekable (PeekError) import System.Exit (ExitCode (..)) import Text.Pandoc.Class.PandocIO (runIO) import Text.Pandoc.Definition -import Text.Pandoc.Lua.Filter (List (..), SingletonsList (..), LuaFilter, - peekLuaFilter, - walkInlines, walkInlineLists, - walkBlocks, walkBlockLists) import Text.Pandoc.Lua.Orphans () import Text.Pandoc.Lua.Marshal.AST +import Text.Pandoc.Lua.Marshal.Filter (peekFilter) import Text.Pandoc.Lua.Marshal.ReaderOptions ( peekReaderOptions - , pushReaderOptions) + , pushReaderOptions) import Text.Pandoc.Lua.Module.Utils (sha1) import Text.Pandoc.Lua.PandocLua (PandocLua, liftPandocLua) import Text.Pandoc.Options (ReaderOptions (readerExtensions)) import Text.Pandoc.Process (pipeProcess) import Text.Pandoc.Readers (Reader (..), getReader) -import Text.Pandoc.Walk (Walkable) import qualified HsLua as Lua import qualified Data.ByteString.Lazy as BL @@ -149,16 +145,6 @@ stringConstants = } in map toField nullaryConstructors -walkElement :: (Walkable (SingletonsList Inline) a, - Walkable (SingletonsList Block) a, - Walkable (List Inline) a, - Walkable (List Block) a) - => a -> LuaFilter -> LuaE PandocError a -walkElement x f = walkInlines f x - >>= walkInlineLists f - >>= walkBlocks f - >>= walkBlockLists f - functions :: [DocumentedFunction PandocError] functions = [ defun "pipe" @@ -206,15 +192,21 @@ functions = , defun "walk_block" ### walkElement <#> parameter peekBlockFuzzy "Block" "block" "element to traverse" - <#> parameter peekLuaFilter "LuaFilter" "filter" "filter functions" + <#> parameter peekFilter "Filter" "lua_filter" "filter functions" =#> functionResult pushBlock "Block" "modified Block" , defun "walk_inline" ### walkElement <#> parameter peekInlineFuzzy "Inline" "inline" "element to traverse" - <#> parameter peekLuaFilter "LuaFilter" "filter" "filter functions" + <#> parameter peekFilter "Filter" "lua_filter" "filter functions" =#> functionResult pushInline "Inline" "modified Inline" ] + where + walkElement x f = + walkInlineSplicing f x + >>= walkInlinesStraight f + >>= walkBlockSplicing f + >>= walkBlocksStraight f data PipeError = PipeError { pipeErrorCommand :: T.Text diff --git a/src/Text/Pandoc/Lua/Walk.hs b/src/Text/Pandoc/Lua/Walk.hs deleted file mode 100644 index 75ed1f471..000000000 --- a/src/Text/Pandoc/Lua/Walk.hs +++ /dev/null @@ -1,183 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveTraversable #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE UndecidableInstances #-} -{- | -Module : Text.Pandoc.Lua.Walk -Copyright : © 2012-2021 John MacFarlane, - © 2017-2021 Albert Krewinkel -License : GNU GPL, version 2 or above -Maintainer : Albert Krewinkel -Stability : alpha - -Walking documents in a filter-suitable way. --} -module Text.Pandoc.Lua.Walk - ( SingletonsList (..) - , List (..) - ) -where - -import Control.Monad ((<=<)) -import Data.Data (Data) -import HsLua (Pushable (push)) -import Text.Pandoc.Lua.Marshal.AST (pushBlocks, pushInlines) -import Text.Pandoc.Definition -import Text.Pandoc.Walk - - --- | Helper type which allows to traverse trees in order, while splicing in --- trees. --- --- The only interesting use of this type is via it's '@Walkable@' instance. That --- instance makes it possible to walk a Pandoc document (or a subset thereof), --- while applying a function on each element of an AST element /list/, and have --- the resulting list spliced back in place of the original element. This is the --- traversal/splicing method used for Lua filters. -newtype SingletonsList a = SingletonsList { singletonsList :: [a] } - deriving (Functor, Foldable, Traversable) - --- --- SingletonsList Inline --- -instance {-# OVERLAPPING #-} Walkable (SingletonsList Inline) [Inline] where - walkM = walkSingletonsListM - query = querySingletonsList - -instance Walkable (SingletonsList Inline) Pandoc where - walkM = walkPandocM - query = queryPandoc - -instance Walkable (SingletonsList Inline) Citation where - walkM = walkCitationM - query = queryCitation - -instance Walkable (SingletonsList Inline) Inline where - walkM = walkInlineM - query = queryInline - -instance Walkable (SingletonsList Inline) Block where - walkM = walkBlockM - query = queryBlock - -instance Walkable (SingletonsList Inline) Row where - walkM = walkRowM - query = queryRow - -instance Walkable (SingletonsList Inline) TableHead where - walkM = walkTableHeadM - query = queryTableHead - -instance Walkable (SingletonsList Inline) TableBody where - walkM = walkTableBodyM - query = queryTableBody - -instance Walkable (SingletonsList Inline) TableFoot where - walkM = walkTableFootM - query = queryTableFoot - -instance Walkable (SingletonsList Inline) Caption where - walkM = walkCaptionM - query = queryCaption - -instance Walkable (SingletonsList Inline) Cell where - walkM = walkCellM - query = queryCell - -instance Walkable (SingletonsList Inline) MetaValue where - walkM = walkMetaValueM - query = queryMetaValue - -instance Walkable (SingletonsList Inline) Meta where - walkM f (Meta metamap) = Meta <$> walkM f metamap - query f (Meta metamap) = query f metamap - --- --- SingletonsList Block --- -instance {-# OVERLAPPING #-} Walkable (SingletonsList Block) [Block] where - walkM = walkSingletonsListM - query = querySingletonsList - -instance Walkable (SingletonsList Block) Pandoc where - walkM = walkPandocM - query = queryPandoc - -instance Walkable (SingletonsList Block) Citation where - walkM = walkCitationM - query = queryCitation - -instance Walkable (SingletonsList Block) Inline where - walkM = walkInlineM - query = queryInline - -instance Walkable (SingletonsList Block) Block where - walkM = walkBlockM - query = queryBlock - -instance Walkable (SingletonsList Block) Row where - walkM = walkRowM - query = queryRow - -instance Walkable (SingletonsList Block) TableHead where - walkM = walkTableHeadM - query = queryTableHead - -instance Walkable (SingletonsList Block) TableBody where - walkM = walkTableBodyM - query = queryTableBody - -instance Walkable (SingletonsList Block) TableFoot where - walkM = walkTableFootM - query = queryTableFoot - -instance Walkable (SingletonsList Block) Caption where - walkM = walkCaptionM - query = queryCaption - -instance Walkable (SingletonsList Block) Cell where - walkM = walkCellM - query = queryCell - -instance Walkable (SingletonsList Block) MetaValue where - walkM = walkMetaValueM - query = queryMetaValue - -instance Walkable (SingletonsList Block) Meta where - walkM f (Meta metamap) = Meta <$> walkM f metamap - query f (Meta metamap) = query f metamap - - -walkSingletonsListM :: (Monad m, Walkable (SingletonsList a) a) - => (SingletonsList a -> m (SingletonsList a)) - -> [a] -> m [a] -walkSingletonsListM f = - let f' = fmap singletonsList . f . SingletonsList . (:[]) <=< walkM f - in fmap mconcat . mapM f' - -querySingletonsList :: (Monoid c, Walkable (SingletonsList a) a) - => (SingletonsList a -> c) - -> [a] -> c -querySingletonsList f = - let f' x = f (SingletonsList [x]) `mappend` query f x - in mconcat . map f' - - --- | List wrapper where each list is processed as a whole, but special --- pushed to Lua in type-dependent ways. --- --- The walk instance is basically that of unwrapped Haskell lists. -newtype List a = List { fromList :: [a] } - deriving (Data, Eq, Show) - -instance Pushable (List Block) where - push (List xs) = pushBlocks xs - -instance Pushable (List Inline) where - push (List xs) = pushInlines xs - -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