From a6fa3df1146f7aee4e3bfa4cf506ab44e38ecb35 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Fri, 28 Jan 2022 18:05:49 +0100 Subject: [PATCH] HTML writer: avoid duplicate "style" attributes on table cells Fixes: #7871 --- src/Text/Pandoc/CSS.hs | 6 ++--- src/Text/Pandoc/Writers/HTML.hs | 40 ++++++++++++++++++++++++--------- test/command/7871.md | 14 ++++++++++++ test/tables/nordics.html4 | 4 ++-- test/tables/nordics.html5 | 4 ++-- test/tables/planets.html4 | 12 +++++----- test/tables/planets.html5 | 12 +++++----- test/tables/students.html4 | 6 ++--- test/tables/students.html5 | 6 ++--- 9 files changed, 68 insertions(+), 36 deletions(-) create mode 100644 test/command/7871.md diff --git a/src/Text/Pandoc/CSS.hs b/src/Text/Pandoc/CSS.hs index ab31e3d5b..03065cc9b 100644 --- a/src/Text/Pandoc/CSS.hs +++ b/src/Text/Pandoc/CSS.hs @@ -18,6 +18,7 @@ module Text.Pandoc.CSS ) where +import Data.Either (fromRight) import Data.Maybe (mapMaybe, listToMaybe) import Data.Text (Text, pack) import Text.Pandoc.Shared (trim) @@ -37,10 +38,7 @@ styleAttrParser = many1 ruleParser -- Returns an empty list on failure. cssAttributes :: Text -> [(Text, Text)] cssAttributes styleString = - -- Use Data.Either.fromRight once GHC 8.0 is no longer supported - case parse styleAttrParser "" styleString of - Left _ -> [] - Right x -> x + fromRight [] $ parse styleAttrParser "" styleString -- | takes a list of keys/properties and a CSS string and -- returns the corresponding key-value-pairs. diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 79846736a..b1161fded 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -44,6 +44,7 @@ import Text.Blaze.Internal (MarkupM (Empty), customLeaf, customParent) import Text.DocTemplates (FromContext (lookupContext), Context (..)) import Text.Blaze.Html hiding (contents) import Text.Pandoc.Translations (Term(Abstract)) +import Text.Pandoc.CSS (cssAttributes) import Text.Pandoc.Definition import Text.Pandoc.Highlighting (formatHtmlBlock, formatHtmlInline, highlight, styleToCss) @@ -1282,29 +1283,48 @@ tableCellToHtml :: PandocMonad m tableCellToHtml opts ctype colAlign (Cell attr align rowspan colspan item) = do contents <- blockListToHtml opts item html5 <- gets stHtml5 + let (ident, cls, kvs) = attr let tag' = case ctype of BodyCell -> H.td HeaderCell -> H.th let align' = case align of AlignDefault -> colAlign _ -> align - let alignAttribs = case alignmentToString align' of - Nothing -> - mempty - Just alignStr -> - if html5 - then A.style (toValue $ "text-align: " <> alignStr <> ";") - else A.align (toValue alignStr) - otherAttribs <- attrsToHtml opts attr + let kvs' = case alignmentToString align' of + Nothing -> + kvs + Just alignStr -> + if html5 + then addStyle ("text-align", alignStr) kvs + else case break ((== "align") . fst) kvs of + (_, []) -> ("align", alignStr) : kvs + (xs, _:rest) -> xs ++ ("align", alignStr) : rest + otherAttribs <- attrsToHtml opts (ident, cls, kvs') let attribs = mconcat - $ alignAttribs - : colspanAttrib colspan + $ colspanAttrib colspan : rowspanAttrib rowspan : otherAttribs return $ do tag' ! attribs $ contents nl +-- | Adds a key-value pair to the @style@ attribute. +addStyle :: (Text, Text) -> [(Text, Text)] -> [(Text, Text)] +addStyle (key, value) kvs = + let cssToStyle = T.intercalate " " . map (\(k, v) -> k <> ": " <> v <> ";") + in case break ((== "style") . fst) kvs of + (_, []) -> + -- no style attribute yet, add new one + ("style", cssToStyle [(key, value)]) : kvs + (xs, (_,cssStyles):rest) -> + -- modify the style attribute + xs ++ ("style", cssToStyle modifiedCssStyles) : rest + where + modifiedCssStyles = + case break ((== key) . fst) $ cssAttributes cssStyles of + (cssAttribs, []) -> (key, value) : cssAttribs + (pre, _:post) -> pre ++ (key, value) : post + toListItems :: [Html] -> [Html] toListItems items = map toListItem items ++ [nl] diff --git a/test/command/7871.md b/test/command/7871.md new file mode 100644 index 000000000..94670f32b --- /dev/null +++ b/test/command/7871.md @@ -0,0 +1,14 @@ +``` +% pandoc -f html -t html + + +
a
+^D + + + + + + +
a
+``` diff --git a/test/tables/nordics.html4 b/test/tables/nordics.html4 index 841ab03e5..3cc94845c 100644 --- a/test/tables/nordics.html4 +++ b/test/tables/nordics.html4 @@ -51,8 +51,8 @@ Total -27,376,022 -1,258,336 +27,376,022 +1,258,336 diff --git a/test/tables/nordics.html5 b/test/tables/nordics.html5 index 0d639d4ea..dbc13d313 100644 --- a/test/tables/nordics.html5 +++ b/test/tables/nordics.html5 @@ -51,8 +51,8 @@ Total -27,376,022 -1,258,336 +27,376,022 +1,258,336 diff --git a/test/tables/planets.html4 b/test/tables/planets.html4 index 4435571b4..e0cd646d8 100644 --- a/test/tables/planets.html4 +++ b/test/tables/planets.html4 @@ -2,7 +2,7 @@

Data about the planets of our solar system.

- + Name Mass (10^24kg) Diameter (km) @@ -17,7 +17,7 @@ -Terrestrial planets +Terrestrial planets Mercury 0.330 4,879 @@ -66,8 +66,8 @@ The red planet -Jovian planets -Gas giants +Jovian planets +Gas giants Jupiter 1898 142,984 @@ -92,7 +92,7 @@ -Ice giants +Ice giants Uranus 86.8 51,118 @@ -117,7 +117,7 @@ -Dwarf planets +Dwarf planets Pluto 0.0146 2,370 diff --git a/test/tables/planets.html5 b/test/tables/planets.html5 index 1fee985b9..99aa0b04c 100644 --- a/test/tables/planets.html5 +++ b/test/tables/planets.html5 @@ -2,7 +2,7 @@

Data about the planets of our solar system.

- + Name Mass (10^24kg) Diameter (km) @@ -17,7 +17,7 @@ -Terrestrial planets +Terrestrial planets Mercury 0.330 4,879 @@ -66,8 +66,8 @@ The red planet -Jovian planets -Gas giants +Jovian planets +Gas giants Jupiter 1898 142,984 @@ -92,7 +92,7 @@ -Ice giants +Ice giants Uranus 86.8 51,118 @@ -117,7 +117,7 @@ -Dwarf planets +Dwarf planets Pluto 0.0146 2,370 diff --git a/test/tables/students.html4 b/test/tables/students.html4 index b02b0aba8..cbfffaa1e 100644 --- a/test/tables/students.html4 +++ b/test/tables/students.html4 @@ -12,7 +12,7 @@ -Computer Science +Computer Science @@ -30,7 +30,7 @@ -Russian Literature +Russian Literature @@ -40,7 +40,7 @@ -Astrophysics +Astrophysics diff --git a/test/tables/students.html5 b/test/tables/students.html5 index af9e088fb..a7e0127c8 100644 --- a/test/tables/students.html5 +++ b/test/tables/students.html5 @@ -12,7 +12,7 @@ -Computer Science +Computer Science @@ -30,7 +30,7 @@ -Russian Literature +Russian Literature @@ -40,7 +40,7 @@ -Astrophysics +Astrophysics