git.iko.soy/typeable/pandoc
on master help sign in
Docx reader: add simple comment functionality.
8bb739fJesse Rosenthal
src/Text/Pandoc/Readers/Docx.hs+16
compare with master
unifiedsplit
@@ -339,6 +339,22 @@ parPartToInlines (Deletion _ author date runs) = do
339 ils <- smushInlines <$> mapM runToInlines runs
339 ils <- smushInlines <$> mapM runToInlines runs
340 let attr = ("", ["deletion"], [("author", author), ("date", date)])
340 let attr = ("", ["deletion"], [("author", author), ("date", date)])
341 return $ spanWith attr ils
341 return $ spanWith attr ils
342+parPartToInlines (CommentStart cmtId author date bodyParts) = do
343+ opts <- asks docxOptions
344+ case readerTrackChanges opts of
345+ AllChanges -> do
346+ blks <- smushBlocks <$> mapM bodyPartToBlocks bodyParts
347+ let ils = fromList $ blocksToInlines $ toList blks
348+ attr = ("", ["comment-start"], [("id", cmtId), ("author", author), ("date", date)])
349+ return $ spanWith attr ils
350+ _ -> return mempty
351+parPartToInlines (CommentEnd cmtId) = do
352+ opts <- asks docxOptions
353+ case readerTrackChanges opts of
354+ AllChanges -> do
355+ let attr = ("", ["comment-end"], [("id", cmtId)])
356+ return $ spanWith attr mempty
357+ _ -> return mempty
342parPartToInlines (BookMark _ anchor) | anchor `elem` dummyAnchors =
358parPartToInlines (BookMark _ anchor) | anchor `elem` dummyAnchors =
343 return mempty
359 return mempty
344parPartToInlines (BookMark _ anchor) =
360parPartToInlines (BookMark _ anchor) =
src/Text/Pandoc/Readers/Docx/Parse.hs+57−1
@@ -73,6 +73,7 @@ import Text.Pandoc.Readers.Docx.Util
73import Data.Char (readLitChar, ord, chr, isDigit)
73import Data.Char (readLitChar, ord, chr, isDigit)
74
74
75data ReaderEnv = ReaderEnv { envNotes :: Notes
75data ReaderEnv = ReaderEnv { envNotes :: Notes
76+ , envComments :: Comments
76 , envNumbering :: Numbering
77 , envNumbering :: Numbering
77 , envRelationships :: [Relationship]
78 , envRelationships :: [Relationship]
78 , envMedia :: Media
79 , envMedia :: Media
@@ -160,6 +161,9 @@ data Notes = Notes NameSpaces
160 (Maybe (M.Map String Element))
161 (Maybe (M.Map String Element))
161 deriving Show
162 deriving Show
162
163
164+data Comments = Comments NameSpaces (M.Map String Element)
165+ deriving Show
166+
163data ParIndentation = ParIndentation { leftParIndent :: Maybe Integer
167data ParIndentation = ParIndentation { leftParIndent :: Maybe Integer
164 , rightParIndent :: Maybe Integer
168 , rightParIndent :: Maybe Integer
165 , hangingParIndent :: Maybe Integer}
169 , hangingParIndent :: Maybe Integer}
@@ -210,6 +214,8 @@ type Extent = Maybe (Double, Double)
210data ParPart = PlainRun Run
214data ParPart = PlainRun Run
211 | Insertion ChangeId Author ChangeDate [Run]
215 | Insertion ChangeId Author ChangeDate [Run]
212 | Deletion ChangeId Author ChangeDate [Run]
216 | Deletion ChangeId Author ChangeDate [Run]
217+ | CommentStart CommentId Author CommentDate [BodyPart]
218+ | CommentEnd CommentId
213 | BookMark BookMarkId Anchor
219 | BookMark BookMarkId Anchor
214 | InternalHyperLink Anchor [Run]
220 | InternalHyperLink Anchor [Run]
215 | ExternalHyperLink URL [Run]
221 | ExternalHyperLink URL [Run]
@@ -259,8 +265,10 @@ type URL = String
259type BookMarkId = String
265type BookMarkId = String
260type RelId = String
266type RelId = String
261type ChangeId = String
267type ChangeId = String
268+type CommentId = String
262type Author = String
269type Author = String
263type ChangeDate = String
270type ChangeDate = String
271+type CommentDate = String
264
272
265archiveToDocx :: Archive -> Either DocxError Docx
273archiveToDocx :: Archive -> Either DocxError Docx
266archiveToDocx archive = fst <$> archiveToDocxWithWarnings archive
274archiveToDocx archive = fst <$> archiveToDocxWithWarnings archive
@@ -268,12 +276,13 @@ archiveToDocx archive = fst <$> archiveToDocxWithWarnings archive
268archiveToDocxWithWarnings :: Archive -> Either DocxError (Docx, [String])
276archiveToDocxWithWarnings :: Archive -> Either DocxError (Docx, [String])
269archiveToDocxWithWarnings archive = do
277archiveToDocxWithWarnings archive = do
270 let notes = archiveToNotes archive
278 let notes = archiveToNotes archive
279+ comments = archiveToComments archive
271 numbering = archiveToNumbering archive
280 numbering = archiveToNumbering archive
272 rels = archiveToRelationships archive
281 rels = archiveToRelationships archive
273 media = archiveToMedia archive
282 media = archiveToMedia archive
274 (styles, parstyles) = archiveToStyles archive
283 (styles, parstyles) = archiveToStyles archive
275 rEnv =
284 rEnv =
276− ReaderEnv notes numbering rels media Nothing styles parstyles InDocument
285+ ReaderEnv notes comments numbering rels media Nothing styles parstyles InDocument
277 rState = ReaderState { stateWarnings = [] }
286 rState = ReaderState { stateWarnings = [] }
278 (eitherDoc, st) = runD (archiveToDocument archive) rEnv rState
287 (eitherDoc, st) = runD (archiveToDocument archive) rEnv rState
279 case eitherDoc of
288 case eitherDoc of
@@ -384,6 +393,20 @@ archiveToNotes zf =
384 in
393 in
385 Notes ns fn en
394 Notes ns fn en
386
395
396+archiveToComments :: Archive -> Comments
397+archiveToComments zf =
398+ let cmtsElem = findEntryByPath "word/comments.xml" zf
399+ >>= (parseXMLDoc . UTF8.toStringLazy . fromEntry)
400+ cmts_namespaces = case cmtsElem of
401+ Just e -> elemToNameSpaces e
402+ Nothing -> []
403+ cmts = (elemToComments cmts_namespaces) <$> cmtsElem
404+ in
405+ case cmts of
406+ Just c -> Comments cmts_namespaces c
407+ Nothing -> Comments cmts_namespaces M.empty
408+
409+
387filePathToRelType :: FilePath -> Maybe DocumentLocation
410filePathToRelType :: FilePath -> Maybe DocumentLocation
388filePathToRelType "word/_rels/document.xml.rels" = Just InDocument
411filePathToRelType "word/_rels/document.xml.rels" = Just InDocument
389filePathToRelType "word/_rels/footnotes.xml.rels" = Just InFootnote
412filePathToRelType "word/_rels/footnotes.xml.rels" = Just InFootnote
@@ -504,6 +527,18 @@ elemToNotes ns notetype element
504 Just $ M.fromList $ pairs
527 Just $ M.fromList $ pairs
505elemToNotes _ _ _ = Nothing
528elemToNotes _ _ _ = Nothing
506
529
530+elemToComments :: NameSpaces -> Element -> M.Map String Element
531+elemToComments ns element
532+ | isElem ns "w" "comments" element =
533+ let pairs = mapMaybe
534+ (\e -> findAttr (elemName ns "w" "id") e >>=
535+ (\a -> Just (a, e)))
536+ (findChildren (elemName ns "w" "comment") element)
537+ in
538+ M.fromList $ pairs
539+elemToComments _ _ = M.empty
540+
541+
507---------------------------------------------
542---------------------------------------------
508---------------------------------------------
543---------------------------------------------
509
544
@@ -696,11 +731,32 @@ elemToParPart ns element
696 , Just anchor <- findAttr (elemName ns "w" "anchor") element = do
731 , Just anchor <- findAttr (elemName ns "w" "anchor") element = do
697 runs <- mapD (elemToRun ns) (elChildren element)
732 runs <- mapD (elemToRun ns) (elChildren element)
698 return $ InternalHyperLink anchor runs
733 return $ InternalHyperLink anchor runs
734+elemToParPart ns element
735+ | isElem ns "w" "commentRangeStart" element
736+ , Just cmtId <- findAttr (elemName ns "w" "id") element = do
737+ (Comments _ commentMap) <- asks envComments
738+ case M.lookup cmtId commentMap of
739+ Just cmtElem -> elemToCommentStart ns cmtElem
740+ Nothing -> throwError WrongElem
741+elemToParPart ns element
742+ | isElem ns "w" "commentRangeEnd" element
743+ , Just cmtId <- findAttr (elemName ns "w" "id") element =
744+ return $ CommentEnd cmtId
699elemToParPart ns element
745elemToParPart ns element
700 | isElem ns "m" "oMath" element =
746 | isElem ns "m" "oMath" element =
701 (eitherToD $ readOMML $ showElement element) >>= (return . PlainOMath)
747 (eitherToD $ readOMML $ showElement element) >>= (return . PlainOMath)
702elemToParPart _ _ = throwError WrongElem
748elemToParPart _ _ = throwError WrongElem
703
749
750+elemToCommentStart :: NameSpaces -> Element -> D ParPart
751+elemToCommentStart ns element
752+ | isElem ns "w" "comment" element
753+ , Just cmtId <- findAttr (elemName ns "w" "id") element
754+ , Just cmtAuthor <- findAttr (elemName ns "w" "author") element
755+ , Just cmtDate <- findAttr (elemName ns "w" "date") element = do
756+ bps <- mapD (elemToBodyPart ns) (elChildren element)
757+ return $ CommentStart cmtId cmtAuthor cmtDate bps
758+elemToCommentStart _ _ = throwError WrongElem
759+
704lookupFootnote :: String -> Notes -> Maybe Element
760lookupFootnote :: String -> Notes -> Maybe Element
705lookupFootnote s (Notes _ fns _) = fns >>= (M.lookup s)
761lookupFootnote s (Notes _ fns _) = fns >>= (M.lookup s)
706
762