aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorAlbert Krewinkel <albert@zeitkraut.de>2021-12-06 16:55:19 +0100
committerJohn MacFarlane <jgm@berkeley.edu>2021-12-09 09:22:29 -0800
commitfa643ba6d78fd97f0a779840dca32bfea3b296f8 (patch)
treed99ad99d9cc9e7716790e2bb91eb79a7c235a4f7 /src
parent9cbea695c439dd04c9a670107ec729c503d5b368 (diff)
downloadpandoc-fa643ba6d78fd97f0a779840dca32bfea3b296f8.tar.gz
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.
Diffstat (limited to 'src')
-rw-r--r--src/Text/Pandoc/Lua/Filter.hs238
-rw-r--r--src/Text/Pandoc/Lua/Module/Pandoc.hs28
-rw-r--r--src/Text/Pandoc/Lua/Walk.hs183
3 files changed, 26 insertions, 423 deletions
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 <tarleb+pandoc@moltkeplatz.de>
-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)