@@ -36,11 +36,15 @@ StackValue instances for pandoc types.
3636module Text.Pandoc.Lua.StackInstances () where
3737
3838import Data.Aeson ( FromJSON(..), ToJSON(..), Result(..), Value, fromJSON )
39−import Scripting.Lua ( LuaState, StackValue(..), newtable, pop, rawget, rawset )
39+import Scripting.Lua
40+ ( LTYPE(..), LuaState, StackValue(..)
41+ , gettable, newtable, pop, rawgeti, rawset, rawseti, settable
42+ )
4043import Scripting.Lua.Aeson ()
41−import Text.Pandoc.Definition ( Block(..), Inline(..), Meta(..), Pandoc(..) )
44+import Text.Pandoc.Definition
45+ ( Block(..), Inline(..), Meta(..), Pandoc(..)
46+ , Citation(..), CitationMode(..), Format(..), MathType(..), QuoteType(..) )
4247
43−import qualified Scripting.Lua as Lua
4448import qualified Text.Pandoc.UTF8 as UTF8
4549
4650maybeFromJson :: (FromJSON a) => Maybe Value -> Maybe a
@@ -57,12 +61,12 @@ instance StackValue Pandoc where
5761 blocks <- getField lua idx "blocks"
5862 meta <- getField lua idx "meta"
5963 return $ Pandoc <$> meta <*> blocks
60− valuetype _ = Lua.TTABLE
64+ valuetype _ = TTABLE
6165
6266instance StackValue Meta where
6367 push lua = push lua . toJSON
6468 peek lua = fmap maybeFromJson . peek lua
65− valuetype _ = Lua.TTABLE
69+ valuetype _ = TTABLE
6670
6771instance StackValue Block where
6872 push lua = \case
@@ -76,24 +80,99 @@ instance StackValue Block where
7680 -- fall back to conversion via aeson's Value
7781 x -> push lua (toJSON x)
7882 peek lua i = peekBlock lua i
79− valuetype _ = Lua.TTABLE
83+ valuetype _ = TTABLE
8084
8185instance StackValue Inline where
8286 push lua = \case
83− Emph inlns -> pushTagged lua "Emph" inlns
84− LineBreak -> pushTagged' lua "LineBreak"
85− Note blcks -> pushTagged lua "Note" blcks
86− SmallCaps inlns -> pushTagged lua "SmallCaps" inlns
87− SoftBreak -> pushTagged' lua "SoftBreak"
88− Space -> pushTagged' lua "Space"
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
94− x -> push lua (toJSON x)
87+ Cite citations lst -> pushTagged lua "Cite" (citations, lst)
88+ Code attr lst -> pushTagged lua "Code" (attr, lst)
89+ Emph inlns -> pushTagged lua "Emph" inlns
90+ Image attr lst tgt -> pushTagged lua "Image" (attr, lst, tgt)
91+ LineBreak -> pushTagged' lua "LineBreak"
92+ Link attr lst tgt -> pushTagged lua "Link" (attr, lst, tgt)
93+ Note blcks -> pushTagged lua "Note" blcks
94+ Math mty str -> pushTagged lua "Math" (mty, str)
95+ Quoted qt inlns -> pushTagged lua "Quoted" (qt, inlns)
96+ RawInline f cs -> pushTagged lua "RawInline" (f, cs)
97+ SmallCaps inlns -> pushTagged lua "SmallCaps" inlns
98+ SoftBreak -> pushTagged' lua "SoftBreak"
99+ Space -> pushTagged' lua "Space"
100+ Span attr inlns -> pushTagged lua "Span" (attr, inlns)
101+ Str str -> pushTagged lua "Str" str
102+ Strikeout inlns -> pushTagged lua "Strikeout" inlns
103+ Strong inlns -> pushTagged lua "Strong" inlns
104+ Subscript inlns -> pushTagged lua "Subscript" inlns
105+ Superscript inlns -> pushTagged lua "Superscript" inlns
95106 peek = peekInline
96− valuetype _ = Lua.TTABLE
107+ valuetype _ = TTABLE
108+
109+instance StackValue Citation where
110+ push lua c = do
111+ newtable lua
112+ setField lua (-1) "citationId" (citationId c)
113+ setField lua (-1) "citationPrefix" (citationPrefix c)
114+ setField lua (-1) "citationSuffix" (citationSuffix c)
115+ setField lua (-1) "citationMode" (citationMode c)
116+ setField lua (-1) "citationNoteNum" (citationNoteNum c)
117+ setField lua (-1) "citationHash" (citationHash c)
118+ peek lua idx = do
119+ id' <- getField lua idx "citationId"
120+ prefix <- getField lua idx "citationPrefix"
121+ suffix <- getField lua idx "citationSuffix"
122+ mode <- getField lua idx "citationMode"
123+ num <- getField lua idx "citationNoteNum"
124+ hash <- getField lua idx "citationHash"
125+ return $ Citation
126+ <$> id'
127+ <*> prefix
128+ <*> suffix
129+ <*> mode
130+ <*> num
131+ <*> hash
132+ valuetype _ = TTABLE
133+
134+instance StackValue CitationMode where
135+ push lua = \case
136+ AuthorInText -> pushTagged' lua "AuthorInText"
137+ NormalCitation -> pushTagged' lua "NormalCitation"
138+ SuppressAuthor -> pushTagged' lua "SuppressAuthor"
139+ peek lua idx = do
140+ tag <- getField lua idx "t"
141+ case tag of
142+ Just "AuthorInText" -> return $ Just AuthorInText
143+ Just "NormalCitation" -> return $ Just NormalCitation
144+ Just "SuppressAuthor" -> return $ Just SuppressAuthor
145+ _ -> return Nothing
146+ valuetype _ = TSTRING
147+
148+instance StackValue Format where
149+ push lua (Format f) = push lua f
150+ peek lua idx = fmap Format <$> peek lua idx
151+ valuetype _ = TSTRING
152+
153+instance StackValue MathType where
154+ push lua = \case
155+ InlineMath -> pushTagged' lua "InlineMath"
156+ DisplayMath -> pushTagged' lua "DisplayMath"
157+ peek lua idx = do
158+ res <- getField lua idx "t"
159+ case res of
160+ Just "InlineMath" -> return $ Just InlineMath
161+ Just "DisplayMath" -> return $ Just DisplayMath
162+ _ -> return Nothing
163+ valuetype _ = TTABLE
164+
165+instance StackValue QuoteType where
166+ push lua = \case
167+ SingleQuote -> pushTagged' lua "SingleQuote"
168+ DoubleQuote -> pushTagged' lua "DoubleQuote"
169+ peek lua idx = do
170+ res <- getField lua idx "t"
171+ case res of
172+ Just "SingleQuote" -> return $ Just SingleQuote
173+ Just "DoubleQuote" -> return $ Just DoubleQuote
174+ _ -> return Nothing
175+ valuetype _ = TTABLE
97176
98177#if MIN_VERSION_base(4,8,0)
99178instance {-# OVERLAPS #-} StackValue [Char] where
@@ -102,7 +181,33 @@ instance StackValue [Char] where
102181#endif
103182 push lua cs = push lua (UTF8.fromString cs)
104183 peek lua i = fmap UTF8.toString <$> peek lua i
105− valuetype _ = Lua.TSTRING
184+ valuetype _ = TSTRING
185+
186+instance (StackValue a, StackValue b) => StackValue (a, b) where
187+ push lua (a, b) = do
188+ newtable lua
189+ setIntField lua (-1) 1 a
190+ setIntField lua (-1) 2 b
191+ peek lua idx = do
192+ a <- getIntField lua idx 1
193+ b <- getIntField lua idx 2
194+ return $ (,) <$> a <*> b
195+ valuetype _ = TTABLE
196+
197+instance (StackValue a, StackValue b, StackValue c) =>
198+ StackValue (a, b, c)
199+ where
200+ push lua (a, b, c) = do
201+ newtable lua
202+ setIntField lua (-1) 1 a
203+ setIntField lua (-1) 2 b
204+ setIntField lua (-1) 3 c
205+ peek lua idx = do
206+ a <- getIntField lua idx 1
207+ b <- getIntField lua idx 2
208+ c <- getIntField lua idx 3
209+ return $ (,,) <$> a <*> b <*> c
210+ valuetype _ = TTABLE
106211
107212-- | Push a value to the lua stack, tagged with a given string. This currently
108213-- creates a structure equivalent to what the JSONified value would look like
@@ -127,19 +232,28 @@ peekInline lua idx = do
127232 case tag of
128233 Nothing -> return Nothing
129234 Just t -> case t of
235+ "Cite" -> fmap (uncurry Cite) <$> elementContent
236+ "Code" -> fmap (uncurry Code) <$> elementContent
130237 "Emph" -> fmap Emph <$> elementContent
238+ "Image" -> fmap (\(attr, lst, tgt) -> Image attr lst tgt)
239+ <$> elementContent
240+ "Link" -> fmap (\(attr, lst, tgt) -> Link attr lst tgt)
241+ <$> elementContent
131242 "LineBreak" -> return (Just LineBreak)
132243 "Note" -> fmap Note <$> elementContent
244+ "Math" -> fmap (uncurry Math) <$> elementContent
245+ "Quoted" -> fmap (uncurry Quoted) <$> elementContent
246+ "RawInline" -> fmap (uncurry RawInline) <$> elementContent
133247 "SmallCaps" -> fmap SmallCaps <$> elementContent
134248 "SoftBreak" -> return (Just SoftBreak)
135249 "Space" -> return (Just Space)
250+ "Span" -> fmap (uncurry Span) <$> elementContent
136251 "Str" -> fmap Str <$> elementContent
137252 "Strikeout" -> fmap Strikeout <$> elementContent
138253 "Strong" -> fmap Strong <$> elementContent
139254 "Subscript" -> fmap Subscript <$> elementContent
140255 "Superscript"-> fmap Superscript <$> elementContent
141− -- fall back to construction via aeson's Value
142− _ -> maybeFromJson <$> peek lua idx
256+ _ -> return Nothing
143257 where
144258 -- Get the contents of an AST element.
145259 elementContent :: StackValue a => IO (Maybe a)
@@ -178,7 +292,7 @@ adjustIndexBy idx n =
178292getField :: (StackValue a, StackValue b) => LuaState -> Int -> a -> IO (Maybe b)
179293getField lua idx key = do
180294 push lua key
181− rawget lua (idx `adjustIndexBy` 1)
295+ gettable lua (idx `adjustIndexBy` 1)
182296 peek lua (-1) <* pop lua 1
183297
184298-- | Set value for key for table at the given index
@@ -186,4 +300,17 @@ setField :: (StackValue a, StackValue b) => LuaState -> Int -> a -> b -> IO ()
186300setField lua idx key value = do
187301 push lua key
188302 push lua value
189− rawset lua (idx `adjustIndexBy` 2)
303+ settable lua (idx `adjustIndexBy` 2)
304+
305+-- | Get value behind key from table at given index.
306+getIntField :: StackValue a => LuaState -> Int -> Int -> IO (Maybe a)
307+getIntField lua idx key =
308+ rawgeti lua idx key
309+ *> peek lua (-1)
310+ <* pop lua 1
311+
312+-- | Set numeric key/value in table at the given index
313+setIntField :: StackValue a => LuaState -> Int -> Int -> a -> IO ()
314+setIntField lua idx key value = do
315+ push lua value
316+ rawseti lua (idx `adjustIndexBy` 1) key