git.iko.soy/typeable/pandoc
on master help sign in
Lua filter: Improve inline filter performance
dd00163Albert Krewinkel
src/Text/Pandoc/Lua/StackInstances.hs+73−7
@@ -36,7 +36,7 @@ StackValue instances for pandoc types.
36module Text.Pandoc.Lua.StackInstances () where
36module Text.Pandoc.Lua.StackInstances () where
37
37
38import Data.Aeson ( FromJSON(..), ToJSON(..), Result(..), Value, fromJSON )
38import Data.Aeson ( FromJSON(..), ToJSON(..), Result(..), Value, fromJSON )
39−import Scripting.Lua ( StackValue(..) )
39+import Scripting.Lua ( LuaState, StackValue(..), newtable, pop, rawget, rawset )
40import Scripting.Lua.Aeson ()
40import Scripting.Lua.Aeson ()
41import Text.Pandoc.Definition ( Block(..), Inline(..), Pandoc(..) )
41import Text.Pandoc.Definition ( Block(..), Inline(..), Pandoc(..) )
42
42
@@ -59,8 +59,20 @@ instance StackValue Block where
59 valuetype _ = Lua.TTABLE
59 valuetype _ = Lua.TTABLE
60
60
61instance StackValue Inline where
61instance StackValue Inline where
62− push lua = Lua.push lua . toJSON
62+ push lua = \case
63− peek lua i = maybeFromJson <$> peek lua i
63+ Emph inlns -> pushTagged lua "Emph" inlns
64+ LineBreak -> pushTagged' lua "LineBreak"
65+ Note blcks -> pushTagged lua "Note" blcks
66+ SmallCaps inlns -> pushTagged lua "SmallCaps" inlns
67+ SoftBreak -> pushTagged' lua "SoftBreak"
68+ Space -> pushTagged' lua "Space"
69+ Str s -> pushTagged lua "Str" s
70+ Strikeout inlns -> pushTagged lua "Strikeout" inlns
71+ Strong inlns -> pushTagged lua "Strong" inlns
72+ Subscript inlns -> pushTagged lua "Subscript" inlns
73+ Superscript inlns -> pushTagged lua "Superscript" inlns
74+ x -> push lua (toJSON x)
75+ peek = peekInline
64 valuetype _ = Lua.TTABLE
76 valuetype _ = Lua.TTABLE
65
77
66#if MIN_VERSION_base(4,8,0)
78#if MIN_VERSION_base(4,8,0)
@@ -68,8 +80,62 @@ instance {-# OVERLAPS #-} StackValue [Char] where
68#else
80#else
69instance StackValue [Char] where
81instance StackValue [Char] where
70#endif
82#endif
71− push lua cs = Lua.push lua (UTF8.fromString cs)
83+ push lua cs = push lua (UTF8.fromString cs)
72− peek lua i = do
84+ peek lua i = fmap UTF8.toString <$> peek lua i
73− res <- Lua.peek lua i
74− return $ UTF8.toString `fmap` res
75 valuetype _ = Lua.TSTRING
85 valuetype _ = Lua.TSTRING
86+
87+-- | Push a value to the lua stack, tagged with a given string. This currently
88+-- creates a structure equivalent to what the JSONified value would look like
89+-- when pushed to lua.
90+pushTagged :: StackValue a => LuaState -> String -> a -> IO ()
91+pushTagged lua tag value = do
92+ newtable lua
93+ push lua "t"
94+ push lua tag
95+ rawset lua (-3)
96+ push lua "c"
97+ push lua value
98+ rawset lua (-3)
99+
100+pushTagged' :: LuaState -> String -> IO ()
101+pushTagged' lua tag = do
102+ newtable lua
103+ push lua "t"
104+ push lua tag
105+ rawset lua (-3)
106+
107+-- | Return the value at the given index as inline if possible.
108+peekInline :: LuaState -> Int -> IO (Maybe Inline)
109+peekInline lua idx = do
110+ push lua "t"
111+ rawget lua (idx `adjustIndexBy` 1)
112+ tag <- peek lua (-1) <* pop lua 1
113+ case tag of
114+ Nothing -> return Nothing
115+ Just t -> case t of
116+ "Emph" -> fmap Emph <$> elementContent
117+ "LineBreak" -> return (Just LineBreak)
118+ "Note" -> fmap Note <$> elementContent
119+ "SmallCaps" -> fmap SmallCaps <$> elementContent
120+ "SoftBreak" -> return (Just SoftBreak)
121+ "Space" -> return (Just Space)
122+ "Str" -> fmap Str <$> elementContent
123+ "Strikeout" -> fmap Strikeout <$> elementContent
124+ "Strong" -> fmap Strong <$> elementContent
125+ "Subscript" -> fmap Subscript <$> elementContent
126+ "Superscript"-> fmap Superscript <$> elementContent
127+ _ -> maybeFromJson <$> peek lua idx
128+ where
129+ elementContent :: StackValue a => IO (Maybe a)
130+ elementContent = do
131+ push lua "c"
132+ rawget lua (idx `adjustIndexBy` 1)
133+ peek lua (-1) <* pop lua 1
134+
135+-- | Adjust the stack index, assuming that @n@ new elements have been pushed on
136+-- the stack.
137+adjustIndexBy :: Int -> Int -> Int
138+adjustIndexBy idx n =
139+ if idx < 0
140+ then idx - n
141+ else idx