37cadd5 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

HTML reader: parse attributes into table attributes.

37cadd5John MacFarlane7 years ago

src/Text/Pandoc/Readers/HTML.hs+18−14

compare with master

unifiedsplit

@@ -389,9 +389,8 @@ pDiv = try $ do

389 isDivLike "main" = True

390 isDivLike _ = False

391 TagOpen tag attr' <- lookAhead $ pSatisfy $ tagOpen isDivLike (const True)

392− let attr = toStringAttr attr'

392+ let (ident, classes, kvs) = toAttr attr'

393 contents <- pInTags tag block

394− let (ident, classes, kvs) = mkAttr attr

395 let classes' = if tag == "section"

394 let classes' = if tag == "section"

396 then "section":classes

395 then "section":classes

397 else classes

396 else classes

@@ -479,7 +478,8 @@ pHrule = do

479

478

480pTable :: PandocMonad m => TagParser m Blocks

479pTable :: PandocMonad m => TagParser m Blocks

481pTable = try $ do

480pTable = try $ do

482− TagOpen _ _ <- pSatisfy (matchTagOpen "table" [])

481+ TagOpen _ attribs' <- pSatisfy (matchTagOpen "table" [])

482+ let attribs = toAttr attribs'

483 skipMany pBlank

484 caption <- option mempty $ pInTags "caption" inline <* skipMany pBlank

485 widths' <- (mconcat <$> many1 pColgroup) <|> many pCol

@@ -518,7 +518,8 @@ pTable = try $ do

518 else widths'

519 let toRow = Row nullAttr . map B.simpleCell

520 toHeaderRow l = if null l then [] else [toRow l]

521+ return $ B.tableWith attribs

521− return $ B.table (B.simpleCaption $ B.plain caption)

522+ (B.simpleCaption $ B.plain caption)

522 (zip aligns widths)

523 (zip aligns widths)

