Docx reader: clean up parStyle processing.

This gets rid of `divAttrToContainers`: an internal convenience function
which had become pretty inconvenient. Rather than converting classes and
indentations to string lists and back, we deal with the `pPr` attribute
directly.
This commit is contained in:
Jesse Rosenthal 2014-06-30 11:19:06 -04:00
parent 3fbbafd391
commit 0abfd386a4

View file

@ -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
let pPr' = pPr { pStyle = cs }
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
(Container $ \_ -> CodeBlock ("", [], []) "") : (parStyleToContainers pPr')
parStyleToContainers pPr | (c:cs) <- pStyle pPr, c `elem` listParagraphDivs =
let pPr' = pPr { pStyle = cs, indentation = Nothing}
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
in
case ind of
"0" -> divAttrToContainers [] kvs'
('-':_) -> divAttrToContainers [] kvs'
_ -> (Container BlockQuote) : divAttrToContainers [] kvs'
(Container $ Div ("", [c], [])) : (parStyleToContainers pPr')
divAttrToContainers _ _ = []
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
divAttrToContainers classes kvs
(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
case left > 0 of
True -> (Container BlockQuote) : (parStyleToContainers pPr')
False -> parStyleToContainers pPr'
parStyleToContainers _ = []
strToInlines :: String -> [Inline]