@@ -88,6 +88,9 @@ import qualified Data.ByteString as BS
8888import qualified Data.ByteString.Lazy as B
8989import Data.ByteString.Base64 (encode)
9090import System.FilePath (combine)
91+import qualified Data.Map as M
92+import Control.Monad.Reader
93+import Control.Monad.State
9194
9295readDocx :: ReaderOptions
9396 -> B.ByteString
@@ -97,11 +100,24 @@ readDocx opts bytes =
97100 Just docx -> Pandoc nullMeta (docxToBlocks opts docx)
98101 Nothing -> error $ "couldn't parse docx file"
99102
100−spansToKeep :: [String]
101−spansToKeep = []
102103
104+data DState = DState { docxHdrLinks :: M.Map String String }
105+
106+data DEnv = DEnv { docxOptions :: ReaderOptions
107+ , docxDocument :: Docx}
108+
109+type DocxContext = ReaderT DEnv (State DState)
110+
111+evalDocxContext :: DocxContext a -> DEnv -> DState -> a
112+evalDocxContext ctx env st = evalState (runReaderT ctx env) st
113+
114+concatMapM :: (Monad m) => (a -> m [b]) -> [a] -> m [b]
115+concatMapM f xs = liftM concat (mapM f xs)
103116
104117-- This is empty, but we put it in for future-proofing.
118+spansToKeep :: [String]
119+spansToKeep = []
120+
105121divsToKeep :: [String]
106122divsToKeep = ["list-item", "Definition", "DefinitionTerm"]
107123
@@ -213,57 +229,69 @@ inlineCodeContainer (Container f) = case f [] of
213229inlineCodeContainer _ = False
214230
215231
216−runToInlines :: ReaderOptions -> Docx -> Run -> [Inline]
217−runToInlines _ _ (Run rs runElems)
232+runToInlines :: Run -> DocxContext [Inline]
233+runToInlines (Run rs runElems)
218234 | any inlineCodeContainer (runStyleToContainers rs) =
235+ return $
219236 rebuild (runStyleToContainers rs) $ [Str $ runElemsToString runElems]
220237 | otherwise =
238+ return $
221239 rebuild (runStyleToContainers rs) (concatMap runElemToInlines runElems)
222−runToInlines opts docx@(Docx _ notes _ _ _ ) (Footnote fnId) =
240+runToInlines (Footnote fnId) = do
241+ (Docx _ notes _ _ _ ) <- asks docxDocument
223242 case (getFootNote fnId notes) of
224− Just bodyParts ->
225− [Note (concatMap (bodyPartToBlocks opts docx) bodyParts)]
226− Nothing ->
227− [Note []]
228−runToInlines opts docx@(Docx _ notes _ _ _) (Endnote fnId) =
243+ Just bodyParts -> do
244+ blks <- concatMapM bodyPartToBlocks bodyParts
245+ return $ [Note blks]
246+ Nothing -> return [Note []]
247+runToInlines (Endnote fnId) = do
248+ (Docx _ notes _ _ _ ) <- asks docxDocument
229249 case (getEndNote fnId notes) of
230− Just bodyParts ->
231− [Note (concatMap (bodyPartToBlocks opts docx) bodyParts)]
232− Nothing ->
233− [Note []]
234−
235−parPartToInlines :: ReaderOptions -> Docx -> ParPart -> [Inline]
236−parPartToInlines opts docx (PlainRun r) = runToInlines opts docx r
237−parPartToInlines opts docx (Insertion _ author date runs) =
250+ Just bodyParts -> do
251+ blks <- concatMapM bodyPartToBlocks bodyParts
252+ return $ [Note blks]
253+ Nothing -> return [Note []]
254+
255+parPartToInlines :: ParPart -> DocxContext [Inline]
256+parPartToInlines (PlainRun r) = runToInlines r
257+parPartToInlines (Insertion _ author date runs) = do
258+ opts <- asks docxOptions
238259 case readerTrackChanges opts of
239− AcceptChanges -> concatMap (runToInlines opts docx) runs
240− RejectChanges -> []
241− AllChanges ->
242− [Span
243− ("", ["insertion"], [("author", author), ("date", date)])
244− (concatMap (runToInlines opts docx) runs)]
245−parPartToInlines opts docx (Deletion _ author date runs) =
260+ AcceptChanges -> concatMapM runToInlines runs >>= return
261+ RejectChanges -> return []
262+ AllChanges -> do
263+ ils <- (concatMapM runToInlines runs)
264+ return [Span
265+ ("", ["insertion"], [("author", author), ("date", date)])
266+ ils]
267+parPartToInlines (Deletion _ author date runs) = do
268+ opts <- asks docxOptions
246269 case readerTrackChanges opts of
247− AcceptChanges -> []
248− RejectChanges -> concatMap (runToInlines opts docx) runs
249− AllChanges ->
250− [Span
251− ("", ["deletion"], [("author", author), ("date", date)])
252− (concatMap (runToInlines opts docx) runs)]
253−parPartToInlines _ _ (BookMark _ anchor) | anchor `elem` dummyAnchors = []
254−parPartToInlines _ _ (BookMark _ anchor) = [Span (anchor, ["anchor"], []) []]
255−parPartToInlines _ (Docx _ _ _ rels _) (Drawing relid) =
256− case lookupRelationship relid rels of
270+ AcceptChanges -> return []
271+ RejectChanges -> concatMapM runToInlines runs >>= return
272+ AllChanges -> do
273+ ils <- concatMapM runToInlines runs
274+ return [Span
275+ ("", ["deletion"], [("author", author), ("date", date)])
276+ ils]
277+parPartToInlines (BookMark _ anchor) | anchor `elem` dummyAnchors = return []
278+parPartToInlines (BookMark _ anchor) = return [Span (anchor, ["anchor"], []) []]
279+parPartToInlines (Drawing relid) = do
280+ (Docx _ _ _ rels _) <- asks docxDocument
281+ return $ case lookupRelationship relid rels of
257282 Just target -> [Image [] (combine "word" target, "")]
258283 Nothing -> [Image [] ("", "")]
259−parPartToInlines opts docx (InternalHyperLink anchor runs) =
260− [Link (concatMap (runToInlines opts docx) runs) ('#' : anchor, "")]
261−parPartToInlines opts docx@(Docx _ _ _ rels _) (ExternalHyperLink relid runs) =
262− case lookupRelationship relid rels of
284+parPartToInlines (InternalHyperLink anchor runs) = do
285+ ils <- concatMapM runToInlines runs
286+ return [Link ils ('#' : anchor, "")]
287+parPartToInlines (ExternalHyperLink relid runs) = do
288+ (Docx _ _ _ rels _) <- asks docxDocument
289+ rs <- concatMapM runToInlines runs
290+ return $ case lookupRelationship relid rels of
263291 Just target ->
264− [Link (concatMap (runToInlines opts docx) runs) (target, "")]
292+ [Link rs (target, "")]
265293 Nothing ->
266− [Link (concatMap (runToInlines opts docx) runs) ("", "")]
294+ [Link rs ("", "")]
267295
268296isAnchorSpan :: Inline -> Bool
269297isAnchorSpan (Span (ident, classes, kvs) ils) =
@@ -287,25 +315,18 @@ makeHeaderAnchors h@(Header n (_, classes, kvs) ils) =
287315 _ -> h
288316makeHeaderAnchors blk = blk
289317
290−parPartsToInlines :: ReaderOptions -> Docx -> [ParPart] -> [Inline]
291−parPartsToInlines opts docx parparts =
292− --
293− -- We're going to skip data-uri's for now. It should be an option,
294− -- not mandatory.
295− --
296− (if False -- TODO depend on option
297− then walk (makeImagesSelfContained docx)
298− else id) $
299− -- bottomUp spanTrim $
300− -- bottomUp spanCorrect $
301− -- bottomUp spanReduce $
302− reduceList $ concatMap (parPartToInlines opts docx) parparts
303−
304−cellToBlocks :: ReaderOptions -> Docx -> Cell -> [Block]
305−cellToBlocks opts docx (Cell bps) = concatMap (bodyPartToBlocks opts docx) bps
306−
307−rowToBlocksList :: ReaderOptions -> Docx -> Row -> [[Block]]
308−rowToBlocksList opts docx (Row cells) = map (cellToBlocks opts docx) cells
318+parPartsToInlines :: [ParPart] -> DocxContext [Inline]
319+parPartsToInlines parparts = do
320+ ils <- concatMapM parPartToInlines parparts >>=
321+ -- TODO: Option for self-containted images
322+ (if False then (walkM makeImagesSelfContained) else return)
323+ return $ reduceList $ ils
324+
325+cellToBlocks :: Cell -> DocxContext [Block]
326+cellToBlocks (Cell bps) = concatMapM bodyPartToBlocks bps
327+
328+rowToBlocksList :: Row -> DocxContext [[Block]]
329+rowToBlocksList (Row cells) = mapM cellToBlocks cells
309330
310331blockCodeContainer :: Container Block -> Bool
311332blockCodeContainer (Container f) = case f [] of
@@ -313,27 +334,32 @@ blockCodeContainer (Container f) = case f [] of
313334 _ -> False
314335blockCodeContainer _ = False
315336
316−bodyPartToBlocks :: ReaderOptions -> Docx -> BodyPart -> [Block]
317−bodyPartToBlocks _ _ (Paragraph pPr parparts)
337+bodyPartToBlocks :: BodyPart -> DocxContext [Block]
338+bodyPartToBlocks (Paragraph pPr parparts)
318339 | any blockCodeContainer (parStyleToContainers pPr) =
319340 let
320341 otherConts = filter (not . blockCodeContainer) (parStyleToContainers pPr)
321342 in
343+ return $
322344 rebuild
323345 otherConts
324346 [CodeBlock ("", [], []) (concatMap parPartToString parparts)]
325−bodyPartToBlocks opts docx (Paragraph pPr parparts) =
326− case parPartsToInlines opts docx parparts of
327− [] ->
328− []
329− _ ->
330− let parContents = parPartsToInlines opts docx parparts
331− trimmedContents = reverse $ dropWhile (Space ==) $ reverse $ dropWhile (Space ==) parContents
332− in
347+bodyPartToBlocks (Paragraph pPr parparts) = do
348+ ils <- parPartsToInlines parparts
349+ case ils of
350+ [] -> return []
351+ _ -> do
352+ parContents <- parPartsToInlines parparts
353+ let trimmedContents = reverse $
354+ dropWhile (Space ==) $
355+ reverse $
356+ dropWhile (Space ==) parContents
357+ return $
333358 rebuild
334359 (parStyleToContainers pPr)
335360 [Para trimmedContents]
336−bodyPartToBlocks opts docx@(Docx _ _ numbering _ _) (ListItem pPr numId lvl parparts) =
361+bodyPartToBlocks (ListItem pPr numId lvl parparts) = do
362+ (Docx _ _ numbering _ _) <- asks docxDocument
337363 let
338364 kvs = case lookupLevel numId lvl numbering of
339365 Just (_, fmt, txt, Just start) -> [ ("level", lvl)
@@ -349,23 +375,22 @@ bodyPartToBlocks opts docx@(Docx _ _ numbering _ _) (ListItem pPr numId lvl parp
349375 , ("text", txt)
350376 ]
351377 Nothing -> []
352− in
353− [Div
354− ("", ["list-item"], kvs)
355− (bodyPartToBlocks opts docx (Paragraph pPr parparts))]
356−bodyPartToBlocks _ _ (Tbl _ _ _ []) =
357− [Para []]
358−bodyPartToBlocks opts docx (Tbl cap _ look (r:rs)) =
378+ blks <- bodyPartToBlocks (Paragraph pPr parparts)
379+ return $ [Div ("", ["list-item"], kvs) blks]
380+bodyPartToBlocks (Tbl _ _ _ []) =
381+ return [Para []]
382+bodyPartToBlocks (Tbl cap _ look (r:rs)) = do
359383 let caption = strToInlines cap
360384 (hdr, rows) = case firstRowFormatting look of
361385 True -> (Just r, rs)
362386 False -> (Nothing, r:rs)
363− hdrCells = case hdr of
364− Just r' -> rowToBlocksList opts docx r'
365− Nothing -> []
366− cells = map (rowToBlocksList opts docx) rows
387+ hdrCells <- case hdr of
388+ Just r' -> rowToBlocksList r'
389+ Nothing -> return []
390+
391+ cells <- mapM rowToBlocksList rows
367392
368− size = case null hdrCells of
393+ let size = case null hdrCells of
369394 True -> length $ head cells
370395 False -> length $ hdrCells
371396 --
@@ -374,34 +399,42 @@ bodyPartToBlocks opts docx (Tbl cap _ look (r:rs)) =
374399 -- moment. Width information is in the TblGrid field of the Tbl,
375400 -- so should be possible. Alignment might be more difficult,
376401 -- since there doesn't seem to be a column entity in docx.
377− alignments = take size (repeat AlignDefault)
378− widths = take size (repeat 0) :: [Double]
379− in
380− [Table caption alignments widths hdrCells cells]
381−
382−
383−makeImagesSelfContained :: Docx -> Inline -> Inline
384−makeImagesSelfContained (Docx _ _ _ _ media) i@(Image alt (uri, title)) =
385− case lookup uri media of
386− Just bs -> case getMimeType uri of
387− Just mime -> let data_uri =
388− "data:" ++ mime ++ ";base64," ++ toString (encode $ BS.concat $ B.toChunks bs)
389− in
390− Image alt (data_uri, title)
391− Nothing -> i
402+ alignments = replicate size AlignDefault
403+ widths = replicate size 0 :: [Double]
404+
405+ return [Table caption alignments widths hdrCells cells]
406+
407+
408+makeImagesSelfContained :: Inline -> DocxContext Inline
409+makeImagesSelfContained i@(Image alt (uri, title)) = do
410+ (Docx _ _ _ _ media) <- asks docxDocument
411+ return $ case lookup uri media of
412+ Just bs ->
413+ case getMimeType uri of
414+ Just mime ->
415+ let data_uri = "data:" ++ mime ++ ";base64," ++
416+ toString (encode $ BS.concat $ B.toChunks bs)
417+ in
418+ Image alt (data_uri, title)
419+ Nothing -> i
392420 Nothing -> i
393−makeImagesSelfContained _ inline = inline
421+makeImagesSelfContained inline = return inline
394422
395−bodyToBlocks :: ReaderOptions -> Docx -> Body -> [Block]
396−bodyToBlocks opts docx (Body bps) =
397− map (makeHeaderAnchors) $
398− blocksToDefinitions $
399− blocksToBullets $
400− concatMap (bodyPartToBlocks opts docx) bps
423+bodyToBlocks :: Body -> DocxContext [Block]
424+bodyToBlocks (Body bps) = do
425+ blks <- concatMapM bodyPartToBlocks bps
426+ return $
427+ map (makeHeaderAnchors) $
428+ blocksToDefinitions $
429+ blocksToBullets $ blks
401430
402431docxToBlocks :: ReaderOptions -> Docx -> [Block]
403−docxToBlocks opts d@(Docx (Document _ body) _ _ _ _) = bodyToBlocks opts d body
404−
432+docxToBlocks opts d@(Docx (Document _ body) _ _ _ _) =
433+ let dState = DState { docxHdrLinks = M.empty }
434+ dEnv = DEnv { docxOptions = opts
435+ , docxDocument = d}
436+ in
437+ evalDocxContext (bodyToBlocks body) dEnv dState
405438
406439ilToCode :: Inline -> String
407440ilToCode (Str s) = s