Merge pull request #1540 from jkr/charStyles

Char styles

src/Text/Pandoc/Readers/Docx.hs

@@ -165,7 +165,7 @@ bodyPartsToMeta' (bp : bps)
   | (Paragraph pPr parParts) <- bp
   , (c : _)<- intersect (pStyle pPr) (M.keys metaStyles)
   , (Just metaField) <- M.lookup c metaStyles = do
-    inlines <- parPartsToInlines parParts
+    inlines <- concatReduce <$> mapM parPartToInlines parParts
     remaining <- bodyPartsToMeta' bps
     let
       f (MetaInlines ils) (MetaInlines ils') = MetaBlocks [Para ils, Para ils']
@@ -218,11 +218,8 @@ runElemToString (TextRun s) = s
 runElemToString (LnBrk) = ['\n']
 runElemToString (Tab) = ['\t']
 
-runElemsToString :: [RunElem] -> String
-runElemsToString = concatMap runElemToString
-
 runToString :: Run -> String
-runToString (Run _ runElems) = runElemsToString runElems
+runToString (Run _ runElems) = concatMap runElemToString runElems
 runToString _ = ""
 
 parPartToString :: ParPart -> String
@@ -242,14 +239,14 @@ runStyleToTransform rPr
   , s `elem` emphStyles =
     let rPr' = rPr{rStyle = Nothing, isItalic = Nothing}
     in
-     case isItalic rPr' of
+     case isItalic rPr of
        Just False -> runStyleToTransform rPr'
        _          -> emph . (runStyleToTransform rPr')
   | Just s <- rStyle rPr
   , s `elem` strongStyles =
     let rPr' = rPr{rStyle = Nothing, isBold = Nothing}
     in
-     case isItalic rPr' of
+     case isBold rPr of
        Just False -> runStyleToTransform rPr'
        _          -> strong . (runStyleToTransform rPr')
   | Just True <- isItalic rPr =
@@ -272,7 +269,7 @@ runToInlines :: Run -> DocxContext Inlines
 runToInlines (Run rs runElems)
   | Just s <- rStyle rs
   , s `elem` codeStyles =
-    return $ code $ runElemsToString runElems
+    return $ code $ concatMap runElemToString runElems
   | otherwise = do
     let ils = concatReduce (map runElemToInlines runElems)
     return $ (runStyleToTransform rs) ils
@@ -383,9 +380,6 @@ makeHeaderAnchor' (Header n (_, classes, kvs) ils) =
     return $ Header n (newIdent, classes, kvs) ils
 makeHeaderAnchor' blk = return blk
 
-parPartsToInlines :: [ParPart] -> DocxContext Inlines
-parPartsToInlines parparts = concatReduce <$> mapM parPartToInlines parparts
-
 cellToBlocks :: Cell -> DocxContext Blocks
 cellToBlocks (Cell bps) = concatReduce <$> mapM bodyPartToBlocks bps
 
@@ -447,12 +441,12 @@ bodyPartToBlocks (Paragraph pPr parparts)
   | (c : cs) <- filter (isJust . isHeaderClass) $ pStyle pPr
   , Just n <- isHeaderClass c = do
     ils <- local (\s-> s{docxInHeaderBlock=True}) $
-           (parPartsToInlines parparts)
+           (concatReduce <$> mapM parPartToInlines parparts)
 
     makeHeaderAnchor $
       headerWith ("", delete ("Heading" ++ show n) cs, []) n ils
   | otherwise = do
-    ils <- parPartsToInlines parparts >>=
+    ils <- concatReduce <$> mapM parPartToInlines parparts >>=
            (return . fromList . trimLineBreaks . normalizeSpaces . toList)
     dropIls <- gets docxDropCap
     let ils' = dropIls <> ils

tests/Tests/Readers/Docx.hs

@@ -102,6 +102,10 @@ tests = [ testGroup "inlines"
             "font formatting"
             "docx/inline_formatting.docx"
             "docx/inline_formatting.native"
+          , testCompare
+            "font formatting with character styles"
+            "docx/char_styles.docx"
+            "docx/char_styles.native"
           , testCompare
             "hyperlinks"
             "docx/links.docx"

tests/docx/char_styles.native

@@ -0,0 +1,4 @@
+[Para [Emph [Str "This",Space,Str "is",Space,Str "all",Space,Str "in",Space,Str "an"],Space,Emph [Strong [Str "italic",Space,Str "style"],Str "."]]
+,Para [Emph [Str "This",Space,Str "is",Space,Str "an",Space,Str "italic"],Space,Str "style",Space,Emph [Str "with",Space,Str "some"],Space,Str "words",Space,Emph [Str "unitalicized."]]
+,Para [Strong [Str "This",Space,Str "is",Space,Str "all",Space,Str "in",Space,Str "a",Space,Emph [Str "strong",Space,Str "style"],Str "."]]
+,Para [Strong [Str "This",Space,Str "is",Space,Str "a",Space,Str "strong"],Space,Str "style",Space,Strong [Str "with",Space,Str "some"],Space,Str "words",Space,Strong [Str "ubolded."]]]