git.iko.soy/typeable/pandoc
on master help sign in
Lua filter: improve doc filter performance

Pandoc elements are pushed and pulled from the lua stack via custom instances.

commit41ebdee5df4b322ce49ee955824047a7e4d888f9 authorAlbert Krewinkel <albert@zeitkraut.de> dateFri 7 Apr 2017, 21:04 (10 years ago) parentd412c38
2 files changed+56−37
src/Text/Pandoc/Lua/StackInstances.hs+47−36 test/Tests/Lua.hs+9−1
src/Text/Pandoc/Lua/StackInstances.hs+47−36
@@ -38,7 +38,7 @@ module Text.Pandoc.Lua.StackInstances () where
3838import Data.Aeson ( FromJSON(..), ToJSON(..), Result(..), Value, fromJSON )
3939import Scripting.Lua ( LuaState, StackValue(..), newtable, pop, rawget, rawset )
4040import Scripting.Lua.Aeson ()
41−import Text.Pandoc.Definition ( Block(..), Inline(..), Pandoc(..) )
41+import Text.Pandoc.Definition ( Block(..), Inline(..), Meta(..), Pandoc(..) )
4242
4343import qualified Scripting.Lua as Lua
4444import qualified Text.Pandoc.UTF8 as UTF8
@@ -49,19 +49,30 @@ maybeFromJson mv = fromJSON <$> mv >>= \case
4949 _ -> Nothing
5050
5151instance StackValue Pandoc where
52− push lua = Lua.push lua . toJSON
53− peek lua i = maybeFromJson <$> peek lua i
52+ push lua (Pandoc meta blocks) = do
53+ newtable lua
54+ setField lua (-1) "blocks" blocks
55+ setField lua (-1) "meta" meta
56+ peek lua idx = do
57+ blocks <- getField lua idx "blocks"
58+ meta <- getField lua idx "meta"
59+ return $ Pandoc <$> meta <*> blocks
60+ valuetype _ = Lua.TTABLE
61+
62+instance StackValue Meta where
63+ push lua = push lua . toJSON
64+ peek lua = fmap maybeFromJson . peek lua
5465 valuetype _ = Lua.TTABLE
5566
5667instance StackValue Block where
5768 push lua = \case
58− BlockQuote blcks -> pushTagged lua "BlockQuote" blcks
59− BulletList items -> pushTagged lua "BulletList" items
69+ BlockQuote blcks -> pushTagged lua "BlockQuote" blcks
70+ BulletList items -> pushTagged lua "BulletList" items
6071 HorizontalRule -> pushTagged' lua "HorizontalRule"
61− LineBlock blcks -> pushTagged lua "LineBlock" blcks
72+ LineBlock blcks -> pushTagged lua "LineBlock" blcks
6273 Null -> pushTagged' lua "Null"
63− Para blcks -> pushTagged lua "Para" blcks
64− Plain blcks -> pushTagged lua "Plain" blcks
74+ Para blcks -> pushTagged lua "Para" blcks
75+ Plain blcks -> pushTagged lua "Plain" blcks
6576 -- fall back to conversion via aeson's Value
6677 x -> push lua (toJSON x)
6778 peek lua i = peekBlock lua i
@@ -69,17 +80,17 @@ instance StackValue Block where
6980
7081instance StackValue Inline where
7182 push lua = \case
72− Emph inlns -> pushTagged lua "Emph" inlns
83+ Emph inlns -> pushTagged lua "Emph" inlns
7384 LineBreak -> pushTagged' lua "LineBreak"
74− Note blcks -> pushTagged lua "Note" blcks
75− SmallCaps inlns -> pushTagged lua "SmallCaps" inlns
85+ Note blcks -> pushTagged lua "Note" blcks
86+ SmallCaps inlns -> pushTagged lua "SmallCaps" inlns
7687 SoftBreak -> pushTagged' lua "SoftBreak"
7788 Space -> pushTagged' lua "Space"
78− Str s -> pushTagged lua "Str" s
79− Strikeout inlns -> pushTagged lua "Strikeout" inlns
80− Strong inlns -> pushTagged lua "Strong" inlns
81− Subscript inlns -> pushTagged lua "Subscript" inlns
82− Superscript inlns -> pushTagged lua "Superscript" inlns
89+ Str s -> pushTagged lua "Str" s
90+ Strikeout inlns -> pushTagged lua "Strikeout" inlns
91+ Strong inlns -> pushTagged lua "Strong" inlns
92+ Subscript inlns -> pushTagged lua "Subscript" inlns
93+ Superscript inlns -> pushTagged lua "Superscript" inlns
8394 x -> push lua (toJSON x)
8495 peek = peekInline
8596 valuetype _ = Lua.TTABLE
@@ -99,12 +110,8 @@ instance StackValue [Char] where
99110pushTagged :: StackValue a => LuaState -> String -> a -> IO ()
100111pushTagged lua tag value = do
101112 newtable lua
102− push lua "t"
103− push lua tag
104− rawset lua (-3)
105− push lua "c"
106− push lua value
107− rawset lua (-3)
113+ setField lua (-1) "t" tag
114+ setField lua (-1) "c" value
108115
109116pushTagged' :: LuaState -> String -> IO ()
110117pushTagged' lua tag = do
@@ -116,9 +123,7 @@ pushTagged' lua tag = do
116123-- | Return the value at the given index as inline if possible.
117124peekInline :: LuaState -> Int -> IO (Maybe Inline)
118125peekInline lua idx = do
119− push lua "t"
120− rawget lua (idx `adjustIndexBy` 1)
121− tag <- peek lua (-1) <* pop lua 1
126+ tag <- getField lua idx "t"
122127 case tag of
123128 Nothing -> return Nothing
124129 Just t -> case t of
@@ -138,17 +143,12 @@ peekInline lua idx = do
138143 where
139144 -- Get the contents of an AST element.
140145 elementContent :: StackValue a => IO (Maybe a)
141− elementContent = do
142− push lua "c"
143− rawget lua (idx `adjustIndexBy` 1)
144− peek lua (-1) <* pop lua 1
146+ elementContent = getField lua idx "c"
145147
146148-- | Return the value at the given index as block if possible.
147149peekBlock :: LuaState -> Int -> IO (Maybe Block)
148150peekBlock lua idx = do
149− push lua "t"
150− rawget lua (idx `adjustIndexBy` 1)
151− tag <- peek lua (-1) <* pop lua 1
151+ tag <- getField lua idx "t"
152152 case tag of
153153 Nothing -> return Nothing
154154 Just t -> case t of
@@ -164,10 +164,7 @@ peekBlock lua idx = do
164164 where
165165 -- Get the contents of an AST element.
166166 elementContent :: StackValue a => IO (Maybe a)
167− elementContent = do
168− push lua "c"
169− rawget lua (idx `adjustIndexBy` 1)
170− peek lua (-1) <* pop lua 1
167+ elementContent = getField lua idx "c"
171168
172169-- | Adjust the stack index, assuming that @n@ new elements have been pushed on
173170-- the stack.
@@ -176,3 +173,17 @@ adjustIndexBy idx n =
176173 if idx < 0
177174 then idx - n
178175 else idx
176+
177+-- | Get value behind key from table at given index.
178+getField :: (StackValue a, StackValue b) => LuaState -> Int -> a -> IO (Maybe b)
179+getField lua idx key = do
180+ push lua key
181+ rawget lua (idx `adjustIndexBy` 1)
182+ peek lua (-1) <* pop lua 1
183+
184+-- | Set value for key for table at the given index
185+setField :: (StackValue a, StackValue b) => LuaState -> Int -> a -> b -> IO ()
186+setField lua idx key value = do
187+ push lua key
188+ push lua value
189+ rawset lua (idx `adjustIndexBy` 2)
test/Tests/Lua.hs+9−1
@@ -7,7 +7,9 @@ import Test.Tasty (TestTree)
77import Test.Tasty.HUnit (Assertion, assertEqual, testCase)
88import Test.Tasty.QuickCheck (ioProperty, testProperty)
99import Text.Pandoc.Arbitrary ()
10−import Text.Pandoc.Builder
10+import Text.Pandoc.Definition (Block, Inline, Meta, Pandoc)
11+import Text.Pandoc.Builder ( (<>), bulletList, doc, emph, linebreak, rawBlock
12+ , para, plain, space, str, strong)
1113import Text.Pandoc.Lua
1214
1315import qualified Scripting.Lua as Lua
@@ -43,6 +45,12 @@ tests =
4345
4446 , testProperty "block elements can be round-tripped through the lua stack" $
4547 \x -> ioProperty (roundtripEqual (x::Block))
48+
49+ , testProperty "meta blocks can be round-tripped through the lua stack" $
50+ \x -> ioProperty (roundtripEqual (x::Meta))
51+
52+ , testProperty "documents can be round-tripped through the lua stack" $
53+ \x -> ioProperty (roundtripEqual (x::Pandoc))
4654 ]
4755
4856assertFilterConversion :: String -> FilePath -> Pandoc -> Pandoc -> Assertion