@@ -1,6 +1,33 @@
1−{-# LANGUAGE NoImplicitPrelude #-}
1+{-
2+Copyright © 2012-2018 John MacFarlane <jgm@berkeley.edu>
3+ 2017-2018 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
5+This program is free software; you can redistribute it and/or modify
6+it under the terms of the GNU General Public License as published by
7+the Free Software Foundation; either version 2 of the License, or
8+(at your option) any later version.
10+This program is distributed in the hope that it will be useful,
11+but WITHOUT ANY WARRANTY; without even the implied warranty of
12+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13+GNU General Public License for more details.
15+You should have received a copy of the GNU General Public License
16+along with this program; if not, write to the Free Software
17+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
2{-# LANGUAGE FlexibleContexts #-}
19{-# LANGUAGE FlexibleContexts #-}
3−
20+{-# LANGUAGE NoImplicitPrelude #-}
22+Module : Text.Pandoc.Lua.Filter
23+Copyright : © 2012–2018 John MacFarlane,
24+ © 2017-2018 Albert Krewinkel
25+License : GNU GPL, version 2 or above
26+Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
29+Types and functions for running Lua filters.
4module Text.Pandoc.Lua.Filter ( LuaFilterFunction
31module Text.Pandoc.Lua.Filter ( LuaFilterFunction
5 , LuaFilter
32 , LuaFilter
6 , tryFilter
33 , tryFilter
@@ -12,60 +39,56 @@ module Text.Pandoc.Lua.Filter ( LuaFilterFunction
12 , inlineElementNames
39 , inlineElementNames
14import Prelude
41import Prelude
15−import Control.Monad (mplus, unless, when, (>=>))
42+import Control.Monad (mplus, (>=>))
16import Control.Monad.Catch (finally)
43import Control.Monad.Catch (finally)
17−import Text.Pandoc.Definition
18−import Data.Foldable (foldrM)
20−import qualified Data.Map as Map
21−import qualified Foreign.Lua as Lua
22−import Foreign.Lua (FromLuaStack (peek), Lua, StackIndex,
23− Status (OK), ToLuaStack (push))
24−import Text.Pandoc.Walk (walkM, Walkable)
25import Data.Data (Data, DataType, dataTypeConstrs, dataTypeName, dataTypeOf,
44import Data.Data (Data, DataType, dataTypeConstrs, dataTypeName, dataTypeOf,
26 showConstr, toConstr, tyconUQname)
45 showConstr, toConstr, tyconUQname)
46+import Data.Foldable (foldrM)
48+import Foreign.Lua (Lua, FromLuaStack, ToLuaStack)
49+import Text.Pandoc.Definition
27−import Text.Pandoc.Lua.StackInstances()
50+import Text.Pandoc.Lua.StackInstances ()
28import Text.Pandoc.Lua.Util (typeCheck)
51import Text.Pandoc.Lua.Util (typeCheck)
52+import Text.Pandoc.Walk (walkM, Walkable)
30−type FunctionMap = Map String LuaFilterFunction
54+import qualified Data.Map.Strict as Map
31−
55+import qualified Foreign.Lua as Lua
32−newtype LuaFilterFunction = LuaFilterFunction { functionIndex :: Int }
34−instance ToLuaStack LuaFilterFunction where
35− push = pushFilterFunction
37−instance FromLuaStack LuaFilterFunction where
57+-- | Filter function stored at the given index in the registry
38− peek = registerFilterFunction
58+newtype LuaFilterFunction = LuaFilterFunction Int
60+-- | Collection of filter functions (at most one function per element
40−newtype LuaFilter = LuaFilter FunctionMap
62+newtype LuaFilter = LuaFilter (Map String LuaFilterFunction)
42instance FromLuaStack LuaFilter where
64instance FromLuaStack LuaFilter where
43− peek idx =
65+ peek idx = do
44− let constrs = metaFilterName : pandocFilterNames
66+ let constrs = metaFilterName
45− ++ blockElementNames
68+ ++ blockElementNames
46− ++ inlineElementNames
69+ ++ inlineElementNames
47− fn c acc = do
70+ let go constr acc = do
48− Lua.getfield idx c
71+ Lua.getfield idx constr
49− filterFn <- Lua.tryLua (peek (-1))
72+ filterFn <- registerFilterFunction
51 return $ case filterFn of
73 return $ case filterFn of
52− Left _ -> acc
74+ Nothing -> acc
53− Right f -> (c, f) : acc
75+ Just fn -> Map.insert constr fn acc
54− in LuaFilter . Map.fromList <$> foldrM fn [] constrs
76+ LuaFilter <$> foldrM go Map.empty constrs
56−-- | Push the filter function to the top of the stack.
78+-- | Register the function at the top of the stack as a filter function in the
80+registerFilterFunction :: Lua (Maybe LuaFilterFunction)
81+registerFilterFunction = do
82+ isFn <- Lua.isfunction Lua.stackTop
84+ then Just . LuaFilterFunction <$> Lua.ref Lua.registryindex
85+ else Nothing <$ Lua.pop 1
87+-- | Retrieve filter function from registry and push it to the top of the stack.
57pushFilterFunction :: LuaFilterFunction -> Lua ()
88pushFilterFunction :: LuaFilterFunction -> Lua ()
58−pushFilterFunction lf =
89+pushFilterFunction (LuaFilterFunction fnRef) =
59− -- The function is stored in a lua registry table, retrieve it from there.
90+ Lua.rawgeti Lua.registryindex fnRef
60− Lua.rawgeti Lua.registryindex (functionIndex lf)
91+
62−registerFilterFunction :: StackIndex -> Lua LuaFilterFunction
63−registerFilterFunction idx = do
64− isFn <- Lua.isfunction idx
65− unless isFn . Lua.throwLuaError $ "Not a function at index " ++ show idx
67− refIdx <- Lua.ref Lua.registryindex
68− return $ LuaFilterFunction refIdx
70elementOrList :: FromLuaStack a => a -> Lua [a]
93elementOrList :: FromLuaStack a => a -> Lua [a]
71elementOrList x = do
94elementOrList x = do
@@ -98,12 +121,11 @@ tryFilter (LuaFilter fnMap) x =
98-- element is left unchanged.
121-- element is left unchanged.
99runFilterFunction :: ToLuaStack a => LuaFilterFunction -> a -> Lua ()
122runFilterFunction :: ToLuaStack a => LuaFilterFunction -> a -> Lua ()
100runFilterFunction lf x = do
123runFilterFunction lf x = do
101− pushFilterFunction lf
103− z <- Lua.pcall 1 1 Nothing
105− let addPrefix = ("Error while running filter function: " ++)
124+ let errorPrefix = "Error while running filter function:\n"
106− Lua.throwTopMessageAsError' addPrefix
125+ (`Lua.modifyLuaError` (errorPrefix <>)) $ do
126+ pushFilterFunction lf
108walkMWithLuaFilter :: LuaFilter -> Pandoc -> Lua Pandoc
130walkMWithLuaFilter :: LuaFilter -> Pandoc -> Lua Pandoc
109walkMWithLuaFilter f =
131walkMWithLuaFilter f =