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:
parent
3fbbafd391
commit
0abfd386a4
1 changed files with 36 additions and 45 deletions
|
@ -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]
|
||||
|
|
Loading…
Add table
Reference in a new issue