@@ -50,20 +50,20 @@ TODO : refactor common patterns across readers :
52module Text.Pandoc.Readers.Textile ( readTextile) where
52module Text.Pandoc.Readers.Textile ( readTextile) where
54import Text.Pandoc.Definition
53import Text.Pandoc.Definition
54+import Text.Pandoc.Builder (Inlines, Blocks, trimInlines)
55import qualified Text.Pandoc.Builder as B
55import qualified Text.Pandoc.Builder as B
56−import Text.Pandoc.Shared
57import Text.Pandoc.Options
56import Text.Pandoc.Options
58−import Text.Pandoc.Parsing
57+import Text.Pandoc.Parsing
59import Text.Pandoc.Readers.HTML ( htmlTag, isInlineTag, isBlockTag )
58import Text.Pandoc.Readers.HTML ( htmlTag, isInlineTag, isBlockTag )
60import Text.Pandoc.Readers.LaTeX ( rawLaTeXInline, rawLaTeXBlock )
59import Text.Pandoc.Readers.LaTeX ( rawLaTeXInline, rawLaTeXBlock )
61import Text.HTML.TagSoup (parseTags, innerText, fromAttrib, Tag(..))
60import Text.HTML.TagSoup (parseTags, innerText, fromAttrib, Tag(..))
62import Text.HTML.TagSoup.Match
61import Text.HTML.TagSoup.Match
63import Data.List ( intercalate )
62import Data.List ( intercalate )
64−import Data.Char ( digitToInt, isUpper )
63+import Data.Char ( digitToInt, isUpper)
65import Control.Monad ( guard, liftM )
64import Control.Monad ( guard, liftM )
66import Control.Applicative ((<$>), (*>), (<*))
65import Control.Applicative ((<$>), (*>), (<*))
68-- | Parse a Textile text and return a Pandoc document.
68-- | Parse a Textile text and return a Pandoc document.
69readTextile :: ReaderOptions -- ^ Reader options
69readTextile :: ReaderOptions -- ^ Reader options
@@ -95,7 +95,7 @@ parseTextile = do
95 updateState $ \s -> s { stateNotes = reverse reversedNotes }
95 updateState $ \s -> s { stateNotes = reverse reversedNotes }
96 -- now parse it for real...
96 -- now parse it for real...
97 blocks <- parseBlocks
97 blocks <- parseBlocks
98− return $ Pandoc nullMeta blocks -- FIXME
98+ return $ Pandoc nullMeta (B.toList blocks) -- FIXME
100noteMarker :: Parser [Char] ParserState [Char]
100noteMarker :: Parser [Char] ParserState [Char]
101noteMarker = skipMany spaceChar >> string "fn" >> manyTill digit (char '.')
101noteMarker = skipMany spaceChar >> string "fn" >> manyTill digit (char '.')
@@ -115,11 +115,11 @@ noteBlock = try $ do
115 return $ replicate (sourceLine endPos - sourceLine startPos) '\n'
115 return $ replicate (sourceLine endPos - sourceLine startPos) '\n'
117-- | Parse document blocks
117-- | Parse document blocks
118−parseBlocks :: Parser [Char] ParserState [Block]
118+parseBlocks :: Parser [Char] ParserState Blocks
119−parseBlocks = manyTill block eof
119+parseBlocks = mconcat <$> manyTill block eof
121-- | Block parsers list tried in definition order
121-- | Block parsers list tried in definition order
122−blockParsers :: [Parser [Char] ParserState Block]
122+blockParsers :: [Parser [Char] ParserState Blocks]
123blockParsers = [ codeBlock
123blockParsers = [ codeBlock
125 , blockQuote
125 , blockQuote
@@ -130,29 +130,32 @@ blockParsers = [ codeBlock
130 , rawLaTeXBlock'
130 , rawLaTeXBlock'
131 , maybeExplicitBlock "table" table
131 , maybeExplicitBlock "table" table
132 , maybeExplicitBlock "p" para
132 , maybeExplicitBlock "p" para
136+endBlock :: Parser [Char] ParserState Blocks
137+endBlock = string "\n\n" >> return mempty
135-- | Any block in the order of definition of blockParsers
138-- | Any block in the order of definition of blockParsers
136−block :: Parser [Char] ParserState Block
139+block :: Parser [Char] ParserState Blocks
137block = choice blockParsers <?> "block"
140block = choice blockParsers <?> "block"
139−commentBlock :: Parser [Char] ParserState Block
142+commentBlock :: Parser [Char] ParserState Blocks
140commentBlock = try $ do
143commentBlock = try $ do
141 string "###."
144 string "###."
142 manyTill anyLine blanklines
145 manyTill anyLine blanklines
143− return Null
146+ return mempty
145−codeBlock :: Parser [Char] ParserState Block
148+codeBlock :: Parser [Char] ParserState Blocks
146codeBlock = codeBlockBc <|> codeBlockPre
149codeBlock = codeBlockBc <|> codeBlockPre
148−codeBlockBc :: Parser [Char] ParserState Block
151+codeBlockBc :: Parser [Char] ParserState Blocks
149codeBlockBc = try $ do
152codeBlockBc = try $ do
150 string "bc. "
153 string "bc. "
151 contents <- manyTill anyLine blanklines
154 contents <- manyTill anyLine blanklines
152− return $ CodeBlock ("",[],[]) $ unlines contents
155+ return $ B.codeBlock (unlines contents)
154-- | Code Blocks in Textile are between <pre> and </pre>
157-- | Code Blocks in Textile are between <pre> and </pre>
155−codeBlockPre :: Parser [Char] ParserState Block
158+codeBlockPre :: Parser [Char] ParserState Blocks
156codeBlockPre = try $ do
159codeBlockPre = try $ do
157 (t@(TagOpen _ attrs),_) <- htmlTag (tagOpen (=="pre") (const True))
160 (t@(TagOpen _ attrs),_) <- htmlTag (tagOpen (=="pre") (const True))
158 result' <- (innerText . parseTags) `fmap` -- remove internal tags
161 result' <- (innerText . parseTags) `fmap` -- remove internal tags
@@ -169,29 +172,29 @@ codeBlockPre = try $ do
169 let classes = words $ fromAttrib "class" t
172 let classes = words $ fromAttrib "class" t
170 let ident = fromAttrib "id" t
173 let ident = fromAttrib "id" t
171 let kvs = [(k,v) | (k,v) <- attrs, k /= "id" && k /= "class"]
174 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'''
174-- | Header of the form "hN. content" with N in 1..6
177-- | Header of the form "hN. content" with N in 1..6
175−header :: Parser [Char] ParserState Block
178+header :: Parser [Char] ParserState Blocks
176header = try $ do
179header = try $ do
178 level <- digitToInt <$> oneOf "123456"
181 level <- digitToInt <$> oneOf "123456"
179 attr <- attributes
182 attr <- attributes
181− whitespace
184+ lookAhead whitespace
182− name <- normalizeSpaces <$> manyTill inline blockBreak
185+ name <- trimInlines . mconcat <$> manyTill inline blockBreak
183− attr' <- registerHeader attr (B.fromList name)
186+ attr' <- registerHeader attr name
184− return $ Header level attr' name
187+ return $ B.headerWith attr' level name
186-- | Blockquote of the form "bq. content"
189-- | Blockquote of the form "bq. content"
187−blockQuote :: Parser [Char] ParserState Block
190+blockQuote :: Parser [Char] ParserState Blocks
188blockQuote = try $ do
191blockQuote = try $ do
189 string "bq" >> attributes >> char '.' >> whitespace
192 string "bq" >> attributes >> char '.' >> whitespace
190− BlockQuote . singleton <$> para
193+ B.blockQuote <$> para
192-- Horizontal rule
195-- Horizontal rule
194−hrule :: Parser [Char] st Block
197+hrule :: Parser [Char] st Blocks
195hrule = try $ do
198hrule = try $ do
196 skipSpaces
199 skipSpaces
197 start <- oneOf "-*"
200 start <- oneOf "-*"
@@ -199,62 +202,62 @@ hrule = try $ do
199 skipMany (spaceChar <|> char start)
202 skipMany (spaceChar <|> char start)
201 optional blanklines
204 optional blanklines
202− return HorizontalRule
205+ return B.horizontalRule
204-- Lists handling
207-- Lists handling
206-- | Can be a bullet list or an ordered list. This implementation is
209-- | Can be a bullet list or an ordered list. This implementation is
207-- strict in the nesting, sublist must start at exactly "parent depth
210-- strict in the nesting, sublist must start at exactly "parent depth
208-- plus one"
211-- plus one"
209−anyList :: Parser [Char] ParserState Block
212+anyList :: Parser [Char] ParserState Blocks
210anyList = try $ anyListAtDepth 1 <* blanklines
213anyList = try $ anyListAtDepth 1 <* blanklines
212-- | This allow one type of list to be nested into an other type,
215-- | This allow one type of list to be nested into an other type,
213-- provided correct nesting
216-- provided correct nesting
214−anyListAtDepth :: Int -> Parser [Char] ParserState Block
217+anyListAtDepth :: Int -> Parser [Char] ParserState Blocks
215anyListAtDepth depth = choice [ bulletListAtDepth depth,
218anyListAtDepth depth = choice [ bulletListAtDepth depth,
216 orderedListAtDepth depth,
219 orderedListAtDepth depth,
217 definitionList ]
220 definitionList ]
219-- | Bullet List of given depth, depth being the number of leading '*'
222-- | Bullet List of given depth, depth being the number of leading '*'
220−bulletListAtDepth :: Int -> Parser [Char] ParserState Block
223+bulletListAtDepth :: Int -> Parser [Char] ParserState Blocks
221−bulletListAtDepth depth = try $ BulletList <$> many1 (bulletListItemAtDepth depth)
224+bulletListAtDepth depth = try $ B.bulletList <$> many1 (bulletListItemAtDepth depth)
223-- | Bullet List Item of given depth, depth being the number of
226-- | Bullet List Item of given depth, depth being the number of
224-- leading '*'
227-- leading '*'
225−bulletListItemAtDepth :: Int -> Parser [Char] ParserState [Block]
228+bulletListItemAtDepth :: Int -> Parser [Char] ParserState Blocks
226bulletListItemAtDepth = genericListItemAtDepth '*'
229bulletListItemAtDepth = genericListItemAtDepth '*'
228-- | Ordered List of given depth, depth being the number of
231-- | Ordered List of given depth, depth being the number of
229-- leading '#'
232-- leading '#'
230−orderedListAtDepth :: Int -> Parser [Char] ParserState Block
233+orderedListAtDepth :: Int -> Parser [Char] ParserState Blocks
231orderedListAtDepth depth = try $ do
234orderedListAtDepth depth = try $ do
232 items <- many1 (orderedListItemAtDepth depth)
235 items <- many1 (orderedListItemAtDepth depth)
233− return (OrderedList (1, DefaultStyle, DefaultDelim) items)
236+ return $ B.orderedList items
235-- | Ordered List Item of given depth, depth being the number of
238-- | Ordered List Item of given depth, depth being the number of
236-- leading '#'
239-- leading '#'
237−orderedListItemAtDepth :: Int -> Parser [Char] ParserState [Block]
240+orderedListItemAtDepth :: Int -> Parser [Char] ParserState Blocks
238orderedListItemAtDepth = genericListItemAtDepth '#'
241orderedListItemAtDepth = genericListItemAtDepth '#'
240-- | Common implementation of list items
243-- | Common implementation of list items
241−genericListItemAtDepth :: Char -> Int -> Parser [Char] ParserState [Block]
244+genericListItemAtDepth :: Char -> Int -> Parser [Char] ParserState Blocks
242genericListItemAtDepth c depth = try $ do
245genericListItemAtDepth c depth = try $ do
243 count depth (char c) >> attributes >> whitespace
246 count depth (char c) >> attributes >> whitespace
244− p <- many listInline
247+ p <- mconcat <$> many listInline
246− sublist <- option [] (singleton <$> anyListAtDepth (depth + 1))
249+ sublist <- option mempty (anyListAtDepth (depth + 1))
247− return (Plain p : sublist)
250+ return $ (B.plain p) <> sublist
249-- | A definition list is a set of consecutive definition items
252-- | A definition list is a set of consecutive definition items
250−definitionList :: Parser [Char] ParserState Block
253+definitionList :: Parser [Char] ParserState Blocks
251−definitionList = try $ DefinitionList <$> many1 definitionListItem
254+definitionList = try $ B.definitionList <$> many1 definitionListItem
253-- | List start character.
256-- | List start character.
254listStart :: Parser [Char] st Char
257listStart :: Parser [Char] st Char
255listStart = oneOf "*#-"
258listStart = oneOf "*#-"
257−listInline :: Parser [Char] ParserState Inline
260+listInline :: Parser [Char] ParserState Inlines
258listInline = try (notFollowedBy newline >> inline)
261listInline = try (notFollowedBy newline >> inline)
259 <|> try (endline <* notFollowedBy listStart)
262 <|> try (endline <* notFollowedBy listStart)
@@ -262,16 +265,16 @@ listInline = try (notFollowedBy newline >> inline)
262-- the term defined, then spaces and ":=". The definition follows, on
265-- the term defined, then spaces and ":=". The definition follows, on
263-- the same single line, or spaned on multiple line, after a line
266-- the same single line, or spaned on multiple line, after a line
265−definitionListItem :: Parser [Char] ParserState ([Inline], [[Block]])
268+definitionListItem :: Parser [Char] ParserState (Inlines, [Blocks])
266definitionListItem = try $ do
269definitionListItem = try $ do
267 string "- "
270 string "- "
268− term <- many1Till inline (try (whitespace >> string ":="))
271+ term <- mconcat <$> many1Till inline (try (whitespace >> string ":="))
269 def' <- multilineDef <|> inlineDef
272 def' <- multilineDef <|> inlineDef
270 return (term, def')
273 return (term, def')
271− where inlineDef :: Parser [Char] ParserState [[Block]]
274+ where inlineDef :: Parser [Char] ParserState [Blocks]
272− inlineDef = liftM (\d -> [[Plain d]])
275+ inlineDef = liftM (\d -> [B.plain d])
273− $ optional whitespace >> many listInline <* newline
276+ $ optional whitespace >> (trimInlines . mconcat <$> many listInline) <* newline
274− multilineDef :: Parser [Char] ParserState [[Block]]
277+ multilineDef :: Parser [Char] ParserState [Blocks]
275 multilineDef = try $ do
278 multilineDef = try $ do
276 optional whitespace >> newline
279 optional whitespace >> newline
277 s <- many1Till anyChar (try (string "=:" >> newline))
280 s <- many1Till anyChar (try (string "=:" >> newline))
@@ -288,59 +291,59 @@ blockBreak = try (newline >> blanklines >> return ()) <|>
288-- raw content
291-- raw content
290-- | A raw Html Block, optionally followed by blanklines
293-- | A raw Html Block, optionally followed by blanklines
291−rawHtmlBlock :: Parser [Char] ParserState Block
294+rawHtmlBlock :: Parser [Char] ParserState Blocks
292rawHtmlBlock = try $ do
295rawHtmlBlock = try $ do
293 (_,b) <- htmlTag isBlockTag
296 (_,b) <- htmlTag isBlockTag
294 optional blanklines
297 optional blanklines
295− return $ RawBlock (Format "html") b
298+ return $ B.rawBlock "html" b
297-- | Raw block of LaTeX content
300-- | Raw block of LaTeX content
298−rawLaTeXBlock' :: Parser [Char] ParserState Block
301+rawLaTeXBlock' :: Parser [Char] ParserState Blocks
299rawLaTeXBlock' = do
302rawLaTeXBlock' = do
300 guardEnabled Ext_raw_tex
303 guardEnabled Ext_raw_tex
301− RawBlock (Format "latex") <$> (rawLaTeXBlock <* spaces)
304+ B.rawBlock "latex" <$> (rawLaTeXBlock <* spaces)
304-- | In textile, paragraphs are separated by blank lines.
307-- | In textile, paragraphs are separated by blank lines.
305−para :: Parser [Char] ParserState Block
308+para :: Parser [Char] ParserState Blocks
306−para = try $ Para . normalizeSpaces <$> manyTill inline blockBreak
310+ a <- manyTill inline blockBreak
307−
311+ return $ (B.para . trimInlines . mconcat) a
311-- | A table cell spans until a pipe |
315-- | A table cell spans until a pipe |
312−tableCell :: Parser [Char] ParserState TableCell
316+tableCell :: Parser [Char] ParserState Blocks
313tableCell = do
317tableCell = do
314 c <- many1 (noneOf "|\n")
318 c <- many1 (noneOf "|\n")
315− content <- parseFromString (many1 inline) c
319+ content <- trimInlines . mconcat <$> parseFromString (many1 inline) c
316− return $ [ Plain $ normalizeSpaces content ]
320+ return $ B.plain content
318-- | A table row is made of many table cells
322-- | A table row is made of many table cells
319−tableRow :: Parser [Char] ParserState [TableCell]
323+tableRow :: Parser [Char] ParserState [Blocks]
320tableRow = try $ ( char '|' *>
324tableRow = try $ ( char '|' *>
321 (endBy1 tableCell (optional blankline *> char '|')) <* newline)
325 (endBy1 tableCell (optional blankline *> char '|')) <* newline)
323-- | Many table rows
327-- | Many table rows
324−tableRows :: Parser [Char] ParserState [[TableCell]]
328+tableRows :: Parser [Char] ParserState [[Blocks]]
325tableRows = many1 tableRow
329tableRows = many1 tableRow
327-- | Table headers are made of cells separated by a tag "|_."
331-- | Table headers are made of cells separated by a tag "|_."
328−tableHeaders :: Parser [Char] ParserState [TableCell]
332+tableHeaders :: Parser [Char] ParserState [Blocks]
329tableHeaders = let separator = (try $ string "|_.") in
333tableHeaders = let separator = (try $ string "|_.") in
330 try $ ( separator *> (sepBy1 tableCell separator) <* char '|' <* newline )
334 try $ ( separator *> (sepBy1 tableCell separator) <* char '|' <* newline )
332-- | A table with an optional header. Current implementation can
336-- | A table with an optional header. Current implementation can
333-- handle tables with and without header, but will parse cells
337-- handle tables with and without header, but will parse cells
334-- alignment attributes as content.
338-- alignment attributes as content.
335−table :: Parser [Char] ParserState Block
339+table :: Parser [Char] ParserState Blocks
336table = try $ do
340table = try $ do
337− headers <- option [] tableHeaders
341+ headers <- option mempty tableHeaders
338 rows <- tableRows
342 rows <- tableRows
339 blanklines
343 blanklines
340 let nbOfCols = max (length headers) (length $ head rows)
344 let nbOfCols = max (length headers) (length $ head rows)
341− return $ Table []
345+ return $ B.table mempty
342− (replicate nbOfCols AlignDefault)
346+ (zip (replicate nbOfCols AlignDefault) (replicate nbOfCols 0.0))
343− (replicate nbOfCols 0.0)
@@ -348,8 +351,8 @@ table = try $ do
348-- | Blocks like 'p' and 'table' do not need explicit block tag.
351-- | Blocks like 'p' and 'table' do not need explicit block tag.
349-- However, they can be used to set HTML/CSS attributes when needed.
352-- However, they can be used to set HTML/CSS attributes when needed.
350maybeExplicitBlock :: String -- ^ block tag name
353maybeExplicitBlock :: String -- ^ block tag name
351− -> Parser [Char] ParserState Block -- ^ implicit block
354+ -> Parser [Char] ParserState Blocks -- ^ implicit block
352− -> Parser [Char] ParserState Block
355+ -> Parser [Char] ParserState Blocks
353maybeExplicitBlock name blk = try $ do
356maybeExplicitBlock name blk = try $ do
354 optional $ try $ string name >> attributes >> char '.' >>
357 optional $ try $ string name >> attributes >> char '.' >>
355 optional whitespace >> optional endline
358 optional whitespace >> optional endline
@@ -363,12 +366,14 @@ maybeExplicitBlock name blk = try $ do
365-- | Any inline element
368-- | Any inline element
366−inline :: Parser [Char] ParserState Inline
369+inline :: Parser [Char] ParserState Inlines
367−inline = choice inlineParsers <?> "inline"
371+ choice inlineParsers <?> "inline"
369-- | Inline parsers tried in order
373-- | Inline parsers tried in order
370−inlineParsers :: [Parser [Char] ParserState Inline]
374+inlineParsers :: [Parser [Char] ParserState Inlines]
371−inlineParsers = [ str
375+inlineParsers = [ inlineMarkup
372 , whitespace
377 , whitespace
373 , endline
378 , endline
@@ -378,58 +383,57 @@ inlineParsers = [ str
378 , rawLaTeXInline'
383 , rawLaTeXInline'
380 , try $ (char '[' *> inlineMarkup <* char ']')
385 , try $ (char '[' *> inlineMarkup <* char ']')
385− , (Str . (:[])) <$> characterReference
389+ , (B.str . (:[])) <$> characterReference
386 , smartPunctuation inline
390 , smartPunctuation inline
390-- | Inline markups
394-- | Inline markups
391−inlineMarkup :: Parser [Char] ParserState Inline
395+inlineMarkup :: Parser [Char] ParserState Inlines
392−inlineMarkup = choice [ simpleInline (string "??") (Cite [])
396+inlineMarkup = choice [ simpleInline (string "??") (B.cite [])
393− , simpleInline (string "**") Strong
397+ , simpleInline (string "**") B.strong
394− , simpleInline (string "__") Emph
398+ , simpleInline (string "__") B.emph
395− , simpleInline (char '*') Strong
399+ , simpleInline (char '*') B.strong
396− , simpleInline (char '_') Emph
400+ , simpleInline (char '_') B.emph
397− , simpleInline (char '+') Emph -- approximates underline
401+ , simpleInline (char '+') B.emph -- approximates underline
398− , simpleInline (char '-' <* notFollowedBy (char '-')) Strikeout
402+ , simpleInline (char '-' <* notFollowedBy (char '-')) B.strikeout
399− , simpleInline (char '^') Superscript
403+ , simpleInline (char '^') B.superscript
400− , simpleInline (char '~') Subscript
404+ , simpleInline (char '~') B.subscript
403-- | Trademark, registered, copyright
407-- | Trademark, registered, copyright
404−mark :: Parser [Char] st Inline
408+mark :: Parser [Char] st Inlines
405mark = try $ char '(' >> (try tm <|> try reg <|> copy)
409mark = try $ char '(' >> (try tm <|> try reg <|> copy)
407−reg :: Parser [Char] st Inline
411+reg :: Parser [Char] st Inlines
409 oneOf "Rr"
413 oneOf "Rr"
411− return $ Str "\174"
415+ return $ B.str "\174"
413−tm :: Parser [Char] st Inline
417+tm :: Parser [Char] st Inlines
415 oneOf "Tt"
419 oneOf "Tt"
416 oneOf "Mm"
420 oneOf "Mm"
418− return $ Str "\8482"
422+ return $ B.str "\8482"
420−copy :: Parser [Char] st Inline
424+copy :: Parser [Char] st Inlines
422 oneOf "Cc"
426 oneOf "Cc"
424− return $ Str "\169"
428+ return $ B.str "\169"
426−note :: Parser [Char] ParserState Inline
430+note :: Parser [Char] ParserState Inlines
427note = try $ do
431note = try $ do
428 ref <- (char '[' *> many1 digit <* char ']')
432 ref <- (char '[' *> many1 digit <* char ']')
429 notes <- stateNotes <$> getState
433 notes <- stateNotes <$> getState
430 case lookup ref notes of
434 case lookup ref notes of
431 Nothing -> fail "note not found"
435 Nothing -> fail "note not found"
432− Just raw -> liftM Note $ parseFromString parseBlocks raw
436+ Just raw -> B.note <$> parseFromString parseBlocks raw
434-- | Special chars
438-- | Special chars
435markupChars :: [Char]
439markupChars :: [Char]
@@ -450,7 +454,7 @@ wordBoundaries = markupChars ++ stringBreakers
450hyphenedWords :: Parser [Char] ParserState String
454hyphenedWords :: Parser [Char] ParserState String
451hyphenedWords = do
455hyphenedWords = do
452 x <- wordChunk
456 x <- wordChunk
453− xs <- many (try $ char '-' >> wordChunk)
457+ xs <- many (try $ char '-' >> wordChunk)
454 return $ intercalate "-" (x:xs)
458 return $ intercalate "-" (x:xs)
456wordChunk :: Parser [Char] ParserState String
460wordChunk :: Parser [Char] ParserState String
@@ -462,7 +466,7 @@ wordChunk = try $ do
462 return $ hd:tl
466 return $ hd:tl
464-- | Any string
468-- | Any string
465−str :: Parser [Char] ParserState Inline
469+str :: Parser [Char] ParserState Inlines
467 baseStr <- hyphenedWords
471 baseStr <- hyphenedWords
468 -- RedCloth compliance : if parsed word is uppercase and immediatly
472 -- RedCloth compliance : if parsed word is uppercase and immediatly
@@ -472,89 +476,89 @@ str = do
472 acro <- enclosed (char '(') (char ')') anyChar
476 acro <- enclosed (char '(') (char ')') anyChar
473 return $ concat [baseStr, " (", acro, ")"]
477 return $ concat [baseStr, " (", acro, ")"]
474 updateLastStrPos
478 updateLastStrPos
475− return $ Str fullStr
479+ return $ B.str fullStr
477-- | Textile allows HTML span infos, we discard them
481-- | Textile allows HTML span infos, we discard them
478−htmlSpan :: Parser [Char] ParserState Inline
482+htmlSpan :: Parser [Char] ParserState Inlines
479−htmlSpan = try $ Str <$> ( char '%' *> attributes *> manyTill anyChar (char '%') )
483+htmlSpan = try $ B.str <$> ( char '%' *> attributes *> manyTill anyChar (char '%') )
481-- | Some number of space chars
485-- | Some number of space chars
482−whitespace :: Parser [Char] ParserState Inline
486+whitespace :: Parser [Char] ParserState Inlines
483−whitespace = many1 spaceChar >> return Space <?> "whitespace"
487+whitespace = many1 spaceChar >> return B.space <?> "whitespace"
485-- | In Textile, an isolated endline character is a line break
489-- | In Textile, an isolated endline character is a line break
486−endline :: Parser [Char] ParserState Inline
490+endline :: Parser [Char] ParserState Inlines
487endline = try $ do
491endline = try $ do
488 newline >> notFollowedBy blankline
492 newline >> notFollowedBy blankline
489− return LineBreak
493+ return B.linebreak
491−rawHtmlInline :: Parser [Char] ParserState Inline
495+rawHtmlInline :: Parser [Char] ParserState Inlines
492−rawHtmlInline = RawInline (Format "html") . snd <$> htmlTag isInlineTag
496+rawHtmlInline = B.rawInline "html" . snd <$> htmlTag isInlineTag
494-- | Raw LaTeX Inline
498-- | Raw LaTeX Inline
495−rawLaTeXInline' :: Parser [Char] ParserState Inline
499+rawLaTeXInline' :: Parser [Char] ParserState Inlines
496rawLaTeXInline' = try $ do
500rawLaTeXInline' = try $ do
497 guardEnabled Ext_raw_tex
501 guardEnabled Ext_raw_tex
498− rawLaTeXInline
502+ B.singleton <$> rawLaTeXInline
500-- | Textile standard link syntax is "label":target. But we
504-- | Textile standard link syntax is "label":target. But we
501-- can also have ["label":target].
505-- can also have ["label":target].
502−link :: Parser [Char] ParserState Inline
506+link :: Parser [Char] ParserState Inlines
503link = linkB <|> linkNoB
507link = linkB <|> linkNoB
505−linkNoB :: Parser [Char] ParserState Inline
509+linkNoB :: Parser [Char] ParserState Inlines
506linkNoB = try $ do
510linkNoB = try $ do
507− name <- surrounded (char '"') inline
511+ name <- mconcat <$> surrounded (char '"') (withQuoteContext InDoubleQuote inline)
509 let stopChars = "!.,;:"
513 let stopChars = "!.,;:"
510 url <- manyTill nonspaceChar (lookAhead $ space <|> try (oneOf stopChars >> (space <|> newline)))
514 url <- manyTill nonspaceChar (lookAhead $ space <|> try (oneOf stopChars >> (space <|> newline)))
511− let name' = if name == [Str "$"] then [Str url] else name
515+ let name' = if B.toList name == [Str "$"] then B.str url else name
512− return $ Link name' (url, "")
516+ return $ B.link url "" name'
514−linkB :: Parser [Char] ParserState Inline
518+linkB :: Parser [Char] ParserState Inlines
515linkB = try $ do
519linkB = try $ do
517− name <- surrounded (char '"') inline
521+ name <- mconcat <$> surrounded (char '"') inline
519 url <- manyTill nonspaceChar (char ']')
523 url <- manyTill nonspaceChar (char ']')
520− let name' = if name == [Str "$"] then [Str url] else name
524+ let name' = if B.toList name == [Str "$"] then B.str url else name
521− return $ Link name' (url, "")
525+ return $ B.link url "" name'
523-- | image embedding
527-- | image embedding
524−image :: Parser [Char] ParserState Inline
528+image :: Parser [Char] ParserState Inlines
525image = try $ do
529image = try $ do
526 char '!' >> notFollowedBy space
530 char '!' >> notFollowedBy space
527 src <- manyTill anyChar (lookAhead $ oneOf "!(")
531 src <- manyTill anyChar (lookAhead $ oneOf "!(")
528 alt <- option "" (try $ (char '(' >> manyTill anyChar (char ')')))
532 alt <- option "" (try $ (char '(' >> manyTill anyChar (char ')')))
530− return $ Image [Str alt] (src, alt)
534+ return $ B.image src alt (B.str alt)
532−escapedInline :: Parser [Char] ParserState Inline
536+escapedInline :: Parser [Char] ParserState Inlines
533escapedInline = escapedEqs <|> escapedTag
537escapedInline = escapedEqs <|> escapedTag
535−escapedEqs :: Parser [Char] ParserState Inline
539+escapedEqs :: Parser [Char] ParserState Inlines
536−escapedEqs = Str <$> (try $ string "==" *> manyTill anyChar (try $ string "=="))
540+escapedEqs = B.str <$> (try $ string "==" *> manyTill anyChar (try $ string "=="))
538-- | literal text escaped btw <notextile> tags
542-- | literal text escaped btw <notextile> tags
539−escapedTag :: Parser [Char] ParserState Inline
543+escapedTag :: Parser [Char] ParserState Inlines
540−escapedTag = Str <$>
544+escapedTag = B.str <$>
541 (try $ string "<notextile>" *> manyTill anyChar (try $ string "</notextile>"))
545 (try $ string "<notextile>" *> manyTill anyChar (try $ string "</notextile>"))
543-- | Any special symbol defined in wordBoundaries
547-- | Any special symbol defined in wordBoundaries
544−symbol :: Parser [Char] ParserState Inline
548+symbol :: Parser [Char] ParserState Inlines
545−symbol = Str . singleton <$> (oneOf wordBoundaries <|> oneOf markupChars)
549+symbol = B.str . singleton <$> (oneOf wordBoundaries <|> oneOf markupChars)
547-- | Inline code
551-- | Inline code
548−code :: Parser [Char] ParserState Inline
552+code :: Parser [Char] ParserState Inlines
549code = code1 <|> code2
553code = code1 <|> code2
551−code1 :: Parser [Char] ParserState Inline
555+code1 :: Parser [Char] ParserState Inlines
552−code1 = Code nullAttr <$> surrounded (char '@') anyChar
556+code1 = B.code <$> surrounded (char '@') anyChar
554−code2 :: Parser [Char] ParserState Inline
558+code2 :: Parser [Char] ParserState Inlines
555code2 = do
559code2 = do
556 htmlTag (tagOpen (=="tt") null)
560 htmlTag (tagOpen (=="tt") null)
557− Code nullAttr <$> manyTill anyChar (try $ htmlTag $ tagClose (=="tt"))
561+ B.code <$> manyTill anyChar (try $ htmlTag $ tagClose (=="tt"))
559-- | Html / CSS attributes
563-- | Html / CSS attributes
560attributes :: Parser [Char] ParserState Attr
564attributes :: Parser [Char] ParserState Attr
@@ -581,7 +585,7 @@ styleAttr = do
582langAttr :: Parser [Char] ParserState (Attr -> Attr)
586langAttr :: Parser [Char] ParserState (Attr -> Attr)
583langAttr = do
587langAttr = do
584− lang <- try $ enclosed (char '[') (char ']') anyChar
588+ lang <- try $ enclosed (char '[') (char ']') alphaNum
585 return $ \(id',classes,keyvals) -> (id',classes,("lang",lang):keyvals)
589 return $ \(id',classes,keyvals) -> (id',classes,("lang",lang):keyvals)
587-- | Parses material surrounded by a parser.
591-- | Parses material surrounded by a parser.
@@ -590,14 +594,43 @@ surrounded :: Parser [Char] st t -- ^ surrounding parser
590 -> Parser [Char] st [a]
594 -> Parser [Char] st [a]
591surrounded border = enclosed (border *> notFollowedBy (oneOf " \t\n\r")) (try border)
595surrounded border = enclosed (border *> notFollowedBy (oneOf " \t\n\r")) (try border)
593−-- | Inlines are most of the time of the same form
597+
594simpleInline :: Parser [Char] ParserState t -- ^ surrounding parser
598simpleInline :: Parser [Char] ParserState t -- ^ surrounding parser
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
603+ungroupedSimpleInline :: Parser [Char] ParserState t -- ^ surrounding parser
595− -> ([Inline] -> Inline) -- ^ Inline constructor
604+ -> (Inlines -> Inlines) -- ^ Inline constructor
596− -> Parser [Char] ParserState Inline -- ^ content parser (to be used repeatedly)
605+ -> Parser [Char] ParserState Inlines -- ^ content parser (to be used repeatedly)
606+ungroupedSimpleInline border construct = try $ do
609+ isWhitespace <- option False (whitespace >> return True)
610+ guard $ (stateQuoteContext st /= NoQuote)
611+ || (sourceColumn pos == 1)
597−simpleInline border construct = surrounded border inlineWithAttribute >>=
613+ body <- surrounded border inlineWithAttribute
598− return . construct . normalizeSpaces
614+ lookAhead (notFollowedBy alphaNum)
615+ let result = construct $ mconcat body
616+ return $ if isWhitespace then B.space <> result
599− where inlineWithAttribute = (try $ optional attributes) >> inline
619+ inlineWithAttribute = (try $ optional attributes) >> notFollowedBy (string "\n\n")
620+ >> (withQuoteContext InSingleQuote inline)
623+groupedSimpleInline :: Parser [Char] ParserState t
624+ -> (Inlines -> Inlines)
625+ -> Parser [Char] ParserState Inlines
626+groupedSimpleInline border construct = try $ do
628+ withQuoteContext InSingleQuote (simpleInline border construct) >>~ char ']'
601-- | Create a singleton list
633-- | Create a singleton list
602singleton :: a -> [a]
634singleton :: a -> [a]
603singleton x = [x]
635singleton x = [x]