diff options
| -rw-r--r-- | src/Text/Pandoc/Readers/Docx.hs | 20 | ||||
| -rw-r--r-- | tests/Tests/Readers/Docx.hs | 4 | ||||
| -rw-r--r-- | tests/docx/char_styles.docx | bin | 0 -> 30134 bytes | |||
| -rw-r--r-- | tests/docx/char_styles.native | 4 |
4 files changed, 15 insertions, 13 deletions
diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs index 823755a51..a1c16a03a 100644 --- a/src/Text/Pandoc/Readers/Docx.hs +++ b/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 diff --git a/tests/Tests/Readers/Docx.hs b/tests/Tests/Readers/Docx.hs index 0e0f6c2c5..234b1b5b7 100644 --- a/tests/Tests/Readers/Docx.hs +++ b/tests/Tests/Readers/Docx.hs @@ -103,6 +103,10 @@ tests = [ testGroup "inlines" "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" "docx/links.native" diff --git a/tests/docx/char_styles.docx b/tests/docx/char_styles.docx Binary files differnew file mode 100644 index 000000000..05979b9a7 --- /dev/null +++ b/tests/docx/char_styles.docx diff --git a/tests/docx/char_styles.native b/tests/docx/char_styles.native new file mode 100644 index 000000000..7dfc208fb --- /dev/null +++ b/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."]]] |