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.

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)