@@ -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>
4+
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.
9+
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.
14+
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
18+-}
219{-# LANGUAGE FlexibleContexts #-}
3−
20+{-# LANGUAGE NoImplicitPrelude #-}
21+{- |
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>
27+Stability : alpha
28+
29+Types and functions for running Lua filters.
30+-}
431module Text.Pandoc.Lua.Filter ( LuaFilterFunction
532 , LuaFilter
633 , tryFilter
@@ -12,60 +39,56 @@ module Text.Pandoc.Lua.Filter ( LuaFilterFunction
1239 , inlineElementNames
1340 ) where
1441import Prelude
15−import Control.Monad (mplus, unless, when, (>=>))
42+import Control.Monad (mplus, (>=>))
1643import Control.Monad.Catch (finally)
17−import Text.Pandoc.Definition
18−import Data.Foldable (foldrM)
19−import Data.Map (Map)
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)
2544import Data.Data (Data, DataType, dataTypeConstrs, dataTypeName, dataTypeOf,
2645 showConstr, toConstr, tyconUQname)
27−import Text.Pandoc.Lua.StackInstances()
46+import Data.Foldable (foldrM)
47+import Data.Map (Map)
48+import Foreign.Lua (Lua, FromLuaStack, ToLuaStack)
49+import Text.Pandoc.Definition
50+import Text.Pandoc.Lua.StackInstances ()
2851import Text.Pandoc.Lua.Util (typeCheck)
52+import Text.Pandoc.Walk (walkM, Walkable)
2953
30−type FunctionMap = Map String LuaFilterFunction
31−
32−newtype LuaFilterFunction = LuaFilterFunction { functionIndex :: Int }
33−
34−instance ToLuaStack LuaFilterFunction where
35− push = pushFilterFunction
54+import qualified Data.Map.Strict as Map
55+import qualified Foreign.Lua as Lua
3656
37−instance FromLuaStack LuaFilterFunction where
38− peek = registerFilterFunction
57+-- | Filter function stored at the given index in the registry
58+newtype LuaFilterFunction = LuaFilterFunction Int
3959
40−newtype LuaFilter = LuaFilter FunctionMap
60+-- | Collection of filter functions (at most one function per element
61+-- constructor)
62+newtype LuaFilter = LuaFilter (Map String LuaFilterFunction)
4163
4264instance FromLuaStack LuaFilter where
43− peek idx =
44− let constrs = metaFilterName : pandocFilterNames
45− ++ blockElementNames
46− ++ inlineElementNames
47− fn c acc = do
48− Lua.getfield idx c
49− filterFn <- Lua.tryLua (peek (-1))
50− Lua.pop 1
65+ peek idx = do
66+ let constrs = metaFilterName
67+ : pandocFilterNames
68+ ++ blockElementNames
69+ ++ inlineElementNames
70+ let go constr acc = do
71+ Lua.getfield idx constr
72+ filterFn <- registerFilterFunction
5173 return $ case filterFn of
52− Left _ -> acc
53− Right f -> (c, f) : acc
54− in LuaFilter . Map.fromList <$> foldrM fn [] constrs
55−
56−-- | Push the filter function to the top of the stack.
74+ Nothing -> acc
75+ Just fn -> Map.insert constr fn acc
76+ LuaFilter <$> foldrM go Map.empty constrs
77+
78+-- | Register the function at the top of the stack as a filter function in the
79+-- registry.
80+registerFilterFunction :: Lua (Maybe LuaFilterFunction)
81+registerFilterFunction = do
82+ isFn <- Lua.isfunction Lua.stackTop
83+ if isFn
84+ then Just . LuaFilterFunction <$> Lua.ref Lua.registryindex
85+ else Nothing <$ Lua.pop 1
86+
87+-- | Retrieve filter function from registry and push it to the top of the stack.
5788pushFilterFunction :: LuaFilterFunction -> Lua ()
58−pushFilterFunction lf =
59− -- The function is stored in a lua registry table, retrieve it from there.
60− Lua.rawgeti Lua.registryindex (functionIndex lf)
61−
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
66− Lua.pushvalue idx
67− refIdx <- Lua.ref Lua.registryindex
68− return $ LuaFilterFunction refIdx
89+pushFilterFunction (LuaFilterFunction fnRef) =
90+ Lua.rawgeti Lua.registryindex fnRef
91+
6992
7093elementOrList :: FromLuaStack a => a -> Lua [a]
7194elementOrList x = do
@@ -98,12 +121,11 @@ tryFilter (LuaFilter fnMap) x =
98121-- element is left unchanged.
99122runFilterFunction :: ToLuaStack a => LuaFilterFunction -> a -> Lua ()
100123runFilterFunction lf x = do
101− pushFilterFunction lf
102− push x
103− z <- Lua.pcall 1 1 Nothing
104− when (z /= OK) $ do
105− let addPrefix = ("Error while running filter function: " ++)
106− Lua.throwTopMessageAsError' addPrefix
124+ let errorPrefix = "Error while running filter function:\n"
125+ (`Lua.modifyLuaError` (errorPrefix <>)) $ do
126+ pushFilterFunction lf
127+ Lua.push x
128+ Lua.call 1 1
107129
108130walkMWithLuaFilter :: LuaFilter -> Pandoc -> Lua Pandoc
109131walkMWithLuaFilter f =