@@ -50,20 +50,20 @@ TODO : refactor common patterns across readers :
5050
5151
5252module Text.Pandoc.Readers.Textile ( readTextile) where
53−
5453import Text.Pandoc.Definition
54+import Text.Pandoc.Builder (Inlines, Blocks, trimInlines)
5555import qualified Text.Pandoc.Builder as B
56−import Text.Pandoc.Shared
5756import Text.Pandoc.Options
58−import Text.Pandoc.Parsing
57+import Text.Pandoc.Parsing
5958import Text.Pandoc.Readers.HTML ( htmlTag, isInlineTag, isBlockTag )
6059import Text.Pandoc.Readers.LaTeX ( rawLaTeXInline, rawLaTeXBlock )
6160import Text.HTML.TagSoup (parseTags, innerText, fromAttrib, Tag(..))
6261import Text.HTML.TagSoup.Match
6362import Data.List ( intercalate )
64−import Data.Char ( digitToInt, isUpper )
63+import Data.Char ( digitToInt, isUpper)
6564import Control.Monad ( guard, liftM )
6665import Control.Applicative ((<$>), (*>), (<*))
66+import Data.Monoid
6767
6868-- | Parse a Textile text and return a Pandoc document.
6969readTextile :: ReaderOptions -- ^ Reader options
@@ -95,7 +95,7 @@ parseTextile = do
9595 updateState $ \s -> s { stateNotes = reverse reversedNotes }
9696 -- now parse it for real...
9797 blocks <- parseBlocks
98− return $ Pandoc nullMeta blocks -- FIXME
98+ return $ Pandoc nullMeta (B.toList blocks) -- FIXME
9999
100100noteMarker :: Parser [Char] ParserState [Char]
101101noteMarker = skipMany spaceChar >> string "fn" >> manyTill digit (char '.')
@@ -115,11 +115,11 @@ noteBlock = try $ do
115115 return $ replicate (sourceLine endPos - sourceLine startPos) '\n'
116116
117117-- | Parse document blocks
118−parseBlocks :: Parser [Char] ParserState [Block]
119−parseBlocks = manyTill block eof
118+parseBlocks :: Parser [Char] ParserState Blocks
119+parseBlocks = mconcat <$> manyTill block eof
120120
121121-- | Block parsers list tried in definition order
122−blockParsers :: [Parser [Char] ParserState Block]
122+blockParsers :: [Parser [Char] ParserState Blocks]
123123blockParsers = [ codeBlock
124124 , header
125125 , blockQuote
@@ -130,29 +130,32 @@ blockParsers = [ codeBlock
130130 , rawLaTeXBlock'
131131 , maybeExplicitBlock "table" table
132132 , maybeExplicitBlock "p" para
133+ , endBlock
133134 ]
134135
136+endBlock :: Parser [Char] ParserState Blocks
137+endBlock = string "\n\n" >> return mempty
135138-- | Any block in the order of definition of blockParsers
136−block :: Parser [Char] ParserState Block
139+block :: Parser [Char] ParserState Blocks
137140block = choice blockParsers <?> "block"
138141
139−commentBlock :: Parser [Char] ParserState Block
142+commentBlock :: Parser [Char] ParserState Blocks
140143commentBlock = try $ do
141144 string "###."
142145 manyTill anyLine blanklines
143− return Null
146+ return mempty
144147
145−codeBlock :: Parser [Char] ParserState Block
148+codeBlock :: Parser [Char] ParserState Blocks
146149codeBlock = codeBlockBc <|> codeBlockPre
147150
148−codeBlockBc :: Parser [Char] ParserState Block
151+codeBlockBc :: Parser [Char] ParserState Blocks
149152codeBlockBc = try $ do
150153 string "bc. "
151154 contents <- manyTill anyLine blanklines
152− return $ CodeBlock ("",[],[]) $ unlines contents
155+ return $ B.codeBlock (unlines contents)
153156
154157-- | Code Blocks in Textile are between <pre> and </pre>
155−codeBlockPre :: Parser [Char] ParserState Block
158+codeBlockPre :: Parser [Char] ParserState Blocks
156159codeBlockPre = try $ do
157160 (t@(TagOpen _ attrs),_) <- htmlTag (tagOpen (=="pre") (const True))
158161 result' <- (innerText . parseTags) `fmap` -- remove internal tags
@@ -169,29 +172,29 @@ codeBlockPre = try $ do
169172 let classes = words $ fromAttrib "class" t
170173 let ident = fromAttrib "id" t
171174 let kvs = [(k,v) | (k,v) <- attrs, k /= "id" && k /= "class"]
172− return $ CodeBlock (ident,classes,kvs) result'''
175+ return $ B.codeBlockWith (ident,classes,kvs) result'''
173176
174177-- | Header of the form "hN. content" with N in 1..6
175−header :: Parser [Char] ParserState Block
178+header :: Parser [Char] ParserState Blocks
176179header = try $ do
177180 char 'h'
178181 level <- digitToInt <$> oneOf "123456"
179182 attr <- attributes
180183 char '.'
181− whitespace
182− name <- normalizeSpaces <$> manyTill inline blockBreak
183− attr' <- registerHeader attr (B.fromList name)
184− return $ Header level attr' name
184+ lookAhead whitespace
185+ name <- trimInlines . mconcat <$> manyTill inline blockBreak
186+ attr' <- registerHeader attr name
187+ return $ B.headerWith attr' level name
185188
186189-- | Blockquote of the form "bq. content"
187−blockQuote :: Parser [Char] ParserState Block
190+blockQuote :: Parser [Char] ParserState Blocks
188191blockQuote = try $ do
189192 string "bq" >> attributes >> char '.' >> whitespace
190− BlockQuote . singleton <$> para
193+ B.blockQuote <$> para
191194
192195-- Horizontal rule
193196
194−hrule :: Parser [Char] st Block
197+hrule :: Parser [Char] st Blocks
195198hrule = try $ do
196199 skipSpaces
197200 start <- oneOf "-*"
@@ -199,62 +202,62 @@ hrule = try $ do
199202 skipMany (spaceChar <|> char start)
200203 newline
201204 optional blanklines
202− return HorizontalRule
205+ return B.horizontalRule
203206
204207-- Lists handling
205208
206209-- | Can be a bullet list or an ordered list. This implementation is
207210-- strict in the nesting, sublist must start at exactly "parent depth
208211-- plus one"
209−anyList :: Parser [Char] ParserState Block
212+anyList :: Parser [Char] ParserState Blocks
210213anyList = try $ anyListAtDepth 1 <* blanklines
211214
212215-- | This allow one type of list to be nested into an other type,
213216-- provided correct nesting
214−anyListAtDepth :: Int -> Parser [Char] ParserState Block
217+anyListAtDepth :: Int -> Parser [Char] ParserState Blocks
215218anyListAtDepth depth = choice [ bulletListAtDepth depth,
216219 orderedListAtDepth depth,
217220 definitionList ]
218221
219222-- | Bullet List of given depth, depth being the number of leading '*'
220−bulletListAtDepth :: Int -> Parser [Char] ParserState Block
221−bulletListAtDepth depth = try $ BulletList <$> many1 (bulletListItemAtDepth depth)
223+bulletListAtDepth :: Int -> Parser [Char] ParserState Blocks
224+bulletListAtDepth depth = try $ B.bulletList <$> many1 (bulletListItemAtDepth depth)
222225
223226-- | Bullet List Item of given depth, depth being the number of
224227-- leading '*'
225−bulletListItemAtDepth :: Int -> Parser [Char] ParserState [Block]
228+bulletListItemAtDepth :: Int -> Parser [Char] ParserState Blocks
226229bulletListItemAtDepth = genericListItemAtDepth '*'
227230
228231-- | Ordered List of given depth, depth being the number of
229232-- leading '#'
230−orderedListAtDepth :: Int -> Parser [Char] ParserState Block
233+orderedListAtDepth :: Int -> Parser [Char] ParserState Blocks
231234orderedListAtDepth depth = try $ do
232235 items <- many1 (orderedListItemAtDepth depth)
233− return (OrderedList (1, DefaultStyle, DefaultDelim) items)
236+ return $ B.orderedList items
234237
235238-- | Ordered List Item of given depth, depth being the number of
236239-- leading '#'
237−orderedListItemAtDepth :: Int -> Parser [Char] ParserState [Block]
240+orderedListItemAtDepth :: Int -> Parser [Char] ParserState Blocks
238241orderedListItemAtDepth = genericListItemAtDepth '#'
239242
240243-- | Common implementation of list items
241−genericListItemAtDepth :: Char -> Int -> Parser [Char] ParserState [Block]
244+genericListItemAtDepth :: Char -> Int -> Parser [Char] ParserState Blocks
242245genericListItemAtDepth c depth = try $ do
243246 count depth (char c) >> attributes >> whitespace
244− p <- many listInline
247+ p <- mconcat <$> many listInline
245248 newline
246− sublist <- option [] (singleton <$> anyListAtDepth (depth + 1))
247− return (Plain p : sublist)
249+ sublist <- option mempty (anyListAtDepth (depth + 1))
250+ return $ (B.plain p) <> sublist
248251
249252-- | A definition list is a set of consecutive definition items
250−definitionList :: Parser [Char] ParserState Block
251−definitionList = try $ DefinitionList <$> many1 definitionListItem
253+definitionList :: Parser [Char] ParserState Blocks
254+definitionList = try $ B.definitionList <$> many1 definitionListItem
252255
253256-- | List start character.
254257listStart :: Parser [Char] st Char
255258listStart = oneOf "*#-"
256259
257−listInline :: Parser [Char] ParserState Inline
260+listInline :: Parser [Char] ParserState Inlines
258261listInline = try (notFollowedBy newline >> inline)
259262 <|> try (endline <* notFollowedBy listStart)
260263
@@ -262,16 +265,16 @@ listInline = try (notFollowedBy newline >> inline)
262265-- the term defined, then spaces and ":=". The definition follows, on
263266-- the same single line, or spaned on multiple line, after a line
264267-- break.
265−definitionListItem :: Parser [Char] ParserState ([Inline], [[Block]])
268+definitionListItem :: Parser [Char] ParserState (Inlines, [Blocks])
266269definitionListItem = try $ do
267270 string "- "
268− term <- many1Till inline (try (whitespace >> string ":="))
271+ term <- mconcat <$> many1Till inline (try (whitespace >> string ":="))
269272 def' <- multilineDef <|> inlineDef
270273 return (term, def')
271− where inlineDef :: Parser [Char] ParserState [[Block]]
272− inlineDef = liftM (\d -> [[Plain d]])
273− $ optional whitespace >> many listInline <* newline
274− multilineDef :: Parser [Char] ParserState [[Block]]
274+ where inlineDef :: Parser [Char] ParserState [Blocks]
275+ inlineDef = liftM (\d -> [B.plain d])
276+ $ optional whitespace >> (trimInlines . mconcat <$> many listInline) <* newline
277+ multilineDef :: Parser [Char] ParserState [Blocks]
275278 multilineDef = try $ do
276279 optional whitespace >> newline
277280 s <- many1Till anyChar (try (string "=:" >> newline))
@@ -288,59 +291,59 @@ blockBreak = try (newline >> blanklines >> return ()) <|>
288291-- raw content
289292
290293-- | A raw Html Block, optionally followed by blanklines
291−rawHtmlBlock :: Parser [Char] ParserState Block
294+rawHtmlBlock :: Parser [Char] ParserState Blocks
292295rawHtmlBlock = try $ do
293296 (_,b) <- htmlTag isBlockTag
294297 optional blanklines
295− return $ RawBlock (Format "html") b
298+ return $ B.rawBlock "html" b
296299
297300-- | Raw block of LaTeX content
298−rawLaTeXBlock' :: Parser [Char] ParserState Block
301+rawLaTeXBlock' :: Parser [Char] ParserState Blocks
299302rawLaTeXBlock' = do
300303 guardEnabled Ext_raw_tex
301− RawBlock (Format "latex") <$> (rawLaTeXBlock <* spaces)
304+ B.rawBlock "latex" <$> (rawLaTeXBlock <* spaces)
302305
303306
304307-- | In textile, paragraphs are separated by blank lines.
305−para :: Parser [Char] ParserState Block
306−para = try $ Para . normalizeSpaces <$> manyTill inline blockBreak
307−
308+para :: Parser [Char] ParserState Blocks
309+para = do
310+ a <- manyTill inline blockBreak
311+ return $ (B.para . trimInlines . mconcat) a
308312
309313-- Tables
310314
311315-- | A table cell spans until a pipe |
312−tableCell :: Parser [Char] ParserState TableCell
316+tableCell :: Parser [Char] ParserState Blocks
313317tableCell = do
314318 c <- many1 (noneOf "|\n")
315− content <- parseFromString (many1 inline) c
316− return $ [ Plain $ normalizeSpaces content ]
319+ content <- trimInlines . mconcat <$> parseFromString (many1 inline) c
320+ return $ B.plain content
317321
318322-- | A table row is made of many table cells
319−tableRow :: Parser [Char] ParserState [TableCell]
323+tableRow :: Parser [Char] ParserState [Blocks]
320324tableRow = try $ ( char '|' *>
321325 (endBy1 tableCell (optional blankline *> char '|')) <* newline)
322326
323327-- | Many table rows
324−tableRows :: Parser [Char] ParserState [[TableCell]]
328+tableRows :: Parser [Char] ParserState [[Blocks]]
325329tableRows = many1 tableRow
326330
327331-- | Table headers are made of cells separated by a tag "|_."
328−tableHeaders :: Parser [Char] ParserState [TableCell]
332+tableHeaders :: Parser [Char] ParserState [Blocks]
329333tableHeaders = let separator = (try $ string "|_.") in
330334 try $ ( separator *> (sepBy1 tableCell separator) <* char '|' <* newline )
331335
332336-- | A table with an optional header. Current implementation can
333337-- handle tables with and without header, but will parse cells
334338-- alignment attributes as content.
335−table :: Parser [Char] ParserState Block
339+table :: Parser [Char] ParserState Blocks
336340table = try $ do
337− headers <- option [] tableHeaders
341+ headers <- option mempty tableHeaders
338342 rows <- tableRows
339343 blanklines
340344 let nbOfCols = max (length headers) (length $ head rows)
341− return $ Table []
342− (replicate nbOfCols AlignDefault)
343− (replicate nbOfCols 0.0)
345+ return $ B.table mempty
346+ (zip (replicate nbOfCols AlignDefault) (replicate nbOfCols 0.0))
344347 headers
345348 rows
346349
@@ -348,8 +351,8 @@ table = try $ do
348351-- | Blocks like 'p' and 'table' do not need explicit block tag.
349352-- However, they can be used to set HTML/CSS attributes when needed.
350353maybeExplicitBlock :: String -- ^ block tag name
351− -> Parser [Char] ParserState Block -- ^ implicit block
352− -> Parser [Char] ParserState Block
354+ -> Parser [Char] ParserState Blocks -- ^ implicit block
355+ -> Parser [Char] ParserState Blocks
353356maybeExplicitBlock name blk = try $ do
354357 optional $ try $ string name >> attributes >> char '.' >>
355358 optional whitespace >> optional endline
@@ -363,12 +366,14 @@ maybeExplicitBlock name blk = try $ do
363366
364367
365368-- | Any inline element
366−inline :: Parser [Char] ParserState Inline
367−inline = choice inlineParsers <?> "inline"
369+inline :: Parser [Char] ParserState Inlines
370+inline = do
371+ choice inlineParsers <?> "inline"
368372
369373-- | Inline parsers tried in order
370−inlineParsers :: [Parser [Char] ParserState Inline]
371−inlineParsers = [ str
374+inlineParsers :: [Parser [Char] ParserState Inlines]
375+inlineParsers = [ inlineMarkup
376+ , str
372377 , whitespace
373378 , endline
374379 , code
@@ -378,58 +383,57 @@ inlineParsers = [ str
378383 , rawLaTeXInline'
379384 , note
380385 , try $ (char '[' *> inlineMarkup <* char ']')
381− , inlineMarkup
382386 , link
383387 , image
384388 , mark
385− , (Str . (:[])) <$> characterReference
389+ , (B.str . (:[])) <$> characterReference
386390 , smartPunctuation inline
387391 , symbol
388392 ]
389393
390394-- | Inline markups
391−inlineMarkup :: Parser [Char] ParserState Inline
392−inlineMarkup = choice [ simpleInline (string "??") (Cite [])
393− , simpleInline (string "**") Strong
394− , simpleInline (string "__") Emph
395− , simpleInline (char '*') Strong
396− , simpleInline (char '_') Emph
397− , simpleInline (char '+') Emph -- approximates underline
398− , simpleInline (char '-' <* notFollowedBy (char '-')) Strikeout
399− , simpleInline (char '^') Superscript
400− , simpleInline (char '~') Subscript
395+inlineMarkup :: Parser [Char] ParserState Inlines
396+inlineMarkup = choice [ simpleInline (string "??") (B.cite [])
397+ , simpleInline (string "**") B.strong
398+ , simpleInline (string "__") B.emph
399+ , simpleInline (char '*') B.strong
400+ , simpleInline (char '_') B.emph
401+ , simpleInline (char '+') B.emph -- approximates underline
402+ , simpleInline (char '-' <* notFollowedBy (char '-')) B.strikeout
403+ , simpleInline (char '^') B.superscript
404+ , simpleInline (char '~') B.subscript
401405 ]
402406
403407-- | Trademark, registered, copyright
404−mark :: Parser [Char] st Inline
408+mark :: Parser [Char] st Inlines
405409mark = try $ char '(' >> (try tm <|> try reg <|> copy)
406410
407−reg :: Parser [Char] st Inline
411+reg :: Parser [Char] st Inlines
408412reg = do
409413 oneOf "Rr"
410414 char ')'
411− return $ Str "\174"
415+ return $ B.str "\174"
412416
413−tm :: Parser [Char] st Inline
417+tm :: Parser [Char] st Inlines
414418tm = do
415419 oneOf "Tt"
416420 oneOf "Mm"
417421 char ')'
418− return $ Str "\8482"
422+ return $ B.str "\8482"
419423
420−copy :: Parser [Char] st Inline
424+copy :: Parser [Char] st Inlines
421425copy = do
422426 oneOf "Cc"
423427 char ')'
424− return $ Str "\169"
428+ return $ B.str "\169"
425429
426−note :: Parser [Char] ParserState Inline
430+note :: Parser [Char] ParserState Inlines
427431note = try $ do
428432 ref <- (char '[' *> many1 digit <* char ']')
429433 notes <- stateNotes <$> getState
430434 case lookup ref notes of
431435 Nothing -> fail "note not found"
432− Just raw -> liftM Note $ parseFromString parseBlocks raw
436+ Just raw -> B.note <$> parseFromString parseBlocks raw
433437
434438-- | Special chars
435439markupChars :: [Char]
@@ -450,7 +454,7 @@ wordBoundaries = markupChars ++ stringBreakers
450454hyphenedWords :: Parser [Char] ParserState String
451455hyphenedWords = do
452456 x <- wordChunk
453− xs <- many (try $ char '-' >> wordChunk)
457+ xs <- many (try $ char '-' >> wordChunk)
454458 return $ intercalate "-" (x:xs)
455459
456460wordChunk :: Parser [Char] ParserState String
@@ -462,7 +466,7 @@ wordChunk = try $ do
462466 return $ hd:tl
463467
464468-- | Any string
465−str :: Parser [Char] ParserState Inline
469+str :: Parser [Char] ParserState Inlines
466470str = do
467471 baseStr <- hyphenedWords
468472 -- RedCloth compliance : if parsed word is uppercase and immediatly
@@ -472,89 +476,89 @@ str = do
472476 acro <- enclosed (char '(') (char ')') anyChar
473477 return $ concat [baseStr, " (", acro, ")"]
474478 updateLastStrPos
475− return $ Str fullStr
479+ return $ B.str fullStr
476480
477481-- | Textile allows HTML span infos, we discard them
478−htmlSpan :: Parser [Char] ParserState Inline
479−htmlSpan = try $ Str <$> ( char '%' *> attributes *> manyTill anyChar (char '%') )
482+htmlSpan :: Parser [Char] ParserState Inlines
483+htmlSpan = try $ B.str <$> ( char '%' *> attributes *> manyTill anyChar (char '%') )
480484
481485-- | Some number of space chars
482−whitespace :: Parser [Char] ParserState Inline
483−whitespace = many1 spaceChar >> return Space <?> "whitespace"
486+whitespace :: Parser [Char] ParserState Inlines
487+whitespace = many1 spaceChar >> return B.space <?> "whitespace"
484488
485489-- | In Textile, an isolated endline character is a line break
486−endline :: Parser [Char] ParserState Inline
490+endline :: Parser [Char] ParserState Inlines
487491endline = try $ do
488492 newline >> notFollowedBy blankline
489− return LineBreak
493+ return B.linebreak
490494
491−rawHtmlInline :: Parser [Char] ParserState Inline
492−rawHtmlInline = RawInline (Format "html") . snd <$> htmlTag isInlineTag
495+rawHtmlInline :: Parser [Char] ParserState Inlines
496+rawHtmlInline = B.rawInline "html" . snd <$> htmlTag isInlineTag
493497
494498-- | Raw LaTeX Inline
495−rawLaTeXInline' :: Parser [Char] ParserState Inline
499+rawLaTeXInline' :: Parser [Char] ParserState Inlines
496500rawLaTeXInline' = try $ do
497501 guardEnabled Ext_raw_tex
498− rawLaTeXInline
502+ B.singleton <$> rawLaTeXInline
499503
500504-- | Textile standard link syntax is "label":target. But we
501505-- can also have ["label":target].
502−link :: Parser [Char] ParserState Inline
506+link :: Parser [Char] ParserState Inlines
503507link = linkB <|> linkNoB
504508
505−linkNoB :: Parser [Char] ParserState Inline
509+linkNoB :: Parser [Char] ParserState Inlines
506510linkNoB = try $ do
507− name <- surrounded (char '"') inline
511+ name <- mconcat <$> surrounded (char '"') (withQuoteContext InDoubleQuote inline)
508512 char ':'
509513 let stopChars = "!.,;:"
510514 url <- manyTill nonspaceChar (lookAhead $ space <|> try (oneOf stopChars >> (space <|> newline)))
511− let name' = if name == [Str "$"] then [Str url] else name
512− return $ Link name' (url, "")
515+ let name' = if B.toList name == [Str "$"] then B.str url else name
516+ return $ B.link url "" name'
513517
514−linkB :: Parser [Char] ParserState Inline
518+linkB :: Parser [Char] ParserState Inlines
515519linkB = try $ do
516520 char '['
517− name <- surrounded (char '"') inline
521+ name <- mconcat <$> surrounded (char '"') inline
518522 char ':'
519523 url <- manyTill nonspaceChar (char ']')
520− let name' = if name == [Str "$"] then [Str url] else name
521− return $ Link name' (url, "")
524+ let name' = if B.toList name == [Str "$"] then B.str url else name
525+ return $ B.link url "" name'
522526
523527-- | image embedding
524−image :: Parser [Char] ParserState Inline
528+image :: Parser [Char] ParserState Inlines
525529image = try $ do
526530 char '!' >> notFollowedBy space
527531 src <- manyTill anyChar (lookAhead $ oneOf "!(")
528532 alt <- option "" (try $ (char '(' >> manyTill anyChar (char ')')))
529533 char '!'
530− return $ Image [Str alt] (src, alt)
534+ return $ B.image src alt (B.str alt)
531535
532−escapedInline :: Parser [Char] ParserState Inline
536+escapedInline :: Parser [Char] ParserState Inlines
533537escapedInline = escapedEqs <|> escapedTag
534538
535−escapedEqs :: Parser [Char] ParserState Inline
536−escapedEqs = Str <$> (try $ string "==" *> manyTill anyChar (try $ string "=="))
539+escapedEqs :: Parser [Char] ParserState Inlines
540+escapedEqs = B.str <$> (try $ string "==" *> manyTill anyChar (try $ string "=="))
537541
538542-- | literal text escaped btw <notextile> tags
539−escapedTag :: Parser [Char] ParserState Inline
540−escapedTag = Str <$>
543+escapedTag :: Parser [Char] ParserState Inlines
544+escapedTag = B.str <$>
541545 (try $ string "<notextile>" *> manyTill anyChar (try $ string "</notextile>"))
542546
543547-- | Any special symbol defined in wordBoundaries
544−symbol :: Parser [Char] ParserState Inline
545−symbol = Str . singleton <$> (oneOf wordBoundaries <|> oneOf markupChars)
548+symbol :: Parser [Char] ParserState Inlines
549+symbol = B.str . singleton <$> (oneOf wordBoundaries <|> oneOf markupChars)
546550
547551-- | Inline code
548−code :: Parser [Char] ParserState Inline
552+code :: Parser [Char] ParserState Inlines
549553code = code1 <|> code2
550554
551−code1 :: Parser [Char] ParserState Inline
552−code1 = Code nullAttr <$> surrounded (char '@') anyChar
555+code1 :: Parser [Char] ParserState Inlines
556+code1 = B.code <$> surrounded (char '@') anyChar
553557
554−code2 :: Parser [Char] ParserState Inline
558+code2 :: Parser [Char] ParserState Inlines
555559code2 = do
556560 htmlTag (tagOpen (=="tt") null)
557− Code nullAttr <$> manyTill anyChar (try $ htmlTag $ tagClose (=="tt"))
561+ B.code <$> manyTill anyChar (try $ htmlTag $ tagClose (=="tt"))
558562
559563-- | Html / CSS attributes
560564attributes :: Parser [Char] ParserState Attr
@@ -581,7 +585,7 @@ styleAttr = do
581585
582586langAttr :: Parser [Char] ParserState (Attr -> Attr)
583587langAttr = do
584− lang <- try $ enclosed (char '[') (char ']') anyChar
588+ lang <- try $ enclosed (char '[') (char ']') alphaNum
585589 return $ \(id',classes,keyvals) -> (id',classes,("lang",lang):keyvals)
586590
587591-- | Parses material surrounded by a parser.
@@ -590,14 +594,43 @@ surrounded :: Parser [Char] st t -- ^ surrounding parser
590594 -> Parser [Char] st [a]
591595surrounded border = enclosed (border *> notFollowedBy (oneOf " \t\n\r")) (try border)
592596
593−-- | Inlines are most of the time of the same form
597+
594598simpleInline :: Parser [Char] ParserState t -- ^ surrounding parser
595− -> ([Inline] -> Inline) -- ^ Inline constructor
596− -> Parser [Char] ParserState Inline -- ^ content parser (to be used repeatedly)
597−simpleInline border construct = surrounded border inlineWithAttribute >>=
598− return . construct . normalizeSpaces
599− where inlineWithAttribute = (try $ optional attributes) >> inline
599+ -> (Inlines -> Inlines) -- ^ Inline constructor
600+ -> Parser [Char] ParserState Inlines -- ^ content parser (to be used repeatedly)
601+simpleInline border construct = groupedSimpleInline border construct <|> ungroupedSimpleInline border construct
602+
603+ungroupedSimpleInline :: Parser [Char] ParserState t -- ^ surrounding parser
604+ -> (Inlines -> Inlines) -- ^ Inline constructor
605+ -> Parser [Char] ParserState Inlines -- ^ content parser (to be used repeatedly)
606+ungroupedSimpleInline border construct = try $ do
607+ st <- getState
608+ pos <- getPosition
609+ isWhitespace <- option False (whitespace >> return True)
610+ guard $ (stateQuoteContext st /= NoQuote)
611+ || (sourceColumn pos == 1)
612+ || isWhitespace
613+ body <- surrounded border inlineWithAttribute
614+ lookAhead (notFollowedBy alphaNum)
615+ let result = construct $ mconcat body
616+ return $ if isWhitespace then B.space <> result
617+ else result
618+ where
619+ inlineWithAttribute = (try $ optional attributes) >> notFollowedBy (string "\n\n")
620+ >> (withQuoteContext InSingleQuote inline)
621+
622+
623+groupedSimpleInline :: Parser [Char] ParserState t
624+ -> (Inlines -> Inlines)
625+ -> Parser [Char] ParserState Inlines
626+groupedSimpleInline border construct = try $ do
627+ char '['
628+ withQuoteContext InSingleQuote (simpleInline border construct) >>~ char ']'
629+
630+
631+
600632
601633-- | Create a singleton list
602634singleton :: a -> [a]
603635singleton x = [x]
636+