1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
|
{-
Copyright © 2012-2015 John MacFarlane <jgm@berkeley.edu>
2017 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{- |
Module : Text.Pandoc.Lua.StackInstances
Copyright : © 2012-2016 John MacFarlane
© 2017 Albert Krewinkel
License : GNU GPL, version 2 or above
Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
Stability : alpha
StackValue instances for pandoc types.
-}
module Text.Pandoc.Lua.StackInstances () where
import Control.Applicative ( (<|>) )
import Scripting.Lua
( LTYPE(..), LuaState, StackValue(..), ltype, newtable, objlen )
import Text.Pandoc.Definition
import Text.Pandoc.Lua.SharedInstances ()
import Text.Pandoc.Lua.Util ( addValue, getTable, pushViaConstructor )
import Text.Pandoc.Shared ( safeRead )
instance StackValue Pandoc where
push lua (Pandoc meta blocks) = do
newtable lua
addValue lua "blocks" blocks
addValue lua "meta" meta
peek lua idx = do
blocks <- getTable lua idx "blocks"
meta <- getTable lua idx "meta"
return $ Pandoc <$> meta <*> blocks
valuetype _ = TTABLE
instance StackValue Meta where
push lua (Meta mmap) = push lua mmap
peek lua idx = fmap Meta <$> peek lua idx
valuetype _ = TTABLE
instance StackValue MetaValue where
push = pushMetaValue
peek = peekMetaValue
valuetype = \case
MetaBlocks _ -> TTABLE
MetaBool _ -> TBOOLEAN
MetaInlines _ -> TTABLE
MetaList _ -> TTABLE
MetaMap _ -> TTABLE
MetaString _ -> TSTRING
instance StackValue Block where
push = pushBlock
peek = peekBlock
valuetype _ = TTABLE
instance StackValue Inline where
push = pushInline
peek = peekInline
valuetype _ = TTABLE
instance StackValue Citation where
push lua (Citation cid prefix suffix mode noteNum hash) =
pushViaConstructor lua "Citation" cid mode prefix suffix noteNum hash
peek lua idx = do
id' <- getTable lua idx "citationId"
prefix <- getTable lua idx "citationPrefix"
suffix <- getTable lua idx "citationSuffix"
mode <- getTable lua idx "citationMode"
num <- getTable lua idx "citationNoteNum"
hash <- getTable lua idx "citationHash"
return $ Citation <$> id' <*> prefix <*> suffix <*> mode <*> num <*> hash
valuetype _ = TTABLE
instance StackValue Alignment where
push lua = push lua . show
peek lua idx = (>>= safeRead) <$> peek lua idx
valuetype _ = TSTRING
instance StackValue CitationMode where
push lua = push lua . show
peek lua idx = (>>= safeRead) <$> peek lua idx
valuetype _ = TSTRING
instance StackValue Format where
push lua (Format f) = push lua f
peek lua idx = fmap Format <$> peek lua idx
valuetype _ = TSTRING
instance StackValue ListNumberDelim where
push lua = push lua . show
peek lua idx = (>>= safeRead) <$> peek lua idx
valuetype _ = TSTRING
instance StackValue ListNumberStyle where
push lua = push lua . show
peek lua idx = (>>= safeRead) <$> peek lua idx
valuetype _ = TSTRING
instance StackValue MathType where
push lua = push lua . show
peek lua idx = (>>= safeRead) <$> peek lua idx
valuetype _ = TSTRING
instance StackValue QuoteType where
push lua = push lua . show
peek lua idx = (>>= safeRead) <$> peek lua idx
valuetype _ = TSTRING
-- | Push an meta value element to the top of the lua stack.
pushMetaValue :: LuaState -> MetaValue -> IO ()
pushMetaValue lua = \case
MetaBlocks blcks -> pushViaConstructor lua "MetaBlocks" blcks
MetaBool bool -> push lua bool
MetaInlines inlns -> pushViaConstructor lua "MetaInlines" inlns
MetaList metalist -> pushViaConstructor lua "MetaList" metalist
MetaMap metamap -> pushViaConstructor lua "MetaMap" metamap
MetaString str -> push lua str
-- | Interpret the value at the given stack index as meta value.
peekMetaValue :: LuaState -> Int -> IO (Maybe MetaValue)
peekMetaValue lua idx = do
-- Get the contents of an AST element.
let elementContent :: StackValue a => IO (Maybe a)
elementContent = getTable lua idx "c"
luatype <- ltype lua idx
case luatype of
TBOOLEAN -> fmap MetaBool <$> peek lua idx
TSTRING -> fmap MetaString <$> peek lua idx
TTABLE -> do
tag <- getTable lua idx "t"
case tag of
Just "MetaBlocks" -> fmap MetaBlocks <$> elementContent
Just "MetaBool" -> fmap MetaBool <$> elementContent
Just "MetaMap" -> fmap MetaMap <$> elementContent
Just "MetaInlines" -> fmap MetaInlines <$> elementContent
Just "MetaList" -> fmap MetaList <$> elementContent
Just "MetaString" -> fmap MetaString <$> elementContent
Nothing -> do
-- no meta value tag given, try to guess.
len <- objlen lua idx
if len <= 0
then fmap MetaMap <$> peek lua idx
else (fmap MetaInlines <$> peek lua idx)
<|> (fmap MetaBlocks <$> peek lua idx)
<|> (fmap MetaList <$> peek lua idx)
_ -> return Nothing
_ -> return Nothing
-- | Push an block element to the top of the lua stack.
pushBlock :: LuaState -> Block -> IO ()
pushBlock lua = \case
BlockQuote blcks -> pushViaConstructor lua "BlockQuote" blcks
BulletList items -> pushViaConstructor lua "BulletList" items
CodeBlock attr code -> pushViaConstructor lua "CodeBlock" code (LuaAttr attr)
DefinitionList items -> pushViaConstructor lua "DefinitionList" items
Div attr blcks -> pushViaConstructor lua "Div" blcks (LuaAttr attr)
Header lvl attr inlns -> pushViaConstructor lua "Header" lvl (LuaAttr attr) inlns
HorizontalRule -> pushViaConstructor lua "HorizontalRule"
LineBlock blcks -> pushViaConstructor lua "LineBlock" blcks
OrderedList lstAttr list -> pushViaConstructor lua "OrderedList" list lstAttr
Null -> pushViaConstructor lua "Null"
Para blcks -> pushViaConstructor lua "Para" blcks
Plain blcks -> pushViaConstructor lua "Plain" blcks
RawBlock f cs -> pushViaConstructor lua "RawBlock" f cs
Table capt aligns widths headers rows ->
pushViaConstructor lua "Table" capt aligns widths headers rows
-- | Return the value at the given index as block if possible.
peekBlock :: LuaState -> Int -> IO (Maybe Block)
peekBlock lua idx = do
tag <- getTable lua idx "t"
case tag of
Nothing -> return Nothing
Just t -> case t of
"BlockQuote" -> fmap BlockQuote <$> elementContent
"BulletList" -> fmap BulletList <$> elementContent
"CodeBlock" -> fmap (withAttr CodeBlock) <$> elementContent
"DefinitionList" -> fmap DefinitionList <$> elementContent
"Div" -> fmap (withAttr Div) <$> elementContent
"Header" -> fmap (\(lvl, LuaAttr attr, lst) -> Header lvl attr lst)
<$> elementContent
"HorizontalRule" -> return (Just HorizontalRule)
"LineBlock" -> fmap LineBlock <$> elementContent
"OrderedList" -> fmap (uncurry OrderedList) <$> elementContent
"Null" -> return (Just Null)
"Para" -> fmap Para <$> elementContent
"Plain" -> fmap Plain <$> elementContent
"RawBlock" -> fmap (uncurry RawBlock) <$> elementContent
"Table" -> fmap (\(capt, aligns, widths, headers, body) ->
Table capt aligns widths headers body)
<$> elementContent
_ -> return Nothing
where
-- Get the contents of an AST element.
elementContent :: StackValue a => IO (Maybe a)
elementContent = getTable lua idx "c"
-- | Push an inline element to the top of the lua stack.
pushInline :: LuaState -> Inline -> IO ()
pushInline lua = \case
Cite citations lst -> pushViaConstructor lua "Cite" lst citations
Code attr lst -> pushViaConstructor lua "Code" lst (LuaAttr attr)
Emph inlns -> pushViaConstructor lua "Emph" inlns
Image attr alt (src,tit) -> pushViaConstructor lua "Image" alt src tit (LuaAttr attr)
LineBreak -> pushViaConstructor lua "LineBreak"
Link attr lst (src,tit) -> pushViaConstructor lua "Link" lst src tit (LuaAttr attr)
Note blcks -> pushViaConstructor lua "Note" blcks
Math mty str -> pushViaConstructor lua "Math" mty str
Quoted qt inlns -> pushViaConstructor lua "Quoted" qt inlns
RawInline f cs -> pushViaConstructor lua "RawInline" f cs
SmallCaps inlns -> pushViaConstructor lua "SmallCaps" inlns
SoftBreak -> pushViaConstructor lua "SoftBreak"
Space -> pushViaConstructor lua "Space"
Span attr inlns -> pushViaConstructor lua "Span" inlns (LuaAttr attr)
Str str -> pushViaConstructor lua "Str" str
Strikeout inlns -> pushViaConstructor lua "Strikeout" inlns
Strong inlns -> pushViaConstructor lua "Strong" inlns
Subscript inlns -> pushViaConstructor lua "Subscript" inlns
Superscript inlns -> pushViaConstructor lua "Superscript" inlns
-- | Return the value at the given index as inline if possible.
peekInline :: LuaState -> Int -> IO (Maybe Inline)
peekInline lua idx = do
tag <- getTable lua idx "t"
case tag of
Nothing -> return Nothing
Just t -> case t of
"Cite" -> fmap (uncurry Cite) <$> elementContent
"Code" -> fmap (withAttr Code) <$> elementContent
"Emph" -> fmap Emph <$> elementContent
"Image" -> fmap (\(LuaAttr attr, lst, tgt) -> Image attr lst tgt)
<$> elementContent
"Link" -> fmap (\(LuaAttr attr, lst, tgt) -> Link attr lst tgt)
<$> elementContent
"LineBreak" -> return (Just LineBreak)
"Note" -> fmap Note <$> elementContent
"Math" -> fmap (uncurry Math) <$> elementContent
"Quoted" -> fmap (uncurry Quoted) <$> elementContent
"RawInline" -> fmap (uncurry RawInline) <$> elementContent
"SmallCaps" -> fmap SmallCaps <$> elementContent
"SoftBreak" -> return (Just SoftBreak)
"Space" -> return (Just Space)
"Span" -> fmap (withAttr Span) <$> elementContent
"Str" -> fmap Str <$> elementContent
"Strikeout" -> fmap Strikeout <$> elementContent
"Strong" -> fmap Strong <$> elementContent
"Subscript" -> fmap Subscript <$> elementContent
"Superscript"-> fmap Superscript <$> elementContent
_ -> return Nothing
where
-- Get the contents of an AST element.
elementContent :: StackValue a => IO (Maybe a)
elementContent = getTable lua idx "c"
withAttr :: (Attr -> a -> b) -> (LuaAttr, a) -> b
withAttr f (attributes, x) = f (fromLuaAttr attributes) x
-- | Wrapper for Attr
newtype LuaAttr = LuaAttr { fromLuaAttr :: Attr }
instance StackValue LuaAttr where
push lua (LuaAttr (id', classes, kv)) =
pushViaConstructor lua "Attributes" kv id' classes
peek lua idx = fmap LuaAttr <$> peek lua idx
valuetype _ = TTABLE
|