@@ -40,6 +40,7 @@ import Text.HTML.TagSoup
40import Text.HTML.TagSoup.Match
40import Text.HTML.TagSoup.Match
41import Text.Pandoc.Definition
41import Text.Pandoc.Definition
42import qualified Text.Pandoc.Builder as B
42import qualified Text.Pandoc.Builder as B
43+import Text.Pandoc.Builder (Blocks, Inlines, trimInlines)
43import Text.Pandoc.Shared
44import Text.Pandoc.Shared
44import Text.Pandoc.Options
45import Text.Pandoc.Options
45import Text.Pandoc.Parsing
46import Text.Pandoc.Parsing
@@ -48,6 +49,8 @@ import Data.List ( intercalate )
48import Data.Char ( isDigit )
49import Data.Char ( isDigit )
49import Control.Monad ( liftM, guard, when, mzero )
50import Control.Monad ( liftM, guard, when, mzero )
50import Control.Applicative ( (<$>), (<$), (<*) )
51import Control.Applicative ( (<$>), (<$), (<*) )
53+import Data.Sequence (ViewL(..), ViewR(..), viewr, viewl)
52isSpace :: Char -> Bool
55isSpace :: Char -> Bool
53isSpace ' ' = True
56isSpace ' ' = True
@@ -66,30 +69,30 @@ readHtml opts inp =
66 where tags = canonicalizeTags $
69 where tags = canonicalizeTags $
67 parseTagsOptions parseOptions{ optTagPosition = True } inp
70 parseTagsOptions parseOptions{ optTagPosition = True } inp
68 parseDoc = do
71 parseDoc = do
69− blocks <- (fixPlains False . concat) <$> manyTill block eof
72+ blocks <- (fixPlains False) . mconcat <$> manyTill block eof
70 meta <- stateMeta <$> getState
73 meta <- stateMeta <$> getState
71− return $ Pandoc meta blocks
74+ return $ Pandoc meta (B.toList blocks)
73type TagParser = Parser [Tag String] ParserState
76type TagParser = Parser [Tag String] ParserState
75−pBody :: TagParser [Block]
78+pBody :: TagParser Blocks
76pBody = pInTags "body" block
79pBody = pInTags "body" block
78−pHead :: TagParser [Block]
81+pHead :: TagParser Blocks
79−pHead = pInTags "head" $ pTitle <|> pMetaTag <|> ([] <$ pAnyTag)
82+pHead = pInTags "head" $ pTitle <|> pMetaTag <|> (mempty <$ pAnyTag)
80− where pTitle = pInTags "title" inline >>= setTitle . normalizeSpaces
83+ where pTitle = pInTags "title" inline >>= setTitle . trimInlines
81− setTitle t = [] <$ (updateState $ B.setMeta "title" (B.fromList t))
84+ setTitle t = mempty <$ (updateState $ B.setMeta "title" t)
82 pMetaTag = do
85 pMetaTag = do
83 mt <- pSatisfy (~== TagOpen "meta" [])
86 mt <- pSatisfy (~== TagOpen "meta" [])
84 let name = fromAttrib "name" mt
87 let name = fromAttrib "name" mt
85 if null name
88 if null name
86− then return []
89+ then return mempty
88 let content = fromAttrib "content" mt
91 let content = fromAttrib "content" mt
89 updateState $ B.setMeta name (B.text content)
92 updateState $ B.setMeta name (B.text content)
90− return []
93+ return mempty
92−block :: TagParser [Block]
95+block :: TagParser Blocks
93block = choice
96block = choice
@@ -105,10 +108,10 @@ block = choice
105 , pRawHtmlBlock
108 , pRawHtmlBlock
108−pList :: TagParser [Block]
111+pList :: TagParser Blocks
109pList = pBulletList <|> pOrderedList <|> pDefinitionList
112pList = pBulletList <|> pOrderedList <|> pDefinitionList
111−pBulletList :: TagParser [Block]
114+pBulletList :: TagParser Blocks
112pBulletList = try $ do
115pBulletList = try $ do
113 pSatisfy (~== TagOpen "ul" [])
116 pSatisfy (~== TagOpen "ul" [])
114 let nonItem = pSatisfy (\t ->
117 let nonItem = pSatisfy (\t ->
@@ -118,9 +121,9 @@ pBulletList = try $ do
118 -- treat it as a list item, though it's not valid xhtml...
121 -- treat it as a list item, though it's not valid xhtml...
119 skipMany nonItem
122 skipMany nonItem
120 items <- manyTill (pInTags "li" block >>~ skipMany nonItem) (pCloses "ul")
123 items <- manyTill (pInTags "li" block >>~ skipMany nonItem) (pCloses "ul")
121− return [BulletList $ map (fixPlains True) items]
124+ return $ B.bulletList $ map (fixPlains True) items
123−pOrderedList :: TagParser [Block]
126+pOrderedList :: TagParser Blocks
124pOrderedList = try $ do
127pOrderedList = try $ do
125 TagOpen _ attribs <- pSatisfy (~== TagOpen "ol" [])
128 TagOpen _ attribs <- pSatisfy (~== TagOpen "ol" [])
126 let (start, style) = (sta', sty')
129 let (start, style) = (sta', sty')
@@ -146,27 +149,27 @@ pOrderedList = try $ do
146 -- treat it as a list item, though it's not valid xhtml...
149 -- treat it as a list item, though it's not valid xhtml...
147 skipMany nonItem
150 skipMany nonItem
148 items <- manyTill (pInTags "li" block >>~ skipMany nonItem) (pCloses "ol")
151 items <- manyTill (pInTags "li" block >>~ skipMany nonItem) (pCloses "ol")
149− return [OrderedList (start, style, DefaultDelim) $ map (fixPlains True) items]
152+ return $ B.orderedListWith (start, style, DefaultDelim) $ map (fixPlains True) items
151−pDefinitionList :: TagParser [Block]
154+pDefinitionList :: TagParser Blocks
152pDefinitionList = try $ do
155pDefinitionList = try $ do
153 pSatisfy (~== TagOpen "dl" [])
156 pSatisfy (~== TagOpen "dl" [])
154 items <- manyTill pDefListItem (pCloses "dl")
157 items <- manyTill pDefListItem (pCloses "dl")
155− return [DefinitionList items]
158+ return $ B.definitionList items
157−pDefListItem :: TagParser ([Inline],[[Block]])
160+pDefListItem :: TagParser (Inlines, [Blocks])
158pDefListItem = try $ do
161pDefListItem = try $ do
159 let nonItem = pSatisfy (\t -> not (t ~== TagOpen "dt" []) &&
162 let nonItem = pSatisfy (\t -> not (t ~== TagOpen "dt" []) &&
160 not (t ~== TagOpen "dd" []) && not (t ~== TagClose "dl"))
163 not (t ~== TagOpen "dd" []) && not (t ~== TagClose "dl"))
161 terms <- many1 (try $ skipMany nonItem >> pInTags "dt" inline)
164 terms <- many1 (try $ skipMany nonItem >> pInTags "dt" inline)
162 defs <- many1 (try $ skipMany nonItem >> pInTags "dd" block)
165 defs <- many1 (try $ skipMany nonItem >> pInTags "dd" block)
163 skipMany nonItem
166 skipMany nonItem
164− let term = intercalate [LineBreak] terms
167+ let term = foldl1 (\x y -> x <> B.linebreak <> y) terms
165 return (term, map (fixPlains True) defs)
168 return (term, map (fixPlains True) defs)
167−fixPlains :: Bool -> [Block] -> [Block]
170+fixPlains :: Bool -> Blocks -> Blocks
168−fixPlains inList bs = if any isParaish bs
171+fixPlains inList bs = if any isParaish bs'
169− then map plainToPara bs
172+ then B.fromList $ map plainToPara bs'
171 where isParaish (Para _) = True
174 where isParaish (Para _) = True
172 isParaish (CodeBlock _ _) = True
175 isParaish (CodeBlock _ _) = True
@@ -178,6 +181,7 @@ fixPlains inList bs = if any isParaish bs
178 isParaish _ = False
181 isParaish _ = False
179 plainToPara (Plain xs) = Para xs
182 plainToPara (Plain xs) = Para xs
180 plainToPara x = x
183 plainToPara x = x
182pRawTag :: TagParser String
186pRawTag :: TagParser String
183pRawTag = do
187pRawTag = do
@@ -187,20 +191,20 @@ pRawTag = do
187 then return []
191 then return []
188 else return $ renderTags' [tag]
192 else return $ renderTags' [tag]
190−pDiv :: TagParser [Block]
194+pDiv :: TagParser Blocks
191pDiv = try $ do
195pDiv = try $ do
192 getOption readerParseRaw >>= guard
196 getOption readerParseRaw >>= guard
193 TagOpen _ attr <- lookAhead $ pSatisfy $ tagOpen (=="div") (const True)
197 TagOpen _ attr <- lookAhead $ pSatisfy $ tagOpen (=="div") (const True)
194 contents <- pInTags "div" block
198 contents <- pInTags "div" block
195− return [Div (mkAttr attr) contents]
199+ return $ B.divWith (mkAttr attr) contents
197−pRawHtmlBlock :: TagParser [Block]
201+pRawHtmlBlock :: TagParser Blocks
198pRawHtmlBlock = do
202pRawHtmlBlock = do
199 raw <- pHtmlBlock "script" <|> pHtmlBlock "style" <|> pRawTag
203 raw <- pHtmlBlock "script" <|> pHtmlBlock "style" <|> pRawTag
200 parseRaw <- getOption readerParseRaw
204 parseRaw <- getOption readerParseRaw
201 if parseRaw && not (null raw)
205 if parseRaw && not (null raw)
202− then return [RawBlock (Format "html") raw]
206+ then return $ B.rawBlock "html" raw
203− else return []
207+ else return mempty
205pHtmlBlock :: String -> TagParser String
209pHtmlBlock :: String -> TagParser String
206pHtmlBlock t = try $ do
210pHtmlBlock t = try $ do
@@ -208,35 +212,34 @@ pHtmlBlock t = try $ do
208 contents <- manyTill pAnyTag (pSatisfy (~== TagClose t))
212 contents <- manyTill pAnyTag (pSatisfy (~== TagClose t))
209 return $ renderTags' $ [open] ++ contents ++ [TagClose t]
213 return $ renderTags' $ [open] ++ contents ++ [TagClose t]
211−pHeader :: TagParser [Block]
215+pHeader :: TagParser Blocks
212pHeader = try $ do
216pHeader = try $ do
213 TagOpen tagtype attr <- pSatisfy $
217 TagOpen tagtype attr <- pSatisfy $
214 tagOpen (`elem` ["h1","h2","h3","h4","h5","h6"])
218 tagOpen (`elem` ["h1","h2","h3","h4","h5","h6"])
215 (const True)
219 (const True)
216 let bodyTitle = TagOpen tagtype attr ~== TagOpen "h1" [("class","title")]
220 let bodyTitle = TagOpen tagtype attr ~== TagOpen "h1" [("class","title")]
217 let level = read (drop 1 tagtype)
221 let level = read (drop 1 tagtype)
218− contents <- liftM concat $ manyTill inline (pCloses tagtype <|> eof)
222+ contents <- trimInlines . mconcat <$> manyTill inline (pCloses tagtype <|> eof)
219 let ident = fromMaybe "" $ lookup "id" attr
223 let ident = fromMaybe "" $ lookup "id" attr
220 let classes = maybe [] words $ lookup "class" attr
224 let classes = maybe [] words $ lookup "class" attr
221 let keyvals = [(k,v) | (k,v) <- attr, k /= "class", k /= "id"]
225 let keyvals = [(k,v) | (k,v) <- attr, k /= "class", k /= "id"]
222 return $ if bodyTitle
226 return $ if bodyTitle
223− then [] -- skip a representation of the title in the body
227+ then mempty -- skip a representation of the title in the body
224− else [Header level (ident, classes, keyvals) $
228+ else B.headerWith (ident, classes, keyvals) level contents
225− normalizeSpaces contents]
227−pHrule :: TagParser [Block]
230+pHrule :: TagParser Blocks
228pHrule = do
231pHrule = do
229 pSelfClosing (=="hr") (const True)
232 pSelfClosing (=="hr") (const True)
230− return [HorizontalRule]
233+ return B.horizontalRule
232−pTable :: TagParser [Block]
235+pTable :: TagParser Blocks
233pTable = try $ do
236pTable = try $ do
234 TagOpen _ _ <- pSatisfy (~== TagOpen "table" [])
237 TagOpen _ _ <- pSatisfy (~== TagOpen "table" [])
235 skipMany pBlank
238 skipMany pBlank
236− caption <- option [] $ pInTags "caption" inline >>~ skipMany pBlank
239+ caption <- option mempty $ pInTags "caption" inline >>~ skipMany pBlank
237 -- TODO actually read these and take width information from them
240 -- TODO actually read these and take width information from them
238 widths' <- pColgroup <|> many pCol
241 widths' <- pColgroup <|> many pCol
239− head' <- option [] $ pOptInTag "thead" $ pInTags "tr" (pCell "th")
242+ head' <- option mempty $ pOptInTag "thead" $ pInTags "tr" (pCell "th")
240 skipMany pBlank
243 skipMany pBlank
241 rows <- pOptInTag "tbody"
244 rows <- pOptInTag "tbody"
242 $ many1 $ try $ skipMany pBlank >> pInTags "tr" (pCell "td")
245 $ many1 $ try $ skipMany pBlank >> pInTags "tr" (pCell "td")
@@ -245,19 +248,21 @@ pTable = try $ do
245 let isSinglePlain [] = True
248 let isSinglePlain [] = True
246 isSinglePlain [Plain _] = True
249 isSinglePlain [Plain _] = True
247 isSinglePlain _ = False
250 isSinglePlain _ = False
251+ let lHead = B.toList head'
252+ let lRows = map B.toList rows
248− let isSimple = all isSinglePlain $ concat (head':rows)
253+ let isSimple = all isSinglePlain (lHead:lRows)
249− let cols = length $ if null head'
254+ let cols = length $ if null lHead
250− then head rows
255+ then head lRows
251− else head'
256+ else lHead
252 -- fail if there are colspans or rowspans
257 -- fail if there are colspans or rowspans
253− guard $ all (\r -> length r == cols) rows
258+ guard $ all (\r -> length r == cols) lRows
254 let aligns = replicate cols AlignLeft
259 let aligns = replicate cols AlignLeft
255 let widths = if null widths'
260 let widths = if null widths'
256 then if isSimple
261 then if isSimple
257 then replicate cols 0
262 then replicate cols 0
258 else replicate cols (1.0 / fromIntegral cols)
263 else replicate cols (1.0 / fromIntegral cols)
259 else widths'
264 else widths'
260− return [Table caption aligns widths head' rows]
265+ return $ B.table caption (zip aligns widths) [head'] [rows]
262pCol :: TagParser Double
267pCol :: TagParser Double
263pCol = try $ do
268pCol = try $ do
@@ -275,31 +280,31 @@ pColgroup = try $ do
275 skipMany pBlank
280 skipMany pBlank
276 manyTill pCol (pCloses "colgroup" <|> eof) <* skipMany pBlank
281 manyTill pCol (pCloses "colgroup" <|> eof) <* skipMany pBlank
278−pCell :: String -> TagParser [TableCell]
283+pCell :: String -> TagParser Blocks
279pCell celltype = try $ do
284pCell celltype = try $ do
280 skipMany pBlank
285 skipMany pBlank
281 res <- pInTags celltype block
286 res <- pInTags celltype block
282 skipMany pBlank
287 skipMany pBlank
283− return [res]
288+ return res
285−pBlockQuote :: TagParser [Block]
290+pBlockQuote :: TagParser Blocks
286pBlockQuote = do
291pBlockQuote = do
287 contents <- pInTags "blockquote" block
292 contents <- pInTags "blockquote" block
288− return [BlockQuote $ fixPlains False contents]
293+ return $ B.blockQuote $ fixPlains False contents
290−pPlain :: TagParser [Block]
295+pPlain :: TagParser Blocks
291pPlain = do
296pPlain = do
292− contents <- liftM (normalizeSpaces . concat) $ many1 inline
297+ contents <- trimInlines . mconcat <$> many1 inline
293− if null contents
298+ if B.isNull contents
294− then return []
299+ then return mempty
295− else return [Plain contents]
300+ else return $ B.plain contents
297−pPara :: TagParser [Block]
302+pPara :: TagParser Blocks
298pPara = do
303pPara = do
299− contents <- pInTags "p" inline
304+ contents <- trimInlines <$> pInTags "p" inline
300− return [Para $ normalizeSpaces contents]
305+ return $ B.para contents
302−pCodeBlock :: TagParser [Block]
307+pCodeBlock :: TagParser Blocks
303pCodeBlock = try $ do
308pCodeBlock = try $ do
304 TagOpen _ attr <- pSatisfy (~== TagOpen "pre" [])
309 TagOpen _ attr <- pSatisfy (~== TagOpen "pre" [])
305 contents <- manyTill pAnyTag (pCloses "pre" <|> eof)
310 contents <- manyTill pAnyTag (pCloses "pre" <|> eof)
@@ -312,9 +317,9 @@ pCodeBlock = try $ do
312 let result = case reverse result' of
317 let result = case reverse result' of
313 '\n':_ -> init result'
318 '\n':_ -> init result'
314 _ -> result'
319 _ -> result'
315− return [CodeBlock (mkAttr attr) result]
320+ return $ B.codeBlockWith (mkAttr attr) result
317−inline :: TagParser [Inline]
322+inline :: TagParser Inlines
318inline = choice
323inline = choice
319 [ pTagText
324 [ pTagText
@@ -354,7 +359,7 @@ pSelfClosing f g = do
354 optional $ pSatisfy (tagClose f)
359 optional $ pSatisfy (tagClose f)
355 return open
360 return open
357−pQ :: TagParser [Inline]
362+pQ :: TagParser Inlines
359 quoteContext <- stateQuoteContext `fmap` getState
364 quoteContext <- stateQuoteContext `fmap` getState
360 let quoteType = case quoteContext of
365 let quoteType = case quoteContext of
@@ -363,82 +368,93 @@ pQ = do
363 let innerQuoteContext = if quoteType == SingleQuote
368 let innerQuoteContext = if quoteType == SingleQuote
364 then InSingleQuote
369 then InSingleQuote
365 else InDoubleQuote
370 else InDoubleQuote
371+ let constructor = case quoteType of
372+ SingleQuote -> B.singleQuoted
373+ DoubleQuote -> B.doubleQuoted
366− withQuoteContext innerQuoteContext $ pInlinesInTags "q" (Quoted quoteType)
374+ withQuoteContext innerQuoteContext $
375+ pInlinesInTags "q" constructor
368−pEmph :: TagParser [Inline]
377+pEmph :: TagParser Inlines
369−pEmph = pInlinesInTags "em" Emph <|> pInlinesInTags "i" Emph
378+pEmph = pInlinesInTags "em" B.emph <|> pInlinesInTags "i" B.emph
371−pStrong :: TagParser [Inline]
380+pStrong :: TagParser Inlines
372−pStrong = pInlinesInTags "strong" Strong <|> pInlinesInTags "b" Strong
381+pStrong = pInlinesInTags "strong" B.strong <|> pInlinesInTags "b" B.strong
374−pSuperscript :: TagParser [Inline]
383+pSuperscript :: TagParser Inlines
375−pSuperscript = pInlinesInTags "sup" Superscript
384+pSuperscript = pInlinesInTags "sup" B.superscript
377−pSubscript :: TagParser [Inline]
386+pSubscript :: TagParser Inlines
378−pSubscript = pInlinesInTags "sub" Subscript
387+pSubscript = pInlinesInTags "sub" B.subscript
380−pStrikeout :: TagParser [Inline]
389+pStrikeout :: TagParser Inlines
381pStrikeout = do
390pStrikeout = do
382− pInlinesInTags "s" Strikeout <|>
391+ pInlinesInTags "s" B.strikeout <|>
383− pInlinesInTags "strike" Strikeout <|>
392+ pInlinesInTags "strike" B.strikeout <|>
384− pInlinesInTags "del" Strikeout <|>
393+ pInlinesInTags "del" B.strikeout <|>
385 try (do pSatisfy (~== TagOpen "span" [("class","strikeout")])
394 try (do pSatisfy (~== TagOpen "span" [("class","strikeout")])
386− contents <- liftM concat $ manyTill inline (pCloses "span")
395+ contents <- mconcat <$> manyTill inline (pCloses "span")
387− return [Strikeout contents])
396+ return $ B.strikeout contents)
389−pLineBreak :: TagParser [Inline]
398+pLineBreak :: TagParser Inlines
390pLineBreak = do
399pLineBreak = do
391 pSelfClosing (=="br") (const True)
400 pSelfClosing (=="br") (const True)
392− return [LineBreak]
401+ return B.linebreak
394−pLink :: TagParser [Inline]
403+pLink :: TagParser Inlines
395pLink = try $ do
404pLink = try $ do
396 tag <- pSatisfy (tagOpenLit "a" (isJust . lookup "href"))
405 tag <- pSatisfy (tagOpenLit "a" (isJust . lookup "href"))
397 let url = fromAttrib "href" tag
406 let url = fromAttrib "href" tag
398 let title = fromAttrib "title" tag
407 let title = fromAttrib "title" tag
399− lab <- liftM concat $ manyTill inline (pCloses "a")
408+ lab <- trimInlines . mconcat <$> manyTill inline (pCloses "a")
400− return [Link (normalizeSpaces lab) (escapeURI url, title)]
409+ return $ B.link (escapeURI url) title lab
402−pImage :: TagParser [Inline]
411+pImage :: TagParser Inlines
403pImage = do
412pImage = do
404 tag <- pSelfClosing (=="img") (isJust . lookup "src")
413 tag <- pSelfClosing (=="img") (isJust . lookup "src")
405 let url = fromAttrib "src" tag
414 let url = fromAttrib "src" tag
406 let title = fromAttrib "title" tag
415 let title = fromAttrib "title" tag
407 let alt = fromAttrib "alt" tag
416 let alt = fromAttrib "alt" tag
408− return [Image (B.toList $ B.text alt) (escapeURI url, title)]
417+ return $ B.image (escapeURI url) title (B.text alt)
410−pCode :: TagParser [Inline]
419+pCode :: TagParser Inlines
411pCode = try $ do
420pCode = try $ do
412 (TagOpen open attr) <- pSatisfy $ tagOpen (`elem` ["code","tt"]) (const True)
421 (TagOpen open attr) <- pSatisfy $ tagOpen (`elem` ["code","tt"]) (const True)
413 result <- manyTill pAnyTag (pCloses open)
422 result <- manyTill pAnyTag (pCloses open)
414− return [Code (mkAttr attr) $ intercalate " " $ lines $ innerText result]
423+ return $ B.codeWith (mkAttr attr) $ intercalate " " $ lines $ innerText result
416−pSpan :: TagParser [Inline]
425+pSpan :: TagParser Inlines
417pSpan = try $ do
426pSpan = try $ do
418 getOption readerParseRaw >>= guard
427 getOption readerParseRaw >>= guard
419 TagOpen _ attr <- lookAhead $ pSatisfy $ tagOpen (=="span") (const True)
428 TagOpen _ attr <- lookAhead $ pSatisfy $ tagOpen (=="span") (const True)
420 contents <- pInTags "span" inline
429 contents <- pInTags "span" inline
421− return [Span (mkAttr attr) contents]
430+ return $ B.spanWith (mkAttr attr) contents
423−pRawHtmlInline :: TagParser [Inline]
432+pRawHtmlInline :: TagParser Inlines
424pRawHtmlInline = do
433pRawHtmlInline = do
425 result <- pSatisfy (tagComment (const True)) <|> pSatisfy isInlineTag
434 result <- pSatisfy (tagComment (const True)) <|> pSatisfy isInlineTag
426 parseRaw <- getOption readerParseRaw
435 parseRaw <- getOption readerParseRaw
427 if parseRaw
436 if parseRaw
428− then return [RawInline (Format "html") $ renderTags' [result]]
437+ then return $ B.rawInline "html" $ renderTags' [result]
429− else return []
438+ else return mempty
431−pInlinesInTags :: String -> ([Inline] -> Inline)
440+pInlinesInTags :: String -> (Inlines -> Inlines)
432− -> TagParser [Inline]
441+ -> TagParser Inlines
433pInlinesInTags tagtype f = do
442pInlinesInTags tagtype f = do
434− contents <- pInTags tagtype inline
443+ contents <- B.unMany <$> pInTags tagtype inline
444+ let left = case viewl contents of
446+ (a :< _) -> padSpace a
447+ let right = case viewr contents of
449+ (_ :> a) -> padSpace a
435− return [f $ normalizeSpaces contents]
450+ return (left <> f (trimInlines . B.Many $ contents) <> right)
436−
451+ where padSpace a = if a == Space then B.space else mempty
437−pInTags :: String -> TagParser [a]
453+pInTags :: (Monoid a) => String -> TagParser a
438− -> TagParser [a]
454+ -> TagParser a
439pInTags tagtype parser = try $ do
455pInTags tagtype parser = try $ do
440 pSatisfy (~== TagOpen tagtype [])
456 pSatisfy (~== TagOpen tagtype [])
441− liftM concat $ manyTill parser (pCloses tagtype <|> eof)
457+ mconcat <$> manyTill parser (pCloses tagtype <|> eof)
443pOptInTag :: String -> TagParser a
459pOptInTag :: String -> TagParser a
444 -> TagParser a
460 -> TagParser a
@@ -461,36 +477,36 @@ pCloses tagtype = try $ do
461 (TagClose "dl") | tagtype == "li" -> return ()
477 (TagClose "dl") | tagtype == "li" -> return ()
462 _ -> mzero
478 _ -> mzero
464−pTagText :: TagParser [Inline]
480+pTagText :: TagParser Inlines
465pTagText = try $ do
481pTagText = try $ do
466 (TagText str) <- pSatisfy isTagText
482 (TagText str) <- pSatisfy isTagText
467 st <- getState
483 st <- getState
468 case runParser (many pTagContents) st "text" str of
484 case runParser (many pTagContents) st "text" str of
469 Left _ -> fail $ "Could not parse `" ++ str ++ "'"
485 Left _ -> fail $ "Could not parse `" ++ str ++ "'"
470− Right result -> return result
486+ Right result -> return $ mconcat result
472pBlank :: TagParser ()
488pBlank :: TagParser ()
473pBlank = try $ do
489pBlank = try $ do
474 (TagText str) <- pSatisfy isTagText
490 (TagText str) <- pSatisfy isTagText
475 guard $ all isSpace str
491 guard $ all isSpace str
477−pTagContents :: Parser [Char] ParserState Inline
493+pTagContents :: Parser [Char] ParserState Inlines
478pTagContents =
494pTagContents =
479− Math DisplayMath `fmap` mathDisplay
495+ B.displayMath <$> mathDisplay
480− <|> Math InlineMath `fmap` mathInline
496+ <|> B.math <$> mathInline
482 <|> pSpace
498 <|> pSpace
483 <|> smartPunctuation pTagContents
499 <|> smartPunctuation pTagContents
484 <|> pSymbol
500 <|> pSymbol
487−pStr :: Parser [Char] ParserState Inline
503+pStr :: Parser [Char] ParserState Inlines
489 result <- many1 $ satisfy $ \c ->
505 result <- many1 $ satisfy $ \c ->
490 not (isSpace c) && not (isSpecial c) && not (isBad c)
506 not (isSpace c) && not (isSpecial c) && not (isBad c)
491 pos <- getPosition
507 pos <- getPosition
492 updateState $ \s -> s{ stateLastStrPos = Just pos }
508 updateState $ \s -> s{ stateLastStrPos = Just pos }
493− return $ Str result
509+ return $ B.str result
495isSpecial :: Char -> Bool
511isSpecial :: Char -> Bool
496isSpecial '"' = True
512isSpecial '"' = True
@@ -504,13 +520,13 @@ isSpecial '\8220' = True
504isSpecial '\8221' = True
520isSpecial '\8221' = True
505isSpecial _ = False
521isSpecial _ = False
507−pSymbol :: Parser [Char] ParserState Inline
523+pSymbol :: Parser [Char] ParserState Inlines
508−pSymbol = satisfy isSpecial >>= return . Str . (:[])
524+pSymbol = satisfy isSpecial >>= return . B.str . (:[])
510isBad :: Char -> Bool
526isBad :: Char -> Bool
511isBad c = c >= '\128' && c <= '\159' -- not allowed in HTML
527isBad c = c >= '\128' && c <= '\159' -- not allowed in HTML
513−pBad :: Parser [Char] ParserState Inline
529+pBad :: Parser [Char] ParserState Inlines
515 c <- satisfy isBad
531 c <- satisfy isBad
516 let c' = case c of
532 let c' = case c of
@@ -542,10 +558,10 @@ pBad = do
542 '\158' -> '\382'
558 '\158' -> '\382'
543 '\159' -> '\376'
559 '\159' -> '\376'
545− return $ Str [c']
561+ return $ B.str [c']
547−pSpace :: Parser [Char] ParserState Inline
563+pSpace :: Parser [Char] ParserState Inlines
548−pSpace = many1 (satisfy isSpace) >> return Space
564+pSpace = many1 (satisfy isSpace) >> return B.space
551-- Constants
567-- Constants
@@ -679,3 +695,4 @@ mkAttr attr = (attribsId, attribsClasses, attribsKV)
679 attribsClasses = words $ fromMaybe "" $ lookup "class" attr
695 attribsClasses = words $ fromMaybe "" $ lookup "class" attr
680 attribsKV = filter (\(k,_) -> k /= "class" && k /= "id") attr
696 attribsKV = filter (\(k,_) -> k /= "class" && k /= "id") attr