@@ -59,10 +59,12 @@ import Text.Pandoc.Definition
5959import Text.Pandoc.Shared
6060import Text.Pandoc.Parsing
6161import Text.Pandoc.Readers.HTML ( htmlTag, isInlineTag, isBlockTag )
62+import Text.Pandoc.Readers.LaTeX ( rawLaTeXInline, rawLaTeXBlock )
6263import Text.ParserCombinators.Parsec
6364import Text.HTML.TagSoup.Match
6465import Data.Char ( digitToInt, isLetter )
6566import Control.Monad ( guard, liftM )
67+import Control.Applicative ((<$>), (*>), (<*))
6668
6769-- | Parse a Textile text and return a Pandoc document.
6870readTextile :: ParserState -- ^ Parser state, including options for parser
@@ -128,6 +130,7 @@ blockParsers = [ codeBlock
128130 , hrule
129131 , anyList
130132 , rawHtmlBlock
133+ , rawLaTeXBlock'
131134 , maybeExplicitBlock "table" table
132135 , maybeExplicitBlock "p" para
133136 , nullBlock ]
@@ -164,21 +167,16 @@ codeBlockPre = try $ do
164167header :: GenParser Char ParserState Block
165168header = try $ do
166169 char 'h'
167− level <- oneOf "123456" >>= return . digitToInt
168− optional attributes
169− char '.'
170− whitespace
171− name <- manyTill inline blockBreak
172− return $ Header level (normalizeSpaces name)
170+ level <- digitToInt <$> oneOf "123456"
171+ optional attributes >> char '.' >> whitespace
172+ name <- normalizeSpaces <$> manyTill inline blockBreak
173+ return $ Header level name
173174
174175-- | Blockquote of the form "bq. content"
175176blockQuote :: GenParser Char ParserState Block
176177blockQuote = try $ do
177− string "bq"
178− optional attributes
179− char '.'
180− whitespace
181− para >>= return . BlockQuote . (:[])
178+ string "bq" >> optional attributes >> char '.' >> whitespace
179+ BlockQuote . singleton <$> para
182180
183181-- Horizontal rule
184182
@@ -198,10 +196,7 @@ hrule = try $ do
198196-- strict in the nesting, sublist must start at exactly "parent depth
199197-- plus one"
200198anyList :: GenParser Char ParserState Block
201−anyList = try $ do
202− l <- anyListAtDepth 1
203− blanklines
204− return l
199+anyList = try $ ( (anyListAtDepth 1) <* blanklines )
205200
206201-- | This allow one type of list to be nested into an other type,
207202-- provided correct nesting
@@ -212,20 +207,12 @@ anyListAtDepth depth = choice [ bulletListAtDepth depth,
212207
213208-- | Bullet List of given depth, depth being the number of leading '*'
214209bulletListAtDepth :: Int -> GenParser Char ParserState Block
215−bulletListAtDepth depth = try $ do
216− items <- many1 (bulletListItemAtDepth depth)
217− return (BulletList items)
210+bulletListAtDepth depth = try $ BulletList <$> many1 (bulletListItemAtDepth depth)
218211
219212-- | Bullet List Item of given depth, depth being the number of
220213-- leading '*'
221214bulletListItemAtDepth :: Int -> GenParser Char ParserState [Block]
222−bulletListItemAtDepth depth = try $ do
223− count depth (char '*')
224− optional attributes
225− whitespace
226− p <- inlines >>= return . Plain
227− sublist <- option [] (anyListAtDepth (depth + 1) >>= return . (:[]))
228− return (p:sublist)
215+bulletListItemAtDepth = genericListItemAtDepth '*'
229216
230217-- | Ordered List of given depth, depth being the number of
231218-- leading '#'
@@ -237,19 +224,19 @@ orderedListAtDepth depth = try $ do
237224-- | Ordered List Item of given depth, depth being the number of
238225-- leading '#'
239226orderedListItemAtDepth :: Int -> GenParser Char ParserState [Block]
240−orderedListItemAtDepth depth = try $ do
241− count depth (char '#')
242− optional attributes
243− whitespace
244− p <- inlines >>= return . Plain
245− sublist <- option [] (anyListAtDepth (depth + 1) >>= return . (:[]))
246− return (p:sublist)
227+orderedListItemAtDepth = genericListItemAtDepth '#'
228+
229+-- | Common implementation of list items
230+genericListItemAtDepth :: Char -> Int -> GenParser Char ParserState [Block]
231+genericListItemAtDepth c depth = try $ do
232+ count depth (char c) >> optional attributes >> whitespace
233+ p <- inlines
234+ sublist <- option [] (singleton <$> anyListAtDepth (depth + 1))
235+ return ((Plain p):sublist)
247236
248237-- | A definition list is a set of consecutive definition items
249238definitionList :: GenParser Char ParserState Block
250−definitionList = try $ do
251− items <- many1 definitionListItem
252− return $ DefinitionList items
239+definitionList = try $ DefinitionList <$> many1 definitionListItem
253240
254241-- | A definition list item in textile begins with '- ', followed by
255242-- the term defined, then spaces and ":=". The definition follows, on
@@ -277,6 +264,8 @@ blockBreak :: GenParser Char ParserState ()
277264blockBreak = try (newline >> blanklines >> return ()) <|>
278265 (lookAhead rawHtmlBlock >> return ())
279266
267+-- raw content
268+
280269-- | A raw Html Block, optionally followed by blanklines
281270rawHtmlBlock :: GenParser Char ParserState Block
282271rawHtmlBlock = try $ do
@@ -284,11 +273,16 @@ rawHtmlBlock = try $ do
284273 optional blanklines
285274 return $ RawBlock "html" b
286275
276+-- | Raw block of LaTeX content
277+rawLaTeXBlock' :: GenParser Char ParserState Block
278+rawLaTeXBlock' = do
279+ failIfStrict
280+ RawBlock "latex" <$> (rawLaTeXBlock <* spaces)
281+
282+
287283-- | In textile, paragraphs are separated by blank lines.
288284para :: GenParser Char ParserState Block
289−para = try $ do
290− content <- manyTill inline blockBreak
291− return $ Para $ normalizeSpaces content
285+para = try $ Para . normalizeSpaces <$> manyTill inline blockBreak
292286
293287
294288-- Tables
@@ -302,11 +296,7 @@ tableCell = do
302296
303297-- | A table row is made of many table cells
304298tableRow :: GenParser Char ParserState [TableCell]
305−tableRow = try $ do
306− char '|'
307− cells <- endBy1 tableCell (char '|')
308− newline
309− return cells
299+tableRow = try $ ( char '|' *> (endBy1 tableCell (char '|')) <* newline)
310300
311301-- | Many table rows
312302tableRows :: GenParser Char ParserState [[TableCell]]
@@ -314,13 +304,8 @@ tableRows = many1 tableRow
314304
315305-- | Table headers are made of cells separated by a tag "|_."
316306tableHeaders :: GenParser Char ParserState [TableCell]
317−tableHeaders = try $ do
318− let separator = (try $ string "|_.")
319− separator
320− headers <- sepBy1 tableCell separator
321− char '|'
322− newline
323− return headers
307+tableHeaders = let separator = (try $ string "|_.") in
308+ try $ ( separator *> (sepBy1 tableCell separator) <* char '|' <* newline )
324309
325310-- | A table with an optional header. Current implementation can
326311-- handle tables with and without header, but will parse cells
@@ -373,6 +358,7 @@ inlineParsers = [ autoLink
373358 , escapedInline
374359 , htmlSpan
375360 , rawHtmlInline
361+ , rawLaTeXInline'
376362 , note
377363 , simpleInline (string "??") (Cite [])
378364 , simpleInline (string "**") Strong
@@ -444,11 +430,7 @@ str = do
444430
445431-- | Textile allows HTML span infos, we discard them
446432htmlSpan :: GenParser Char ParserState Inline
447−htmlSpan = try $ do
448− char '%'
449− _ <- attributes
450− content <- manyTill anyChar (char '%')
451− return $ Str content
433+htmlSpan = try $ Str <$> ( char '%' *> attributes *> manyTill anyChar (char '%') )
452434
453435-- | Some number of space chars
454436whitespace :: GenParser Char ParserState Inline
@@ -461,8 +443,13 @@ endline = try $ do
461443 return LineBreak
462444
463445rawHtmlInline :: GenParser Char ParserState Inline
464−rawHtmlInline = liftM (RawInline "html" . snd)
465− $ htmlTag isInlineTag
446+rawHtmlInline = RawInline "html" . snd <$> htmlTag isInlineTag
447+
448+-- | Raw LaTeX Inline
449+rawLaTeXInline' :: GenParser Char ParserState Inline
450+rawLaTeXInline' = try $ do
451+ failIfStrict
452+ rawLaTeXInline
466453
467454-- | Textile standard link syntax is "label":target
468455link :: GenParser Char ParserState Inline
@@ -499,16 +486,12 @@ escapedEqs = try $ do
499486
500487-- | literal text escaped btw <notextile> tags
501488escapedTag :: GenParser Char ParserState Inline
502−escapedTag = try $ do
503− string "<notextile>"
504− contents <- manyTill anyChar (try $ string "</notextile>")
505− return $ Str contents
489+escapedTag = try $ Str <$> ( string "<notextile>" *>
490+ manyTill anyChar (try $ string "</notextile>") )
506491
507492-- | Any special symbol defined in specialChars
508493symbol :: GenParser Char ParserState Inline
509−symbol = do
510− result <- oneOf specialChars
511− return $ Str [result]
494+symbol = Str . singleton <$> oneOf specialChars
512495
513496-- | Inline code
514497code :: GenParser Char ParserState Inline
@@ -542,3 +525,7 @@ simpleInline :: GenParser Char ParserState t -- ^ surrounding parser
542525simpleInline border construct = surrounded border (inlineWithAttribute) >>=
543526 return . construct . normalizeSpaces
544527 where inlineWithAttribute = (try $ optional attributes) >> inline
528+
529+-- | Create a singleton list
530+singleton :: a -> [a]
531+singleton x = [x]