diff options
| -rw-r--r-- | src/Text/Pandoc/Readers/Docx.hs | 81 |
1 files changed, 36 insertions, 45 deletions
diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs index 6e9cf44b5..61c17156e 100644 --- a/src/Text/Pandoc/Readers/Docx.hs +++ b/src/Text/Pandoc/Readers/Docx.hs @@ -94,7 +94,6 @@ import System.FilePath (combine) import qualified Data.Map as M import Control.Monad.Reader import Control.Monad.State -import Control.Applicative (liftA2) readDocx :: ReaderOptions -> B.ByteString @@ -154,56 +153,48 @@ runStyleToContainers rPr = in classContainers ++ formatters -divAttrToContainers :: [String] -> [(String, String)] -> [Container Block] -divAttrToContainers (c:cs) _ | Just n <- isHeaderClass c = - [Container $ \_ -> - Header n ("", delete ("Heading" ++ show n) cs, []) []] -divAttrToContainers (c:cs) kvs | c `elem` divsToKeep = - (Container $ Div ("", [c], [])) : (divAttrToContainers cs kvs) -divAttrToContainers (c:cs) kvs | c `elem` codeDivs = +parStyleToContainers :: ParagraphStyle -> [Container Block] +parStyleToContainers pPr | (c:cs) <- pStyle pPr, Just n <- isHeaderClass c = + [Container $ \_ -> Header n ("", delete ("Heading" ++ show n) cs, []) []] +parStyleToContainers pPr | (c:cs) <- pStyle pPr, c `elem` divsToKeep = + let pPr' = pPr { pStyle = cs } + in + (Container $ Div ("", [c], [])) : (parStyleToContainers pPr') +parStyleToContainers pPr | (c:cs) <- pStyle pPr, c `elem` codeDivs = -- This is a bit of a cludge. We make the codeblock from the raw -- parparts in bodyPartToBlocks. But we need something to match against. - (Container $ \_ -> CodeBlock ("", [], []) "") : (divAttrToContainers cs kvs) -divAttrToContainers (c:cs) kvs | c `elem` listParagraphDivs = - let kvs' = filter (\(k,_) -> k /= "indent") kvs - in - (Container $ Div ("", [c], [])) : (divAttrToContainers cs kvs') -divAttrToContainers (c:cs) kvs | c `elem` blockQuoteDivs = - (Container BlockQuote) : (divAttrToContainers (cs \\ blockQuoteDivs) kvs) -divAttrToContainers (_:cs) kvs = divAttrToContainers cs kvs -divAttrToContainers [] kvs | Just _ <- lookup "indent" kvs - , Just flInd <- lookup "first-line-indent" kvs = - let - kvs' = filter (\(k,_) -> notElem k ["indent", "first-line-indent"]) kvs + let pPr' = pPr { pStyle = cs } in - case flInd of - "0" -> divAttrToContainers [] kvs' - ('-':_) -> divAttrToContainers [] kvs' - _ -> (Container BlockQuote) : divAttrToContainers [] kvs' -divAttrToContainers [] kvs | Just ind <- lookup "indent" kvs = - let - kvs' = filter (\(k,_) -> notElem k ["indent"]) kvs + (Container $ \_ -> CodeBlock ("", [], []) "") : (parStyleToContainers pPr') +parStyleToContainers pPr | (c:cs) <- pStyle pPr, c `elem` listParagraphDivs = + let pPr' = pPr { pStyle = cs, indentation = Nothing} in - case ind of - "0" -> divAttrToContainers [] kvs' - ('-':_) -> divAttrToContainers [] kvs' - _ -> (Container BlockQuote) : divAttrToContainers [] kvs' - -divAttrToContainers _ _ = [] + (Container $ Div ("", [c], [])) : (parStyleToContainers pPr') - -parStyleToContainers :: ParagraphStyle -> [Container Block] -parStyleToContainers pPr = - let classes = pStyle pPr - indent = indentation pPr >>= leftParIndent - hanging = indentation pPr >>= hangingParIndent - firstLineIndent = liftA2 (-) indent hanging - kvs = mapMaybe id - [ indent >>= (\n -> Just ("indent", show n)), - firstLineIndent >>= (\n -> Just ("first-line-indent", show n)) - ] +parStyleToContainers pPr | (c:cs) <- pStyle pPr, c `elem` blockQuoteDivs = + let pPr' = pPr { pStyle = cs \\ blockQuoteDivs } + in + (Container BlockQuote) : (parStyleToContainers pPr') +parStyleToContainers pPr | (_:cs) <- pStyle pPr = + let pPr' = pPr { pStyle = cs} + in + parStyleToContainers pPr' +parStyleToContainers pPr | null (pStyle pPr), + Just left <- indentation pPr >>= leftParIndent, + Just hang <- indentation pPr >>= hangingParIndent = + let pPr' = pPr { indentation = Nothing } + in + case (left - hang) > 0 of + True -> (Container BlockQuote) : (parStyleToContainers pPr') + False -> parStyleToContainers pPr' +parStyleToContainers pPr | null (pStyle pPr), + Just left <- indentation pPr >>= leftParIndent = + let pPr' = pPr { indentation = Nothing } in - divAttrToContainers classes kvs + case left > 0 of + True -> (Container BlockQuote) : (parStyleToContainers pPr') + False -> parStyleToContainers pPr' +parStyleToContainers _ = [] strToInlines :: String -> [Inline] |