git.iko.soy/typeable/pandoc
on master help sign in
Docx Reader: Added Default instances and removed withDState
13f26afMatthew Pickering
src/Text/Pandoc/Readers/Docx.hs+23−28
compare with master
unifiedsplit
@@ -89,10 +89,12 @@ import Data.List (delete, stripPrefix, (\\), intersperse, intersect)
89import Data.Monoid
89import Data.Monoid
90import Text.TeXMath (writeTeX)
90import Text.TeXMath (writeTeX)
91import qualified Text.TeXMath.Types as TM
91import qualified Text.TeXMath.Types as TM
92+import Data.Default (Default)
92import qualified Data.ByteString.Lazy as B
93import qualified Data.ByteString.Lazy as B
93import qualified Data.Map as M
94import qualified Data.Map as M
94import Control.Monad.Reader
95import Control.Monad.Reader
95import Control.Monad.State
96import Control.Monad.State
97+import Control.Applicative ((<$>))
96
98
97readDocx :: ReaderOptions
99readDocx :: ReaderOptions
98 -> B.ByteString
100 -> B.ByteString
@@ -104,25 +106,19 @@ readDocx opts bytes =
104 Left _ -> error $ "couldn't parse docx file"
106 Left _ -> error $ "couldn't parse docx file"
105
107
106data DState = DState { docxAnchorMap :: M.Map String String
108data DState = DState { docxAnchorMap :: M.Map String String
107− , docxMediaBag :: MediaBag
109+ , docxMediaBag :: MediaBag }
108− , docxInHeaderBlock :: Bool}
109
110
110−defaultDState :: DState
111+instance Default DState where
111−defaultDState = DState { docxAnchorMap = M.empty
112+ def = DState { docxAnchorMap = M.empty
112− , docxMediaBag = mempty
113+ , docxMediaBag = mempty }
113− , docxInHeaderBlock = False}
114
114
115−data DEnv = DEnv { docxOptions :: ReaderOptions}
115+data DEnv = DEnv { docxOptions :: ReaderOptions
116+ , docxInHeaderBlock :: Bool }
116
117
117−type DocxContext = ReaderT DEnv (State DState)
118+instance Default DEnv where
119+ def = DEnv def False
118
120
119−withDState :: (DState -> DState) -> DocxContext a -> DocxContext a
121+type DocxContext = ReaderT DEnv (State DState)
120−withDState f dctx = do
121− ds <- get
122− modify f
123− ctx' <- dctx
124− put ds
125− return ctx'
126
122
127evalDocxContext :: DocxContext a -> DEnv -> DState -> a
123evalDocxContext :: DocxContext a -> DEnv -> DState -> a
128evalDocxContext ctx env st = evalState (runReaderT ctx env) st
124evalDocxContext ctx env st = evalState (runReaderT ctx env) st
@@ -161,7 +157,7 @@ isEmptyPar (Paragraph _ parParts) =
161 isEmptyElem (TextRun s) = trim s == ""
157 isEmptyElem (TextRun s) = trim s == ""
162 isEmptyElem _ = True
158 isEmptyElem _ = True
163isEmptyPar _ = False
159isEmptyPar _ = False
164−
160+
165bodyPartsToMeta' :: [BodyPart] -> DocxContext (M.Map String MetaValue)
161bodyPartsToMeta' :: [BodyPart] -> DocxContext (M.Map String MetaValue)
166bodyPartsToMeta' [] = return M.empty
162bodyPartsToMeta' [] = return M.empty
167bodyPartsToMeta' (bp : bps)
163bodyPartsToMeta' (bp : bps)
@@ -170,7 +166,7 @@ bodyPartsToMeta' (bp : bps)
170 , (Just metaField) <- M.lookup c metaStyles = do
166 , (Just metaField) <- M.lookup c metaStyles = do
171 inlines <- parPartsToInlines parParts
167 inlines <- parPartsToInlines parParts
172 remaining <- bodyPartsToMeta' bps
168 remaining <- bodyPartsToMeta' bps
173− let
169+ let
174 f (MetaInlines ils) (MetaInlines ils') = MetaBlocks [Para ils, Para ils']
170 f (MetaInlines ils) (MetaInlines ils') = MetaBlocks [Para ils, Para ils']
175 f (MetaInlines ils) (MetaBlocks blks) = MetaBlocks ((Para ils) : blks)
171 f (MetaInlines ils) (MetaBlocks blks) = MetaBlocks ((Para ils) : blks)
176 f m (MetaList mv) = MetaList (m : mv)
172 f m (MetaList mv) = MetaList (m : mv)
@@ -350,7 +346,7 @@ parPartToInlines (BookMark _ anchor) =
350 -- user-defined anchor links with header auto ids.
346 -- user-defined anchor links with header auto ids.
351 do
347 do
352 -- get whether we're in a header.
348 -- get whether we're in a header.
353− inHdrBool <- gets docxInHeaderBlock
349+ inHdrBool <- asks docxInHeaderBlock
354 -- Get the anchor map.
350 -- Get the anchor map.
355 anchorMap <- gets docxAnchorMap
351 anchorMap <- gets docxAnchorMap
356 -- We don't want to rewrite if we're in a header, since we'll take
352 -- We don't want to rewrite if we're in a header, since we'll take
@@ -365,7 +361,8 @@ parPartToInlines (BookMark _ anchor) =
365 if not inHdrBool && anchor `elem` (M.elems anchorMap)
361 if not inHdrBool && anchor `elem` (M.elems anchorMap)
366 then uniqueIdent [Str anchor] (M.elems anchorMap)
362 then uniqueIdent [Str anchor] (M.elems anchorMap)
367 else anchor
363 else anchor
364+ unless inHdrBool
368− modify $ \s -> s { docxAnchorMap = M.insert anchor newAnchor anchorMap}
365+ (modify $ \s -> s { docxAnchorMap = M.insert anchor newAnchor anchorMap})
369 return [Span (newAnchor, ["anchor"], []) []]
366 return [Span (newAnchor, ["anchor"], []) []]
370parPartToInlines (Drawing fp bs) = do
367parPartToInlines (Drawing fp bs) = do
371 mediaBag <- gets docxMediaBag
368 mediaBag <- gets docxMediaBag
@@ -509,7 +506,7 @@ oMathRunStyleToTextType mrPr
509 | Normal <- oMathRunTextStyle mrPr =
506 | Normal <- oMathRunTextStyle mrPr =
510 Just $ TM.TextNormal
507 Just $ TM.TextNormal
511 | Styled scr sty <- oMathRunTextStyle mrPr
508 | Styled scr sty <- oMathRunTextStyle mrPr
512− ,Just OBold <- sty
509+ ,Just OBold <- sty
513 , Just OSansSerif <- scr =
510 , Just OSansSerif <- scr =
514 Just $ TM.TextSansSerifBold
511 Just $ TM.TextSansSerifBold
515 | Styled scr sty <- oMathRunTextStyle mrPr
512 | Styled scr sty <- oMathRunTextStyle mrPr
@@ -555,7 +552,7 @@ oMathRunStyleToTextType mrPr
555 | otherwise = Nothing
552 | otherwise = Nothing
556
553
557
554
558−
555+
559baseToExp :: Base -> DocxContext TM.Exp
556baseToExp :: Base -> DocxContext TM.Exp
560baseToExp (Base mathElems) =
557baseToExp (Base mathElems) =
561 concatMapM oMathElemToExps mathElems >>= (return . TM.EGrouped)
558 concatMapM oMathElemToExps mathElems >>= (return . TM.EGrouped)
@@ -563,7 +560,7 @@ baseToExp (Base mathElems) =
563-- an ungrouped version of baseToExp
560-- an ungrouped version of baseToExp
564baseToExp' :: Base -> DocxContext [TM.Exp]
561baseToExp' :: Base -> DocxContext [TM.Exp]
565baseToExp' (Base mathElems) =
562baseToExp' (Base mathElems) =
566− concatMapM oMathElemToExps mathElems
563+ concatMapM oMathElemToExps mathElems
567
564
568
565
569isAnchorSpan :: Inline -> Bool
566isAnchorSpan :: Inline -> Bool
@@ -631,8 +628,8 @@ bodyPartToBlocks (Paragraph pPr parparts)
631 [CodeBlock ("", [], []) (concatMap parPartToString parparts)]
628 [CodeBlock ("", [], []) (concatMap parPartToString parparts)]
632bodyPartToBlocks (Paragraph pPr parparts)
629bodyPartToBlocks (Paragraph pPr parparts)
633 | any isHeaderContainer (parStyleToContainers pPr) = do
630 | any isHeaderContainer (parStyleToContainers pPr) = do
634− ils <-withDState (\s -> s{docxInHeaderBlock = True}) $
631+ ils <- normalizeSpaces <$> local (\s -> s{docxInHeaderBlock = True})
635− parPartsToInlines parparts >>= (return . normalizeSpaces)
632+ (parPartsToInlines parparts)
636 let (Container hdrFun) = head $ filter isHeaderContainer (parStyleToContainers pPr)
633 let (Container hdrFun) = head $ filter isHeaderContainer (parStyleToContainers pPr)
637 Header n attr _ = hdrFun []
634 Header n attr _ = hdrFun []
638 hdr <- makeHeaderAnchor $ Header n attr ils
635 hdr <- makeHeaderAnchor $ Header n attr ils
@@ -717,10 +714,8 @@ bodyToOutput (Body bps) = do
717
714
718docxToOutput :: ReaderOptions -> Docx -> (Meta, [Block], MediaBag)
715docxToOutput :: ReaderOptions -> Docx -> (Meta, [Block], MediaBag)
719docxToOutput opts (Docx (Document _ body)) =
716docxToOutput opts (Docx (Document _ body)) =
720− let dState = defaultDState
721− dEnv = DEnv { docxOptions = opts }
717+ let dEnv = def { docxOptions = opts} in
722− in
723− evalDocxContext (bodyToOutput body) dEnv dState
718+ evalDocxContext (bodyToOutput body) dEnv def
724
719
725
720
726ilToCode :: Inline -> String
721ilToCode :: Inline -> String