Docx reader: Avoid repeated spans in custom styles.

The previous commit had a bug where custom-style spans would be read
with every recurrsion. This fixes that, and changes the example given
in the manual.

3 files changed, 24 insertions, 15 deletions

diff --git a/MANUAL.txt b/MANUAL.txt
index a9e0863e0..d4a0c5e1d 100644
--- a/MANUAL.txt
+++ b/MANUAL.txt
@@ -4532,15 +4532,14 @@ Without the `+styles` extension:
 And with the extension:
 
     $ pandoc test/docx/custom-style-reference.docx -f docx+styles -t markdown
+
     ::: {custom-style="FirstParagraph"}
     This is some text.
     :::
 
     ::: {custom-style="BodyText"}
-    This is text with an
-    *[[emphasized]{custom-style="Emphatic"}]{custom-style="Emphatic"}* text
-    style. And this is text with a
-    **[[strengthened]{custom-style="Strengthened"}]{custom-style="Strengthened"}**
+    This is text with an *[emphasized]{custom-style="Emphatic"}* text style.
+    And this is text with a **[strengthened]{custom-style="Strengthened"}**
     text style.
     :::
 
diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs
index 491eea753..775fa1cdd 100644
--- a/src/Text/Pandoc/Readers/Docx.hs
+++ b/src/Text/Pandoc/Readers/Docx.hs
@@ -141,10 +141,12 @@ instance Default DState where
                }
 
 data DEnv = DEnv { docxOptions       :: ReaderOptions
-                 , docxInHeaderBlock :: Bool }
+                 , docxInHeaderBlock :: Bool
+                 , docxCustomStyleAlready :: Bool
+                 }
 
 instance Default DEnv where
-  def = DEnv def False
+  def = DEnv def False False
 
 type DocxContext m = ReaderT DEnv (StateT DState m)
 
@@ -281,8 +283,9 @@ resolveDependentRunStyle rPr
 extraRunStyleInfo :: PandocMonad m => RunStyle -> DocxContext m (Inlines -> Inlines)
 extraRunStyleInfo rPr
   | Just (s, _) <- rStyle rPr = do
+      already <- asks docxCustomStyleAlready
       opts <- asks docxOptions
-      return $ if isEnabled Ext_styles opts
+      return $ if isEnabled Ext_styles opts && not already
                then spanWith ("", [], [("custom-style", s)])
                else id
   | otherwise = return id
@@ -295,32 +298,39 @@ runStyleToTransform rPr
       transform <- runStyleToTransform rPr'
       return $ spanWith ("", [s], []) . transform
   | Just True <- isItalic rPr = do
-      transform <- runStyleToTransform rPr {isItalic = Nothing}
       extraInfo <- extraRunStyleInfo rPr
+      transform <- local (\e -> e{docxCustomStyleAlready = True}) $
+                   runStyleToTransform rPr {isItalic = Nothing}
       return $ emph . extraInfo . transform
   | Just True <- isBold rPr = do
-      transform <- runStyleToTransform rPr {isBold = Nothing}
       extraInfo <- extraRunStyleInfo rPr
+      transform <- local (\e -> e{docxCustomStyleAlready = True}) $
+                   runStyleToTransform rPr {isBold = Nothing}
       return $ strong . extraInfo . transform
   | Just True <- isSmallCaps rPr = do
-      transform <- runStyleToTransform rPr {isSmallCaps = Nothing}
       extraInfo <- extraRunStyleInfo rPr
+      transform <- local (\e -> e{docxCustomStyleAlready = True}) $
+                   runStyleToTransform rPr {isSmallCaps = Nothing}
       return $ smallcaps . extraInfo .transform
   | Just True <- isStrike rPr = do
-      transform <- runStyleToTransform rPr {isStrike = Nothing}
       extraInfo <- extraRunStyleInfo rPr
+      transform <- local (\e -> e{docxCustomStyleAlready = True}) $
+                   runStyleToTransform rPr {isStrike = Nothing}
       return $ strikeout . extraInfo . transform
   | Just SupScrpt <- rVertAlign rPr = do
-      transform <- runStyleToTransform rPr {rVertAlign = Nothing}
       extraInfo <- extraRunStyleInfo rPr
+      transform <- local (\e -> e{docxCustomStyleAlready = True}) $
+                   runStyleToTransform rPr {rVertAlign = Nothing}
       return $ superscript . extraInfo . transform
   | Just SubScrpt <- rVertAlign rPr = do
-      transform <- runStyleToTransform rPr {rVertAlign = Nothing}
       extraInfo <- extraRunStyleInfo rPr
+      transform <- local (\e -> e{docxCustomStyleAlready = True}) $
+                   runStyleToTransform rPr {rVertAlign = Nothing}
       return $ subscript . extraInfo . transform
   | Just "single" <- rUnderline rPr = do
-      transform <- runStyleToTransform rPr {rUnderline = Nothing}
       extraInfo <- extraRunStyleInfo rPr
+      transform <- local (\e -> e{docxCustomStyleAlready = True}) $
+                   runStyleToTransform rPr {rUnderline = Nothing}
       return $ underlineSpan . extraInfo . transform
   | otherwise = extraRunStyleInfo rPr
 
diff --git a/test/docx/custom-style-with-styles.native b/test/docx/custom-style-with-styles.native
index 146fea078..9547a261a 100644
--- a/test/docx/custom-style-with-styles.native
+++ b/test/docx/custom-style-with-styles.native
@@ -1,7 +1,7 @@
 [Div ("",[],[("custom-style","FirstParagraph")])
  [Para [Str "This",Space,Str "is",Space,Str "some",Space,Str "text."]]
 ,Div ("",[],[("custom-style","BodyText")])
- [Para [Str "This",Space,Str "is",Space,Str "text",Space,Str "with",Space,Str "an",Space,Emph [Span ("",[],[("custom-style","Emphatic")]) [Span ("",[],[("custom-style","Emphatic")]) [Str "emphasized"]]],Space,Str "text",Space,Str "style.",Space,Str "And",Space,Str "this",Space,Str "is",Space,Str "text",Space,Str "with",Space,Str "a",Space,Strong [Span ("",[],[("custom-style","Strengthened")]) [Span ("",[],[("custom-style","Strengthened")]) [Str "strengthened"]]],Space,Str "text",Space,Str "style."]]
+ [Para [Str "This",Space,Str "is",Space,Str "text",Space,Str "with",Space,Str "an",Space,Emph [Span ("",[],[("custom-style","Emphatic")]) [Str "emphasized"]],Space,Str "text",Space,Str "style.",Space,Str "And",Space,Str "this",Space,Str "is",Space,Str "text",Space,Str "with",Space,Str "a",Space,Strong [Span ("",[],[("custom-style","Strengthened")]) [Str "strengthened"]],Space,Str "text",Space,Str "style."]]
 ,Div ("",[],[("custom-style","MyBlockStyle")])
  [BlockQuote
   [Para [Str "Here",Space,Str "is",Space,Str "a",Space,Str "styled",Space,Str "paragraph",Space,Str "that",Space,Str "inherits",Space,Str "from",Space,Str "Block",Space,Str "Text."]]]]