From 56fb854ad85dafff2016892bd6d2c5d24423bff0 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Tue, 22 Aug 2017 22:02:30 +0200 Subject: Text.Pandoc.Lua: respect metatable when getting filters MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This change makes it possible to define a catch-all function using lua's metatable lookup functionality. function catch_all(el) … end return { setmetatable({}, {__index = function(_) return catch_all end}) } A further effect of this change is that the map with filter functions now only contains functions corresponding to AST element constructors. --- src/Text/Pandoc/Lua.hs | 128 +++++++++++++++++++++++++++++-------------------- 1 file changed, 76 insertions(+), 52 deletions(-) (limited to 'src/Text/Pandoc') diff --git a/src/Text/Pandoc/Lua.hs b/src/Text/Pandoc/Lua.hs index 6190a5fcf..db028d325 100644 --- a/src/Text/Pandoc/Lua.hs +++ b/src/Text/Pandoc/Lua.hs @@ -32,50 +32,50 @@ Pandoc lua utils. -} module Text.Pandoc.Lua (LuaException (..), pushPandocModule, runLuaFilter) where -import Control.Monad (unless, when, (>=>), mplus) +import Control.Monad (mplus, unless, when, (>=>)) import Control.Monad.Trans (MonadIO (..)) -import Data.Data (toConstr, showConstr, dataTypeOf, dataTypeConstrs, Data) +import Data.Data (DataType, Data, toConstr, showConstr, dataTypeOf, + dataTypeConstrs) +import Data.Foldable (foldrM) import Data.Map (Map) import Data.Maybe (isJust) import Foreign.Lua (Lua, FromLuaStack (peek), LuaException (..), StackIndex, - Status(OK), ToLuaStack (push), call, isnil, dofile, - getglobal', gettop, isfunction, newtable, openlibs, pcall, - peekEither, pop, pushvalue, rawgeti, rawseti, ref, - registryindex, runLua, setglobal, throwLuaError) + Status(OK), ToLuaStack (push)) import Text.Pandoc.Definition import Text.Pandoc.Lua.PandocModule (pushPandocModule) import Text.Pandoc.Walk (Walkable (walkM)) import qualified Data.Map as Map +import qualified Foreign.Lua as Lua runLuaFilter :: (MonadIO m) => Maybe FilePath -> FilePath -> [String] -> Pandoc -> m Pandoc -runLuaFilter datadir filterPath args pd = liftIO . runLua $ do - openlibs +runLuaFilter datadir filterPath args pd = liftIO . Lua.runLua $ do + Lua.openlibs -- store module in global "pandoc" pushPandocModule datadir - setglobal "pandoc" - top <- gettop - stat<- dofile filterPath + Lua.setglobal "pandoc" + top <- Lua.gettop + stat<- Lua.dofile filterPath if stat /= OK then do - luaErrMsg <- peek (-1) <* pop 1 - throwLuaError luaErrMsg + luaErrMsg <- peek (-1) <* Lua.pop 1 + Lua.throwLuaError luaErrMsg else do - newtop <- gettop + newtop <- Lua.gettop -- Use the implicitly defined global filter if nothing was returned when (newtop - top < 1) $ pushGlobalFilter luaFilters <- peek (-1) push args - setglobal "PandocParameters" + Lua.setglobal "PandocParameters" runAll luaFilters pd pushGlobalFilter :: Lua () pushGlobalFilter = do - newtable - getglobal' "pandoc.global_filter" - call 0 1 - rawseti (-2) 1 + Lua.newtable + Lua.getglobal' "pandoc.global_filter" + Lua.call 0 1 + Lua.rawseti (-2) 1 runAll :: [LuaFilter] -> Pandoc -> Lua Pandoc runAll = foldr ((>=>) . walkMWithLuaFilter) return @@ -85,29 +85,42 @@ walkMWithLuaFilter (LuaFilter fnMap) = walkLua where walkLua :: Pandoc -> Lua Pandoc walkLua = - (if hasOneOf (constructorsFor (dataTypeOf (Str []))) - then walkM (tryFilter fnMap :: Inline -> Lua Inline) - else return) - >=> - (if hasOneOf (constructorsFor (dataTypeOf (Para []))) - then walkM (tryFilter fnMap :: Block -> Lua Block) - else return) - >=> - (case Map.lookup "Meta" fnMap of - Just fn -> walkM (\(Pandoc meta blocks) -> do - meta' <- runFilterFunction fn meta - return $ Pandoc meta' blocks) - Nothing -> return) - >=> - (case Map.lookup "Pandoc" fnMap `mplus` Map.lookup "Doc" fnMap of - Just fn -> runFilterFunction fn :: Pandoc -> Lua Pandoc - Nothing -> return) + (if hasOneOf inlineFilterNames + then walkM (tryFilter fnMap :: Inline -> Lua Inline) + else return) + >=> + (if hasOneOf blockFilterNames + then walkM (tryFilter fnMap :: Block -> Lua Block) + else return) + >=> + (case Map.lookup "Meta" fnMap of + Just fn -> walkM (\(Pandoc meta blocks) -> do + meta' <- runFilterFunction fn meta + return $ Pandoc meta' blocks) + Nothing -> return) + >=> + (case foldl mplus Nothing (map (`Map.lookup` fnMap) pandocFilterNames) of + Just fn -> runFilterFunction fn :: Pandoc -> Lua Pandoc + Nothing -> return) hasOneOf = any (\k -> isJust (Map.lookup k fnMap)) - constructorsFor x = map show (dataTypeConstrs x) -type FunctionMap = Map String LuaFilterFunction -data LuaFilter = LuaFilter FunctionMap +constructorsFor :: DataType -> [String] +constructorsFor x = map show (dataTypeConstrs x) + +inlineFilterNames :: [String] +inlineFilterNames = constructorsFor (dataTypeOf (Str [])) + +blockFilterNames :: [String] +blockFilterNames = 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 @@ -119,7 +132,18 @@ tryFilter fnMap x = Just fn -> runFilterFunction fn x instance FromLuaStack LuaFilter where - peek idx = LuaFilter <$> peek idx + 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. @@ -130,36 +154,36 @@ runFilterFunction :: (FromLuaStack a, ToLuaStack a) runFilterFunction lf x = do pushFilterFunction lf push x - z <- pcall 1 1 Nothing + z <- Lua.pcall 1 1 Nothing if z /= OK then do msg <- peek (-1) let prefix = "Error while running filter function: " - throwLuaError $ prefix ++ msg + Lua.throwLuaError $ prefix ++ msg else do - noExplicitFilter <- isnil (-1) + noExplicitFilter <- Lua.isnil (-1) if noExplicitFilter - then pop 1 *> return x + then Lua.pop 1 *> return x else do - mbres <- peekEither (-1) + mbres <- Lua.peekEither (-1) case mbres of - Left err -> throwLuaError + Left err -> Lua.throwLuaError ("Error while trying to get a filter's return " ++ "value from lua stack.\n" ++ err) - Right res -> res <$ pop 1 + Right res -> res <$ Lua.pop 1 -- | 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. - rawgeti registryindex (functionIndex lf) + Lua.rawgeti Lua.registryindex (functionIndex lf) registerFilterFunction :: StackIndex -> Lua LuaFilterFunction registerFilterFunction idx = do - isFn <- isfunction idx - unless isFn . throwLuaError $ "Not a function at index " ++ show idx - pushvalue idx - refIdx <- ref registryindex + 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 ToLuaStack LuaFilterFunction where -- cgit v1.2.3