Consistent underline for Readers (#2270)

hftf · jgm · commit 7f8a3c6cb70e · 2017-10-27T18:45:00.000-04:00
* Added underlineSpan builder function.  This can be easily updated if needed. The purpose is for Readers to transform underlines consistently.

* Docx Reader: Use underlineSpan and update test

* Org Reader: Use underlineSpan and add test

* Textile Reader: Use underlineSpan and add test case

* Txt2Tags Reader: Use underlineSpan and update test

* HTML Reader: Use underlineSpan and add test case
diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs
@@ -52,12 +52,13 @@ implemented, [-] means partially implemented):
 * Inlines
 
   - [X] Str
-  - [X] Emph (italics and underline both read as Emph)
+  - [X] Emph
   - [X] Strong
   - [X] Strikeout
   - [X] Superscript
   - [X] Subscript
   - [X] SmallCaps
+  - [-] Underline (was previously converted to Emph)
   - [ ] Quoted
   - [ ] Cite
   - [X] Code (styled with `VerbatimChar`)
@@ -287,7 +288,7 @@ runStyleToTransform rPr
   | Just SubScrpt <- rVertAlign rPr =
       subscript . (runStyleToTransform rPr {rVertAlign = Nothing})
   | Just "single" <- rUnderline rPr =
-      emph . (runStyleToTransform rPr {rUnderline = Nothing})
+      underlineSpan . (runStyleToTransform rPr {rUnderline = Nothing})
   | otherwise = id
 
 runToInlines :: PandocMonad m => Run -> DocxContext m Inlines
diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs
@@ -45,7 +45,7 @@ import Text.Pandoc.Definition
 import qualified Text.Pandoc.Builder as B
 import Text.Pandoc.Builder (Blocks, Inlines, trimInlines, HasMeta(..))
 import Text.Pandoc.Shared ( extractSpaces, addMetaField
-                          , escapeURI, safeRead, crFilter )
+                          , escapeURI, safeRead, crFilter, underlineSpan )
 import Text.Pandoc.Options (
          ReaderOptions(readerExtensions,readerStripComments), extensionEnabled,
          Extension (Ext_epub_html_exts,
@@ -627,6 +627,7 @@ inline = choice
            , pSuperscript
            , pSubscript
            , pStrikeout
+           , pUnderline
            , pLineBreak
            , pLink
            , pImage
@@ -696,6 +697,9 @@ pStrikeout = do
             contents <- mconcat <$> manyTill inline (pCloses "span")
             return $ B.strikeout contents)
 
+pUnderline :: PandocMonad m => TagParser m Inlines
+pUnderline = pInlinesInTags "u" underlineSpan <|> pInlinesInTags "ins" underlineSpan
+
 pLineBreak :: PandocMonad m => TagParser m Inlines
 pLineBreak = do
   pSelfClosing (=="br") (const True)
diff --git a/src/Text/Pandoc/Readers/Org/Inlines.hs b/src/Text/Pandoc/Readers/Org/Inlines.hs
@@ -45,6 +45,7 @@ import Text.Pandoc.Class (PandocMonad)
 import Text.Pandoc.Definition
 import Text.Pandoc.Options
 import Text.Pandoc.Readers.LaTeX (inlineCommand, rawLaTeXInline)
+import Text.Pandoc.Shared (underlineSpan)
 import Text.TeXMath (DisplayType (..), readTeX, writePandoc)
 import qualified Text.TeXMath.Readers.MathML.EntityMap as MathMLEntityMap
 
@@ -572,9 +573,8 @@ strong    = fmap B.strong       <$> emphasisBetween '*'
 strikeout :: PandocMonad m => OrgParser m (F Inlines)
 strikeout = fmap B.strikeout    <$> emphasisBetween '+'
 
--- There is no underline, so we use strong instead.
 underline :: PandocMonad m => OrgParser m (F Inlines)
-underline = fmap B.strong       <$> emphasisBetween '_'
+underline = fmap underlineSpan  <$> emphasisBetween '_'
 
 verbatim  :: PandocMonad m => OrgParser m (F Inlines)
 verbatim  = return . B.code     <$> verbatimBetween '='
diff --git a/src/Text/Pandoc/Readers/Textile.hs b/src/Text/Pandoc/Readers/Textile.hs
@@ -68,7 +68,7 @@ import Text.Pandoc.Options
 import Text.Pandoc.Parsing
 import Text.Pandoc.Readers.HTML (htmlTag, isBlockTag, isInlineTag)
 import Text.Pandoc.Readers.LaTeX (rawLaTeXBlock, rawLaTeXInline)
-import Text.Pandoc.Shared (trim, crFilter)
+import Text.Pandoc.Shared (trim, crFilter, underlineSpan)
 import Data.Text (Text)
 import qualified Data.Text as T
 
@@ -468,7 +468,7 @@ inlineMarkup = choice [ simpleInline (string "??") (B.cite [])
                       , simpleInline (string "__") B.emph
                       , simpleInline (char '*') B.strong
                       , simpleInline (char '_') B.emph
-                      , simpleInline (char '+') B.emph  -- approximates underline
+                      , simpleInline (char '+') underlineSpan
                       , simpleInline (char '-' <* notFollowedBy (char '-')) B.strikeout
                       , simpleInline (char '^') B.superscript
                       , simpleInline (char '~') B.subscript
diff --git a/src/Text/Pandoc/Readers/Txt2Tags.hs b/src/Text/Pandoc/Readers/Txt2Tags.hs
@@ -41,7 +41,7 @@ import qualified Text.Pandoc.Builder as B
 import Text.Pandoc.Definition
 import Text.Pandoc.Options
 import Text.Pandoc.Parsing hiding (space, spaces, uri)
-import Text.Pandoc.Shared (compactify, compactifyDL, escapeURI, crFilter)
+import Text.Pandoc.Shared (compactify, compactifyDL, escapeURI, crFilter, underlineSpan)
 import Control.Monad (guard, void, when)
 import Control.Monad.Reader (Reader, asks, runReader)
 import Data.Default
@@ -393,7 +393,7 @@ bold :: T2T Inlines
 bold = inlineMarkup inline B.strong '*' (B.str)
 
 underline :: T2T Inlines
-underline = inlineMarkup inline B.emph '_' (B.str)
+underline = inlineMarkup inline underlineSpan '_' (B.str)
 
 strike :: T2T Inlines
 strike = inlineMarkup inline B.strikeout '-' (B.str)
diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs
@@ -72,6 +72,7 @@ module Text.Pandoc.Shared (
                      addMetaField,
                      makeMeta,
                      eastAsianLineBreakFilter,
+                     underlineSpan,
                      -- * TagSoup HTML handling
                      renderTags',
                      -- * File handling
@@ -563,6 +564,13 @@ eastAsianLineBreakFilter = bottomUp go
                _ -> x:SoftBreak:y:zs
         go xs = xs
 
+-- | Builder for underline.
+-- This probably belongs in Builder.hs in pandoc-types.
+-- Will be replaced once Underline is an element.
+underlineSpan :: Inlines -> Inlines
+underlineSpan = B.spanWith ("", ["underline"], [])
+
+
 --
 -- TagSoup HTML handling
 --
diff --git a/test/Tests/Readers/Org.hs b/test/Tests/Readers/Org.hs
@@ -8,6 +8,7 @@ import Test.Tasty
 import Tests.Helpers
 import Text.Pandoc
 import Text.Pandoc.Builder
+import Text.Pandoc.Shared (underlineSpan)
 
 org :: Text -> Pandoc
 org = purely $ readOrg def{ readerExtensions = getDefaultExtensions "org" }
@@ -57,6 +58,10 @@ tests =
           " */super/*" =?>
           para (strong . emph $ "super")
 
+      , "Underline" =:
+          "_underline_" =?>
+          para (underlineSpan $ "underline")
+
       , "Strikeout" =:
           "+Kill Bill+" =?>
           para (strikeout . spcSep $ [ "Kill", "Bill" ])
diff --git a/test/Tests/Readers/Txt2Tags.hs b/test/Tests/Readers/Txt2Tags.hs
@@ -10,6 +10,7 @@ import Text.Pandoc
 import Text.Pandoc.Arbitrary ()
 import Text.Pandoc.Builder
 import Text.Pandoc.Class
+import Text.Pandoc.Shared (underlineSpan)
 
 t2t :: Text -> Pandoc
 -- t2t = handleError . readTxt2Tags (T2TMeta "date" "mtime" "in" "out") def
@@ -69,12 +70,12 @@ tests =
 
       , "Inline markup is greedy" =:
           "***** ///// _____ ----- ````` \"\"\"\"\" '''''" =?>
-          para (spcSep [strong "*", emph "/", emph "_"
+          para (spcSep [strong "*", emph "/", underlineSpan "_"
                        , strikeout "-", code "`", text "\""
                        , rawInline "html" "'"])
       , "Markup must be greedy" =:
           "**********    //////////    __________    ----------    ``````````   \"\"\"\"\"\"\"\"\"\"   ''''''''''" =?>
-                      para (spcSep [strong "******", emph "//////", emph "______"
+                      para (spcSep [strong "******", emph "//////", underlineSpan "______"
                        , strikeout "------", code "``````", text "\"\"\"\"\"\""
                        , rawInline "html" "''''''"])
       , "Inlines must be glued" =:
diff --git a/test/docx/inline_formatting.native b/test/docx/inline_formatting.native
@@ -1,5 +1,5 @@
 [Para [Str "Regular",Space,Str "text",Space,Emph [Str "italics"],Space,Strong [Str "bold",Space,Emph [Str "bold",Space,Str "italics"]],Str "."]
 ,Para [Str "This",Space,Str "is",Space,SmallCaps [Str "Small",Space,Str "Caps"],Str ",",Space,Str "and",Space,Str "this",Space,Str "is",Space,Strikeout [Str "strikethrough"],Str "."]
-,Para [Str "Some",Space,Str "people",Space,Str "use",Space,Emph [Str "single",Space,Str "underlines",Space,Str "for",Space,Emph [Str "emphasis"]],Str "."]
+,Para [Str "Some",Space,Str "people",Space,Str "use",Space,Span ("",["underline"],[]) [Str "single",Space,Str "underlines",Space,Str "for",Space,Emph [Str "emphasis"]],Str "."]
 ,Para [Str "Above",Space,Str "the",Space,Str "line",Space,Str "is",Space,Superscript [Str "superscript"],Space,Str "and",Space,Str "below",Space,Str "the",Space,Str "line",Space,Str "is",Space,Subscript [Str "subscript"],Str "."]
 ,Para [Str "A",Space,Str "line",LineBreak,Str "break."]]
diff --git a/test/html-reader.html b/test/html-reader.html
@@ -317,6 +317,8 @@ <h1>Inline Markup</h1>
 <p>So is <strong><em>this</em></strong> word.</p>
 <p>This is code: <code>&gt;</code>, <code>$</code>, <code>\</code>, <code>\$</code>, <code>&lt;html&gt;</code>.</p>
 <p>This is <span style="font-variant: small-caps;">small caps</span>.</p>
+<p>These are all underlined: <u>foo</u> and <ins>bar</ins>.</p>
+<p>These are all strikethrough: <s>foo</s>, <strike>bar</strike>, and <del>baz</del>.</p>
 <hr />
 <h1>Smart quotes, ellipses, dashes</h1>
 <p>"Hello," said the spider. "'Shelob' is my name."</p>
diff --git a/test/html-reader.native b/test/html-reader.native
@@ -207,6 +207,8 @@ Pandoc (Meta {unMeta = fromList [("generator",MetaInlines [Str "pandoc"]),("titl
 ,Para [Str "So",Space,Str "is",Space,Strong [Emph [Str "this"]],Space,Str "word."]
 ,Para [Str "This",Space,Str "is",Space,Str "code:",Space,Code ("",[],[]) ">",Str ",",Space,Code ("",[],[]) "$",Str ",",Space,Code ("",[],[]) "\\",Str ",",Space,Code ("",[],[]) "\\$",Str ",",Space,Code ("",[],[]) "<html>",Str "."]
 ,Para [Str "This",Space,Str "is",Space,SmallCaps [Str "small",Space,Str "caps"],Str "."]
+,Para [Str "These",Space,Str "are",Space,Str "all",Space,Str "underlined:",Space,Span ("",["underline"],[]) [Str "foo"],Space,Str "and",Space,Span ("",["underline"],[]) [Str "bar"],Str "."]
+,Para [Str "These",Space,Str "are",Space,Str "all",Space,Str "strikethrough:",Space,Strikeout [Str "foo"],Str ",",Space,Strikeout [Str "bar"],Str ",",Space,Str "and",Space,Strikeout [Str "baz"],Str "."]
 ,HorizontalRule
 ,Header 1 ("smart-quotes-ellipses-dashes",[],[]) [Str "Smart",Space,Str "quotes,",Space,Str "ellipses,",Space,Str "dashes"]
 ,Para [Str "\"Hello,\"",Space,Str "said",Space,Str "the",Space,Str "spider.",Space,Str "\"'Shelob'",Space,Str "is",Space,Str "my",Space,Str "name.\""]
diff --git a/test/textile-reader.native b/test/textile-reader.native
@@ -86,7 +86,7 @@ Pandoc (Meta {unMeta = fromList []})
  ,([Str "beer"],
    [[Plain [Str "fresh",Space,Str "and",Space,Str "bitter"]]])]
 ,Header 1 ("inline-markup",[],[]) [Str "Inline",Space,Str "Markup"]
-,Para [Str "This",Space,Str "is",Space,Emph [Str "emphasized"],Str ",",Space,Str "and",Space,Str "so",Space,Emph [Str "is",Space,Str "this"],Str ".",LineBreak,Str "This",Space,Str "is",Space,Strong [Str "strong"],Str ",",Space,Str "and",Space,Str "so",Space,Strong [Str "is",Space,Str "this"],Str ".",LineBreak,Str "Hyphenated-words-are-ok,",Space,Str "as",Space,Str "well",Space,Str "as",Space,Str "strange_underscore_notation.",LineBreak,Str "A",Space,Link ("",[],[]) [Strong [Str "strong",Space,Str "link"]] ("http://www.foobar.com",""),Str "."]
+,Para [Str "This",Space,Str "is",Space,Emph [Str "emphasized"],Str ",",Space,Str "and",Space,Str "so",Space,Emph [Str "is",Space,Str "this"],Str ".",LineBreak,Str "This",Space,Str "is",Space,Strong [Str "strong"],Str ",",Space,Str "and",Space,Str "so",Space,Strong [Str "is",Space,Str "this"],Str ".",LineBreak,Str "This",Space,Str "is",Space,Span ("",["underline"],[]) [Str "inserted"],Str ",",Space,Str "and",Space,Str "this",Space,Str "is",Space,Strikeout [Str "deleted"],Str ".",LineBreak,Str "Hyphenated-words-are-ok,",Space,Str "as",Space,Str "well",Space,Str "as",Space,Str "strange_underscore_notation.",LineBreak,Str "A",Space,Link ("",[],[]) [Strong [Str "strong",Space,Str "link"]] ("http://www.foobar.com",""),Str "."]
 ,Para [Emph [Strong [Str "This",Space,Str "is",Space,Str "strong",Space,Str "and",Space,Str "em."]],LineBreak,Str "So",Space,Str "is",Space,Strong [Emph [Str "this"]],Space,Str "word",Space,Str "and",Space,Emph [Strong [Str "that",Space,Str "one"]],Str ".",LineBreak,Strikeout [Str "This",Space,Str "is",Space,Str "strikeout",Space,Str "and",Space,Strong [Str "strong"]]]
 ,Para [Str "Superscripts:",Space,Str "a",Superscript [Str "bc"],Str "d",Space,Str "a",Space,Superscript [Strong [Str "hello"]],Space,Str "a",Superscript [Str "hello",Space,Str "there"],Str ".",LineBreak,Str "Subscripts:",Space,Subscript [Str "here"],Space,Str "H",Space,Subscript [Str "2"],Str "O,",Space,Str "H",Space,Subscript [Str "23"],Str "O,",Space,Str "H",Space,Subscript [Str "many",Space,Str "of",Space,Str "them"],Str "O."]
 ,Para [Str "Dashes",Space,Str ":",Space,Str "How",Space,Str "cool",Space,Str "\8212",Space,Str "automatic",Space,Str "dashes."]
diff --git a/test/textile-reader.textile b/test/textile-reader.textile
@@ -149,6 +149,7 @@ h1. Inline Markup
 
 This is _emphasized_, and so __is this__.
 This is *strong*, and so **is this**.
+This is +inserted+, and this is -deleted-.
 Hyphenated-words-are-ok, as well as strange_underscore_notation.
 A "*strong link*":http://www.foobar.com.
 
diff --git a/test/txt2tags.native b/test/txt2tags.native
