@@ -36,7 +36,7 @@ StackValue instances for pandoc types.
3636module Text.Pandoc.Lua.StackInstances () where
3737
3838import Data.Aeson ( FromJSON(..), ToJSON(..), Result(..), Value, fromJSON )
39−import Scripting.Lua ( StackValue(..) )
39+import Scripting.Lua ( LuaState, StackValue(..), newtable, pop, rawget, rawset )
4040import Scripting.Lua.Aeson ()
4141import Text.Pandoc.Definition ( Block(..), Inline(..), Pandoc(..) )
4242
@@ -59,8 +59,20 @@ instance StackValue Block where
5959 valuetype _ = Lua.TTABLE
6060
6161instance StackValue Inline where
62− push lua = Lua.push lua . toJSON
63− peek lua i = maybeFromJson <$> peek lua i
62+ push lua = \case
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
6476 valuetype _ = Lua.TTABLE
6577
6678#if MIN_VERSION_base(4,8,0)
@@ -68,8 +80,62 @@ instance {-# OVERLAPS #-} StackValue [Char] where
6880#else
6981instance StackValue [Char] where
7082#endif
71− push lua cs = Lua.push lua (UTF8.fromString cs)
72− peek lua i = do
73− res <- Lua.peek lua i
74− return $ UTF8.toString `fmap` res
83+ push lua cs = push lua (UTF8.fromString cs)
84+ peek lua i = fmap UTF8.toString <$> peek lua i
7585 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