523 (TableHead nullAttr $ toHeaderRow head')

524 (TableHead nullAttr $ toHeaderRow head')

524 [TableBody nullAttr 0 [] $ map toRow rows]

525 [TableBody nullAttr 0 [] $ map toRow rows]

@@ -619,7 +620,7 @@ pFigure = try $ do

619pCodeBlock :: PandocMonad m => TagParser m Blocks

620pCodeBlock :: PandocMonad m => TagParser m Blocks

620pCodeBlock = try $ do

621pCodeBlock = try $ do

621 TagOpen _ attr' <- pSatisfy (matchTagOpen "pre" [])

622 TagOpen _ attr' <- pSatisfy (matchTagOpen "pre" [])

622− let attr = toStringAttr attr'

623+ let attr = toAttr attr'

623 contents <- manyTill pAny (pCloses "pre" <|> eof)

624 contents <- manyTill pAny (pCloses "pre" <|> eof)

624 let rawText = T.concat $ map tagToText contents

625 let rawText = T.concat $ map tagToText contents

625 -- drop leading newline if any

626 -- drop leading newline if any

@@ -630,7 +631,7 @@ pCodeBlock = try $ do

630 let result = case T.unsnoc result' of

631 let result = case T.unsnoc result' of

631 Just (result'', '\n') -> result''

632 Just (result'', '\n') -> result''

632 _ -> result'

633 _ -> result'

633− return $ B.codeBlockWith (mkAttr attr) result

634+ return $ B.codeBlockWith attr result

634

635

635tagToText :: Tag Text -> Text

636tagToText :: Tag Text -> Text

636tagToText (TagText s) = s

637tagToText (TagText s) = s

@@ -731,7 +732,7 @@ pSpanLike =

731 where

732 where

732 parseTag tagName = do

733 parseTag tagName = do

733 TagOpen _ attrs <- pSatisfy $ tagOpenLit tagName (const True)

734 TagOpen _ attrs <- pSatisfy $ tagOpenLit tagName (const True)

734− let (ids, cs, kvs) = mkAttr . toStringAttr $ attrs

735+ let (ids, cs, kvs) = toAttr attrs

735 content <- mconcat <$> manyTill inline (pCloses tagName <|> eof)

736 content <- mconcat <$> manyTill inline (pCloses tagName <|> eof)

736 return $ B.spanWith (ids, tagName : cs, kvs) content

737 return $ B.spanWith (ids, tagName : cs, kvs) content

737

738

@@ -797,7 +798,7 @@ pCodeWithClass elemToClass = try $ do

797 let tagTest = flip elem . fmap fst $ elemToClass

798 let tagTest = flip elem . fmap fst $ elemToClass

798 TagOpen open attr' <- pSatisfy $ tagOpen tagTest (const True)

799 TagOpen open attr' <- pSatisfy $ tagOpen tagTest (const True)

799 result <- manyTill pAny (pCloses open)

800 result <- manyTill pAny (pCloses open)

800− let (ids,cs,kvs) = mkAttr . toStringAttr $ attr'

801+ let (ids,cs,kvs) = toAttr attr'

801 cs' = maybe cs (:cs) . lookup open $ elemToClass

802 cs' = maybe cs (:cs) . lookup open $ elemToClass

802 return . B.codeWith (ids,cs',kvs) .

803 return . B.codeWith (ids,cs',kvs) .

803 T.unwords . T.lines . innerText $ result

804 T.unwords . T.lines . innerText $ result

@@ -805,9 +806,9 @@ pCodeWithClass elemToClass = try $ do

805pCode :: PandocMonad m => TagParser m Inlines

806pCode :: PandocMonad m => TagParser m Inlines

806pCode = try $ do

807pCode = try $ do

807 (TagOpen open attr') <- pSatisfy $ tagOpen (`elem` ["code","tt"]) (const True)

808 (TagOpen open attr') <- pSatisfy $ tagOpen (`elem` ["code","tt"]) (const True)

808− let attr = toStringAttr attr'

809+ let attr = toAttr attr'

809 result <- manyTill pAny (pCloses open)

810 result <- manyTill pAny (pCloses open)

810− return $ B.codeWith (mkAttr attr) $ T.unwords $ T.lines $ innerText result

811+ return $ B.codeWith attr $ T.unwords $ T.lines $ innerText result

811

812

812-- https://developer.mozilla.org/en-US/docs/Web/HTML/Element/bdo

813-- https://developer.mozilla.org/en-US/docs/Web/HTML/Element/bdo

813-- Bidirectional Text Override

814-- Bidirectional Text Override

@@ -825,14 +826,14 @@ pSpan :: PandocMonad m => TagParser m Inlines

825pSpan = try $ do

826pSpan = try $ do

826 guardEnabled Ext_native_spans

827 guardEnabled Ext_native_spans

827 TagOpen _ attr' <- lookAhead $ pSatisfy $ tagOpen (=="span") (const True)

828 TagOpen _ attr' <- lookAhead $ pSatisfy $ tagOpen (=="span") (const True)

828− let attr = toStringAttr attr'

829+ let attr = toAttr attr'

829 contents <- pInTags "span" inline

830 contents <- pInTags "span" inline

830 let isSmallCaps = fontVariant == "small-caps" || "smallcaps" `elem` classes

831 let isSmallCaps = fontVariant == "small-caps" || "smallcaps" `elem` classes

831− where styleAttr = fromMaybe "" $ lookup "style" attr

832+ where styleAttr = fromMaybe "" $ lookup "style" attr'

832 fontVariant = fromMaybe "" $ pickStyleAttrProps ["font-variant"] styleAttr

833 fontVariant = fromMaybe "" $ pickStyleAttrProps ["font-variant"] styleAttr

833 classes = maybe []

834 classes = maybe []

834− T.words $ lookup "class" attr

835+ T.words $ lookup "class" attr'

835− let tag = if isSmallCaps then B.smallcaps else B.spanWith (mkAttr attr)

836+ let tag = if isSmallCaps then B.smallcaps else B.spanWith attr

836 return $ tag contents

837 return $ tag contents

837

838

838pRawHtmlInline :: PandocMonad m => TagParser m Inlines

839pRawHtmlInline :: PandocMonad m => TagParser m Inlines

@@ -1298,6 +1299,9 @@ mkAttr attr = (attribsId, attribsClasses, attribsKV)

1298 attribsKV = filter (\(k,_) -> k /= "class" && k /= "id") attr

1299 attribsKV = filter (\(k,_) -> k /= "class" && k /= "id") attr

1299 epubTypes = T.words $ fromMaybe "" $ lookup "epub:type" attr

1300 epubTypes = T.words $ fromMaybe "" $ lookup "epub:type" attr

1300

1301

1302+toAttr :: [(Text, Text)] -> Attr

1303+toAttr = mkAttr . toStringAttr

1304+

1301-- Strip namespace prefixes

1305-- Strip namespace prefixes

1302stripPrefixes :: [Tag Text] -> [Tag Text]

1306stripPrefixes :: [Tag Text] -> [Tag Text]

1303stripPrefixes = map stripPrefix

1307stripPrefixes = map stripPrefix