From ea85a797c24fa9f1335257cfb1a98241649f6e30 Mon Sep 17 00:00:00 2001 From: Jesse Rosenthal Date: Sun, 17 Aug 2014 08:38:17 -0400 Subject: Parser: Framework for parsing styles. We want to be able to read user-defined styles. Eventually we'll be able to figure out styles in terms of inheritance as well. The actual cascading will happen in the docx reader. --- src/Text/Pandoc/Readers/Docx/Parse.hs | 55 ++++++++++++++++++++++++++++------- 1 file changed, 44 insertions(+), 11 deletions(-) (limited to 'src/Text') diff --git a/src/Text/Pandoc/Readers/Docx/Parse.hs b/src/Text/Pandoc/Readers/Docx/Parse.hs index 1775a19c3..43c2459d1 100644 --- a/src/Text/Pandoc/Readers/Docx/Parse.hs +++ b/src/Text/Pandoc/Readers/Docx/Parse.hs @@ -50,7 +50,6 @@ module Text.Pandoc.Readers.Docx.Parse ( Docx(..) , Cell(..) , archiveToDocx ) where - import Codec.Archive.Zip import Text.XML.Light import Data.Maybe @@ -73,6 +72,7 @@ data ReaderEnv = ReaderEnv { envNotes :: Notes , envRelationships :: [Relationship] , envMedia :: Media , envFont :: Maybe Font + , envCharStyles :: CharStyles } deriving Show @@ -120,6 +120,8 @@ data Body = Body [BodyPart] type Media = [(FilePath, B.ByteString)] +type CharStyles = M.Map String RunStyle + data Numbering = Numbering NameSpaces [Numb] [AbstractNumb] deriving Show @@ -206,7 +208,7 @@ data RunStyle = RunStyle { isBold :: Maybe Bool , isStrike :: Maybe Bool , rVertAlign :: Maybe VertAlign , rUnderline :: Maybe String - , rStyle :: Maybe String } + , rStyle :: Maybe (String, Maybe RunStyle)} deriving Show defaultRunStyle :: RunStyle @@ -216,8 +218,7 @@ defaultRunStyle = RunStyle { isBold = Nothing , isStrike = Nothing , rVertAlign = Nothing , rUnderline = Nothing - , rStyle = Nothing - } + , rStyle = Nothing} type Target = String @@ -239,7 +240,8 @@ archiveToDocx archive = do numbering = archiveToNumbering archive rels = archiveToRelationships archive media = archiveToMedia archive - rEnv = ReaderEnv notes numbering rels media Nothing + styles = archiveToStyles archive + rEnv = ReaderEnv notes numbering rels media Nothing styles doc <- runD (archiveToDocument archive) rEnv return $ Docx doc @@ -259,6 +261,28 @@ elemToBody ns element | isElem ns "w" "body" element = (\bps -> return $ Body bps) elemToBody _ _ = throwError WrongElem +archiveToStyles :: Archive -> CharStyles +archiveToStyles zf = + let stylesElem = findEntryByPath "word/styles.xml" zf >>= + (parseXMLDoc . UTF8.toStringLazy . fromEntry) + in + case stylesElem of + Nothing -> M.empty + Just styElem -> + let namespaces = mapMaybe attrToNSPair (elAttribs styElem) + in + M.fromList $ mapMaybe (elemToCharStyle namespaces) (elChildren styElem) + +elemToCharStyle :: NameSpaces -> Element -> Maybe (String, RunStyle) +elemToCharStyle ns element + | isElem ns "w" "style" element + , Just "character" <- findAttr (elemName ns "w" "type") element + , Just styleId <- findAttr (elemName ns "w" "styleId") element + , isJust $ findChild (elemName ns "w" "rPr") element = + Just (styleId, elemToRunStyle ns element M.empty) + | otherwise = Nothing + + archiveToNotes :: Archive -> Notes archiveToNotes zf = let fnElem = findEntryByPath "word/footnotes.xml" zf @@ -629,7 +653,8 @@ elemToRun ns element elemToRun ns element | isElem ns "w" "r" element = do runElems <- elemToRunElems ns element - return $ Run (elemToRunStyle ns element) runElems + runStyle <- elemToRunStyleD ns element + return $ Run runStyle runElems elemToRun _ _ = throwError WrongElem elemToParagraphStyle :: NameSpaces -> Element -> ParagraphStyle @@ -669,9 +694,13 @@ checkOnOff ns rPr tag | Just _ <- findChild tag rPr = Just True checkOnOff _ _ _ = Nothing +elemToRunStyleD :: NameSpaces -> Element -> D RunStyle +elemToRunStyleD ns element = do + charStyles <- asks envCharStyles + return $ elemToRunStyle ns element charStyles -elemToRunStyle :: NameSpaces -> Element -> RunStyle -elemToRunStyle ns element +elemToRunStyle :: NameSpaces -> Element -> CharStyles -> RunStyle +elemToRunStyle ns element charStyles | Just rPr <- findChild (elemName ns "w" "rPr") element = RunStyle { @@ -690,10 +719,14 @@ elemToRunStyle ns element findChild (elemName ns "w" "u") rPr >>= findAttr (elemName ns "w" "val") , rStyle = - findChild (elemName ns "w" "rStyle") rPr >>= - findAttr (elemName ns "w" "val") + case + findChild (elemName ns "w" "rStyle") rPr >>= + findAttr (elemName ns "w" "val") + of + Just styName -> Just $ (styName, M.lookup styName charStyles) + _ -> Nothing } -elemToRunStyle _ _ = defaultRunStyle +elemToRunStyle _ _ _ = defaultRunStyle elemToRunElem :: NameSpaces -> Element -> D RunElem elemToRunElem ns element -- cgit v1.2.3 From 75eec0a6b8a4a65ae957fb416c0cdd2704b7739b Mon Sep 17 00:00:00 2001 From: Jesse Rosenthal Date: Sun, 17 Aug 2014 09:20:57 -0400 Subject: Docx reader: work with new rStyle. Just discards info at the moment, so at least it works the same. --- src/Text/Pandoc/Readers/Docx.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'src/Text') diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs index 3e4ac9647..e1a493028 100644 --- a/src/Text/Pandoc/Readers/Docx.hs +++ b/src/Text/Pandoc/Readers/Docx.hs @@ -230,19 +230,19 @@ parPartToString _ = "" runStyleToTransform :: RunStyle -> (Inlines -> Inlines) runStyleToTransform rPr - | Just s <- rStyle rPr + | Just (s, _) <- rStyle rPr , s `elem` spansToKeep = let rPr' = rPr{rStyle = Nothing} in (spanWith ("", [s], [])) . (runStyleToTransform rPr') - | Just s <- rStyle rPr + | Just (s, _) <- rStyle rPr , s `elem` emphStyles = let rPr' = rPr{rStyle = Nothing, isItalic = Nothing} in case isItalic rPr of Just False -> runStyleToTransform rPr' _ -> emph . (runStyleToTransform rPr') - | Just s <- rStyle rPr + | Just (s, _) <- rStyle rPr , s `elem` strongStyles = let rPr' = rPr{rStyle = Nothing, isBold = Nothing} in @@ -267,7 +267,7 @@ runStyleToTransform rPr runToInlines :: Run -> DocxContext Inlines runToInlines (Run rs runElems) - | Just s <- rStyle rs + | Just (s, _) <- rStyle rs , s `elem` codeStyles = return $ code $ concatMap runElemToString runElems | otherwise = do -- cgit v1.2.3 From c4871ac79050c22387e2ef67cd8dcb69745567df Mon Sep 17 00:00:00 2001 From: Jesse Rosenthal Date: Sun, 17 Aug 2014 10:19:48 -0400 Subject: Docx Style parser: Basic one now just takes a parent style. This will make it easier to build the style map from the bottom up (to avoid any infinite references). --- src/Text/Pandoc/Readers/Docx/Parse.hs | 28 +++++++++++++++------------- 1 file changed, 15 insertions(+), 13 deletions(-) (limited to 'src/Text') diff --git a/src/Text/Pandoc/Readers/Docx/Parse.hs b/src/Text/Pandoc/Readers/Docx/Parse.hs index 43c2459d1..b431f70bf 100644 --- a/src/Text/Pandoc/Readers/Docx/Parse.hs +++ b/src/Text/Pandoc/Readers/Docx/Parse.hs @@ -279,7 +279,7 @@ elemToCharStyle ns element , Just "character" <- findAttr (elemName ns "w" "type") element , Just styleId <- findAttr (elemName ns "w" "styleId") element , isJust $ findChild (elemName ns "w" "rPr") element = - Just (styleId, elemToRunStyle ns element M.empty) + Just (styleId, elemToRunStyle ns element Nothing) | otherwise = Nothing @@ -695,12 +695,20 @@ checkOnOff ns rPr tag checkOnOff _ _ _ = Nothing elemToRunStyleD :: NameSpaces -> Element -> D RunStyle -elemToRunStyleD ns element = do - charStyles <- asks envCharStyles - return $ elemToRunStyle ns element charStyles +elemToRunStyleD ns element + | Just rPr <- findChild (elemName ns "w" "rPr") element = do + charStyles <- asks envCharStyles + let parentSty = case + findChild (elemName ns "w" "rStyle") rPr >>= + findAttr (elemName ns "w" "val") + of + Just styName -> Just $ (styName, M.lookup styName charStyles) + _ -> Nothing + return $ elemToRunStyle ns element parentSty +elemToRunStyleD _ _ = return defaultRunStyle -elemToRunStyle :: NameSpaces -> Element -> CharStyles -> RunStyle -elemToRunStyle ns element charStyles +elemToRunStyle :: NameSpaces -> Element -> Maybe (String, Maybe RunStyle) -> RunStyle +elemToRunStyle ns element parentStyle | Just rPr <- findChild (elemName ns "w" "rPr") element = RunStyle { @@ -718,13 +726,7 @@ elemToRunStyle ns element charStyles , rUnderline = findChild (elemName ns "w" "u") rPr >>= findAttr (elemName ns "w" "val") - , rStyle = - case - findChild (elemName ns "w" "rStyle") rPr >>= - findAttr (elemName ns "w" "val") - of - Just styName -> Just $ (styName, M.lookup styName charStyles) - _ -> Nothing + , rStyle = parentStyle } elemToRunStyle _ _ _ = defaultRunStyle -- cgit v1.2.3 From b8f1658c368d952a3be51b70e167564f81624016 Mon Sep 17 00:00:00 2001 From: Jesse Rosenthal Date: Sun, 17 Aug 2014 11:30:22 -0400 Subject: Alias string and runStyle to CharStyle type. --- src/Text/Pandoc/Readers/Docx/Parse.hs | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) (limited to 'src/Text') diff --git a/src/Text/Pandoc/Readers/Docx/Parse.hs b/src/Text/Pandoc/Readers/Docx/Parse.hs index b431f70bf..bfeccd5a1 100644 --- a/src/Text/Pandoc/Readers/Docx/Parse.hs +++ b/src/Text/Pandoc/Readers/Docx/Parse.hs @@ -72,7 +72,7 @@ data ReaderEnv = ReaderEnv { envNotes :: Notes , envRelationships :: [Relationship] , envMedia :: Media , envFont :: Maybe Font - , envCharStyles :: CharStyles + , envCharStyles :: CharStyleMap } deriving Show @@ -120,7 +120,9 @@ data Body = Body [BodyPart] type Media = [(FilePath, B.ByteString)] -type CharStyles = M.Map String RunStyle +type CharStyle = (String, RunStyle) + +type CharStyleMap = M.Map String RunStyle data Numbering = Numbering NameSpaces [Numb] [AbstractNumb] deriving Show @@ -208,7 +210,7 @@ data RunStyle = RunStyle { isBold :: Maybe Bool , isStrike :: Maybe Bool , rVertAlign :: Maybe VertAlign , rUnderline :: Maybe String - , rStyle :: Maybe (String, Maybe RunStyle)} + , rStyle :: Maybe CharStyle} deriving Show defaultRunStyle :: RunStyle @@ -261,7 +263,7 @@ elemToBody ns element | isElem ns "w" "body" element = (\bps -> return $ Body bps) elemToBody _ _ = throwError WrongElem -archiveToStyles :: Archive -> CharStyles +archiveToStyles :: Archive -> CharStyleMap archiveToStyles zf = let stylesElem = findEntryByPath "word/styles.xml" zf >>= (parseXMLDoc . UTF8.toStringLazy . fromEntry) @@ -273,7 +275,7 @@ archiveToStyles zf = in M.fromList $ mapMaybe (elemToCharStyle namespaces) (elChildren styElem) -elemToCharStyle :: NameSpaces -> Element -> Maybe (String, RunStyle) +elemToCharStyle :: NameSpaces -> Element -> Maybe CharStyle elemToCharStyle ns element | isElem ns "w" "style" element , Just "character" <- findAttr (elemName ns "w" "type") element @@ -702,12 +704,13 @@ elemToRunStyleD ns element findChild (elemName ns "w" "rStyle") rPr >>= findAttr (elemName ns "w" "val") of - Just styName -> Just $ (styName, M.lookup styName charStyles) + Just styName | Just style <- M.lookup styName charStyles -> + Just (styName, style) _ -> Nothing return $ elemToRunStyle ns element parentSty elemToRunStyleD _ _ = return defaultRunStyle -elemToRunStyle :: NameSpaces -> Element -> Maybe (String, Maybe RunStyle) -> RunStyle +elemToRunStyle :: NameSpaces -> Element -> Maybe CharStyle -> RunStyle elemToRunStyle ns element parentStyle | Just rPr <- findChild (elemName ns "w" "rPr") element = RunStyle -- cgit v1.2.3 From 99491f0d988ea821580916d9566a3d2ab47fc236 Mon Sep 17 00:00:00 2001 From: Jesse Rosenthal Date: Sun, 17 Aug 2014 15:46:17 -0400 Subject: Docx Parse: build a bottom-up style tree. Two points here: (1) We're going bottom-up, from styles not based on anything, to avoid circular dependencies or any other sort of maliciousness/incompetence. And (2) each style points to its parent. That way, we don't need the whole tree to pass a style over to Docx.hs --- src/Text/Pandoc/Readers/Docx/Parse.hs | 37 +++++++++++++++++++++++++++++------ 1 file changed, 31 insertions(+), 6 deletions(-) (limited to 'src/Text') diff --git a/src/Text/Pandoc/Readers/Docx/Parse.hs b/src/Text/Pandoc/Readers/Docx/Parse.hs index bfeccd5a1..e7a6c3ffb 100644 --- a/src/Text/Pandoc/Readers/Docx/Parse.hs +++ b/src/Text/Pandoc/Readers/Docx/Parse.hs @@ -273,17 +273,42 @@ archiveToStyles zf = Just styElem -> let namespaces = mapMaybe attrToNSPair (elAttribs styElem) in - M.fromList $ mapMaybe (elemToCharStyle namespaces) (elChildren styElem) + M.fromList $ buildBasedOnList namespaces styElem Nothing -elemToCharStyle :: NameSpaces -> Element -> Maybe CharStyle -elemToCharStyle ns element +isBasedOnStyle :: NameSpaces -> Element -> Maybe CharStyle -> Bool +isBasedOnStyle ns element parentStyle | isElem ns "w" "style" element , Just "character" <- findAttr (elemName ns "w" "type") element - , Just styleId <- findAttr (elemName ns "w" "styleId") element - , isJust $ findChild (elemName ns "w" "rPr") element = - Just (styleId, elemToRunStyle ns element Nothing) + , Just basedOnVal <- findChild (elemName ns "w" "basedOn") element >>= + findAttr (elemName ns "w" "val") + , Just (parentId, _) <- parentStyle = (basedOnVal == parentId) + | isElem ns "w" "style" element + , Just "character" <- findAttr (elemName ns "w" "type") element + , Nothing <- findChild (elemName ns "w" "basedOn") element + , Nothing <- parentStyle = True + | otherwise = False + +elemToCharStyle :: NameSpaces -> Element -> Maybe CharStyle -> Maybe CharStyle +elemToCharStyle ns element parentStyle + | isElem ns "w" "style" element + , Just "character" <- findAttr (elemName ns "w" "type") element + , Just styleId <- findAttr (elemName ns "w" "styleId") element = + Just (styleId, elemToRunStyle ns element parentStyle) | otherwise = Nothing +getStyleChildren :: NameSpaces -> Element -> Maybe CharStyle -> [CharStyle] +getStyleChildren ns element parentStyle + | isElem ns "w" "styles" element = + mapMaybe (\e -> elemToCharStyle ns e parentStyle) $ + filterChildren (\e' -> isBasedOnStyle ns e' parentStyle) element + | otherwise = [] + +buildBasedOnList :: NameSpaces -> Element -> Maybe CharStyle -> [CharStyle] +buildBasedOnList ns element rootStyle = + case (getStyleChildren ns element rootStyle) of + [] -> [] + stys -> stys ++ + (concatMap (\s -> buildBasedOnList ns element (Just s)) stys) archiveToNotes :: Archive -> Notes archiveToNotes zf = -- cgit v1.2.3 From 03d5d8e596551d7454a35bb272a3439967181776 Mon Sep 17 00:00:00 2001 From: Jesse Rosenthal Date: Sun, 17 Aug 2014 16:54:11 -0400 Subject: Docx Reader: Introduce function for resolving dependent run styles. We always favor an explicit positive or negative in a style in a descendent, and only turn to the ancestor if nothing is set. We also introduce an (empty) list of styles that are black-listed. We won't check them. (Think underlines in hyperlinks). --- src/Text/Pandoc/Readers/Docx.hs | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) (limited to 'src/Text') diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs index e1a493028..0c2cf064f 100644 --- a/src/Text/Pandoc/Readers/Docx.hs +++ b/src/Text/Pandoc/Readers/Docx.hs @@ -228,6 +228,37 @@ parPartToString (InternalHyperLink _ runs) = concatMap runToString runs parPartToString (ExternalHyperLink _ runs) = concatMap runToString runs parPartToString _ = "" +blacklistedCharStyles :: [String] +blacklistedCharStyles = [] + +resolveDependentRunStyle :: RunStyle -> RunStyle +resolveDependentRunStyle rPr + | Just (s, _) <- rStyle rPr, s `elem` blacklistedCharStyles = + rPr{rStyle = Nothing} + | Just (_, cs) <- rStyle rPr = + let rPr' = resolveDependentRunStyle cs + in + RunStyle { isBold = case isBold rPr of + Just bool -> Just bool + Nothing -> isBold rPr' + , isItalic = case isItalic rPr of + Just bool -> Just bool + Nothing -> isItalic rPr' + , isSmallCaps = case isSmallCaps rPr of + Just bool -> Just bool + Nothing -> isSmallCaps rPr' + , isStrike = case isStrike rPr of + Just bool -> Just bool + Nothing -> isStrike rPr' + , rVertAlign = case rVertAlign rPr of + Just valign -> Just valign + Nothing -> rVertAlign rPr' + , rUnderline = case rUnderline rPr of + Just ulstyle -> Just ulstyle + Nothing -> rUnderline rPr' + , rStyle = Nothing } + | otherwise = rPr{rStyle = Nothing} + runStyleToTransform :: RunStyle -> (Inlines -> Inlines) runStyleToTransform rPr | Just (s, _) <- rStyle rPr -- cgit v1.2.3 From 15ce28b8caa5f3e71d518a231cc87a319a314400 Mon Sep 17 00:00:00 2001 From: Jesse Rosenthal Date: Sun, 17 Aug 2014 17:03:44 -0400 Subject: Docx reader: Use style resolver. We now no longer check against explicit styles. --- src/Text/Pandoc/Readers/Docx.hs | 32 +++++++++----------------------- 1 file changed, 9 insertions(+), 23 deletions(-) (limited to 'src/Text') diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs index 0c2cf064f..5e00e9996 100644 --- a/src/Text/Pandoc/Readers/Docx.hs +++ b/src/Text/Pandoc/Readers/Docx.hs @@ -256,8 +256,8 @@ resolveDependentRunStyle rPr , rUnderline = case rUnderline rPr of Just ulstyle -> Just ulstyle Nothing -> rUnderline rPr' - , rStyle = Nothing } - | otherwise = rPr{rStyle = Nothing} + , rStyle = rStyle rPr } + | otherwise = rPr runStyleToTransform :: RunStyle -> (Inlines -> Inlines) runStyleToTransform rPr @@ -266,34 +266,20 @@ runStyleToTransform rPr let rPr' = rPr{rStyle = Nothing} in (spanWith ("", [s], [])) . (runStyleToTransform rPr') - | Just (s, _) <- rStyle rPr - , s `elem` emphStyles = - let rPr' = rPr{rStyle = Nothing, isItalic = Nothing} - in - 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 isBold rPr of - Just False -> runStyleToTransform rPr' - _ -> strong . (runStyleToTransform rPr') | Just True <- isItalic rPr = emph . (runStyleToTransform rPr {isItalic = Nothing}) | Just True <- isBold rPr = - strong . (runStyleToTransform rPr {isBold = Nothing}) + strong . (runStyleToTransform rPr {isBold = Nothing}) | Just True <- isSmallCaps rPr = - smallcaps . (runStyleToTransform rPr {isSmallCaps = Nothing}) + smallcaps . (runStyleToTransform rPr {isSmallCaps = Nothing}) | Just True <- isStrike rPr = - strikeout . (runStyleToTransform rPr {isStrike = Nothing}) + strikeout . (runStyleToTransform rPr {isStrike = Nothing}) | Just SupScrpt <- rVertAlign rPr = - superscript . (runStyleToTransform rPr {rVertAlign = Nothing}) + superscript . (runStyleToTransform rPr {rVertAlign = Nothing}) | Just SubScrpt <- rVertAlign rPr = - subscript . (runStyleToTransform rPr {rVertAlign = Nothing}) + subscript . (runStyleToTransform rPr {rVertAlign = Nothing}) | Just "single" <- rUnderline rPr = - emph . (runStyleToTransform rPr {rUnderline = Nothing}) + emph . (runStyleToTransform rPr {rUnderline = Nothing}) | otherwise = id runToInlines :: Run -> DocxContext Inlines @@ -303,7 +289,7 @@ runToInlines (Run rs runElems) return $ code $ concatMap runElemToString runElems | otherwise = do let ils = concatReduce (map runElemToInlines runElems) - return $ (runStyleToTransform rs) ils + return $ (runStyleToTransform $ resolveDependentRunStyle rs) ils runToInlines (Footnote bps) = do blksList <- concatReduce <$> (mapM bodyPartToBlocks bps) return $ note blksList -- cgit v1.2.3 From 9da7b0946eed1ad5c7a781cbf765cc6fcd67afd9 Mon Sep 17 00:00:00 2001 From: Jesse Rosenthal Date: Sun, 17 Aug 2014 17:04:14 -0400 Subject: Docx reader: Add "Hyperlink" to blacklisted styles. This is the only one so far. We'll add others as they show up. --- src/Text/Pandoc/Readers/Docx.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/Text') diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs index 5e00e9996..653439de1 100644 --- a/src/Text/Pandoc/Readers/Docx.hs +++ b/src/Text/Pandoc/Readers/Docx.hs @@ -229,12 +229,12 @@ parPartToString (ExternalHyperLink _ runs) = concatMap runToString runs parPartToString _ = "" blacklistedCharStyles :: [String] -blacklistedCharStyles = [] +blacklistedCharStyles = ["Hyperlink"] resolveDependentRunStyle :: RunStyle -> RunStyle resolveDependentRunStyle rPr | Just (s, _) <- rStyle rPr, s `elem` blacklistedCharStyles = - rPr{rStyle = Nothing} + rPr | Just (_, cs) <- rStyle rPr = let rPr' = resolveDependentRunStyle cs in -- cgit v1.2.3 From 198aea190fe24dfbc05c5c61e28322cbd4da2adc Mon Sep 17 00:00:00 2001 From: Jesse Rosenthal Date: Sun, 17 Aug 2014 17:04:55 -0400 Subject: Docx reader: remove emph styles and strong styles list. We no longer need the explicit lists since we're deriving them from the ground up. --- src/Text/Pandoc/Readers/Docx.hs | 6 ------ 1 file changed, 6 deletions(-) (limited to 'src/Text') diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs index 653439de1..319e95610 100644 --- a/src/Text/Pandoc/Readers/Docx.hs +++ b/src/Text/Pandoc/Readers/Docx.hs @@ -196,12 +196,6 @@ fixAuthors mv = mv codeStyles :: [String] codeStyles = ["VerbatimChar"] -strongStyles :: [String] -strongStyles = ["Strong", "Bold"] - -emphStyles :: [String] -emphStyles = ["Emphasis", "Italic"] - blockQuoteDivs :: [String] blockQuoteDivs = ["Quote", "BlockQuote", "BlockQuotation"] -- cgit v1.2.3 From 4b38e9f1f0d12e46c27fd3782d8f3e32d8ee90a0 Mon Sep 17 00:00:00 2001 From: Jesse Rosenthal Date: Sun, 17 Aug 2014 20:11:50 -0400 Subject: Docx reader: whitespace fix. --- src/Text/Pandoc/Readers/Docx.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'src/Text') diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs index 319e95610..188fa4a42 100644 --- a/src/Text/Pandoc/Readers/Docx.hs +++ b/src/Text/Pandoc/Readers/Docx.hs @@ -263,17 +263,17 @@ runStyleToTransform rPr | Just True <- isItalic rPr = emph . (runStyleToTransform rPr {isItalic = Nothing}) | Just True <- isBold rPr = - strong . (runStyleToTransform rPr {isBold = Nothing}) + strong . (runStyleToTransform rPr {isBold = Nothing}) | Just True <- isSmallCaps rPr = - smallcaps . (runStyleToTransform rPr {isSmallCaps = Nothing}) + smallcaps . (runStyleToTransform rPr {isSmallCaps = Nothing}) | Just True <- isStrike rPr = - strikeout . (runStyleToTransform rPr {isStrike = Nothing}) + strikeout . (runStyleToTransform rPr {isStrike = Nothing}) | Just SupScrpt <- rVertAlign rPr = - superscript . (runStyleToTransform rPr {rVertAlign = Nothing}) + superscript . (runStyleToTransform rPr {rVertAlign = Nothing}) | Just SubScrpt <- rVertAlign rPr = - subscript . (runStyleToTransform rPr {rVertAlign = Nothing}) + subscript . (runStyleToTransform rPr {rVertAlign = Nothing}) | Just "single" <- rUnderline rPr = - emph . (runStyleToTransform rPr {rUnderline = Nothing}) + emph . (runStyleToTransform rPr {rUnderline = Nothing}) | otherwise = id runToInlines :: Run -> DocxContext Inlines -- cgit v1.2.3