1 files changed, 16 insertions, 222 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