Add lua filter functions to walk inline and block elements.

Refactored some code from Text.Pandoc.Lua.PandocModule
into new internal module Text.Pandoc.Lua.Filter.

Add `walk_inline` and `walk_block` in pandoc lua module.

1 files changed, 3 insertions, 147 deletions

diff --git a/src/Text/Pandoc/Lua.hs b/src/Text/Pandoc/Lua.hs
index 091deab8c..355a5baf1 100644
--- a/src/Text/Pandoc/Lua.hs
+++ b/src/Text/Pandoc/Lua.hs
@@ -33,25 +33,18 @@ Pandoc lua utils.
 -}
 module Text.Pandoc.Lua (LuaException (..), pushPandocModule, runLuaFilter) where
 
-import Control.Monad (mplus, unless, when, (>=>))
+import Control.Monad (when, (>=>))
 import Control.Monad.Identity (Identity)
 import Control.Monad.Trans (MonadIO (..))
-import Data.Data (Data, DataType, dataTypeConstrs, dataTypeName, dataTypeOf,
-                  showConstr, toConstr, tyconUQname)
-import Data.Foldable (foldrM)
 import Data.IORef (IORef, newIORef, readIORef)
-import Data.Map (Map)
-import Data.Maybe (isJust)
-import Foreign.Lua (FromLuaStack (peek), Lua, LuaException (..), StackIndex,
+import Foreign.Lua (FromLuaStack (peek), Lua, LuaException (..),
                     Status (OK), ToLuaStack (push))
 import Text.Pandoc.Class (CommonState, PandocIO, getCommonState, getMediaBag,
                           setMediaBag)
 import Text.Pandoc.Definition
 import Text.Pandoc.Lua.PandocModule (pushMediaBagModule, pushPandocModule)
+import Text.Pandoc.Lua.Filter (LuaFilter, walkMWithLuaFilter)
 import Text.Pandoc.MediaBag (MediaBag)
-import Text.Pandoc.Walk (walkM)
-
-import qualified Data.Map as Map
 import qualified Foreign.Lua as Lua
 
 runLuaFilter :: Maybe FilePath -> FilePath -> String
@@ -109,142 +102,5 @@ pushGlobalFilter = do
 runAll :: [LuaFilter] -> Pandoc -> Lua Pandoc
 runAll = foldr ((>=>) . walkMWithLuaFilter) return
 
-walkMWithLuaFilter :: LuaFilter -> Pandoc -> Lua Pandoc
-walkMWithLuaFilter (LuaFilter fnMap) =
-  walkInlines >=> walkBlocks >=> walkMeta >=> walkPandoc
- where
-    walkInlines :: Pandoc -> Lua Pandoc
-    walkInlines =
-      if hasOneOf inlineFilterNames
-      then walkM (mconcatMapM (tryFilter fnMap :: Inline -> Lua [Inline]))
-      else return
-
-    walkBlocks :: Pandoc -> Lua Pandoc
-    walkBlocks =
-      if hasOneOf blockFilterNames
-      then walkM (mconcatMapM (tryFilter fnMap :: Block -> Lua [Block]))
-      else return
-
-    walkMeta :: Pandoc -> Lua Pandoc
-    walkMeta =
-      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
-
-    walkPandoc :: Pandoc -> Lua Pandoc
-    walkPandoc =
-      case foldl mplus Nothing (map (`Map.lookup` fnMap) pandocFilterNames) of
-        Just fn -> \x -> runFilterFunction fn x *> singleElement x
-        Nothing -> return
-
-    mconcatMapM f = fmap mconcat . mapM f
-    hasOneOf = any (\k -> isJust (Map.lookup k fnMap))
-
-constructorsFor :: DataType -> [String]
-constructorsFor x = map show (dataTypeConstrs x)
-
-inlineFilterNames :: [String]
-inlineFilterNames = "Inline" : constructorsFor (dataTypeOf (Str []))
-
-blockFilterNames :: [String]
-blockFilterNames = "Block" : constructorsFor (dataTypeOf (Para []))
-
-metaFilterName :: String
-metaFilterName = "Meta"
-
-pandocFilterNames :: [String]
-pandocFilterNames = ["Pandoc", "Doc"]
-
-type FunctionMap = Map String LuaFilterFunction
-newtype LuaFilter = LuaFilter FunctionMap
-newtype LuaFilterFunction = LuaFilterFunction { functionIndex :: Int }
-
--- | Try running a filter for the given element
-tryFilter :: (Data a, FromLuaStack a, ToLuaStack a)
-          => FunctionMap -> a -> Lua [a]
-tryFilter 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]
-
-instance FromLuaStack LuaFilter where
-  peek idx =
-    let constrs = metaFilterName : pandocFilterNames
-                  ++ blockFilterNames
-                  ++ inlineFilterNames
-        fn c acc = do
-          Lua.getfield idx c
-          filterFn <- Lua.tryLua (peek (-1))
-          Lua.pop 1
-          return $ case filterFn of
-            Left _  -> acc
-            Right f -> (c, f) : acc
-    in LuaFilter . Map.fromList <$> foldrM fn [] constrs
-
--- | 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.
--- Alternatively, the function can return nothing or nil, in which case the
--- element is left unchanged.
-runFilterFunction :: ToLuaStack a => LuaFilterFunction -> a -> Lua ()
-runFilterFunction lf x = do
-  pushFilterFunction lf
-  push x
-  z <- Lua.pcall 1 1 Nothing
-  when (z /= OK) $ do
-    let addPrefix = ("Error while running filter function: " ++)
-    Lua.throwTopMessageAsError' addPrefix
-
-elementOrList :: FromLuaStack a => a -> Lua [a]
-elementOrList x = do
-  let topOfStack = Lua.StackIndex (-1)
-  elementUnchanged <- Lua.isnil topOfStack
-  if elementUnchanged
-    then [x] <$ Lua.pop 1
-    else do
-       mbres <- Lua.peekEither topOfStack
-       case mbres of
-         Right res -> [res] <$ Lua.pop 1
-         Left _    -> Lua.toList topOfStack <* Lua.pop 1
-
-singleElement :: FromLuaStack a => a -> Lua a
-singleElement x = do
-  elementUnchanged <- Lua.isnil (-1)
-  if elementUnchanged
-    then x <$ Lua.pop 1
-    else do
-    mbres <- Lua.peekEither (-1)
-    case mbres of
-      Right res -> res <$ Lua.pop 1
-      Left err  -> do
-        Lua.pop 1
-        Lua.throwLuaError $
-          "Error while trying to get a filter's return " ++
-          "value from lua stack.\n" ++ err
-
--- | Push the filter function to the top of the stack.
-pushFilterFunction :: LuaFilterFunction -> Lua ()
-pushFilterFunction lf =
-  -- The function is stored in a lua registry table, retrieve it from there.
-  Lua.rawgeti Lua.registryindex (functionIndex lf)
-
-registerFilterFunction :: StackIndex -> Lua LuaFilterFunction
-registerFilterFunction idx = do
-  isFn <- Lua.isfunction idx
-  unless isFn . Lua.throwLuaError $ "Not a function at index " ++ show idx
-  Lua.pushvalue idx
-  refIdx <- Lua.ref Lua.registryindex
-  return $ LuaFilterFunction refIdx
-
 instance (FromLuaStack a) => FromLuaStack (Identity a) where
   peek = fmap return . peek
-
-instance ToLuaStack LuaFilterFunction where
-  push = pushFilterFunction
-
-instance FromLuaStack LuaFilterFunction where
-  peek = registerFilterFunction