@@ -75,6 +75,7 @@ data ReaderEnv = ReaderEnv { envNotes :: Notes
7575 , envFont :: Maybe Font
7676 , envCharStyles :: CharStyleMap
7777 , envParStyles :: ParStyleMap
78+ , envLocation :: DocumentLocation
7879 }
7980 deriving Show
8081
@@ -87,7 +88,7 @@ instance Error DocxError where
8788type D = ExceptT DocxError (Reader ReaderEnv)
8889
8990runD :: D a -> ReaderEnv -> Either DocxError a
90−runD dx re = runReader (runExceptT dx ) re
91+runD dx re = runReader (runExceptT dx) re
9192
9293maybeToD :: Maybe a -> D a
9394maybeToD (Just a) = return a
@@ -140,7 +141,13 @@ data AbstractNumb = AbstractNumb String [Level]
140141-- (ilvl, format, string, start)
141142type Level = (String, String, String, Maybe Integer)
142143
143−data Relationship = Relationship (RelId, Target)
144+data DocumentLocation = InDocument | InFootnote | InEndnote
145+ deriving (Eq,Show)
146+
147+-- data RelationshipType = DocumentRel | FootnoteRel | EndnoteRel
148+-- deriving Show
149+
150+data Relationship = Relationship DocumentLocation RelId Target
144151 deriving Show
145152
146153data Notes = Notes NameSpaces
@@ -255,7 +262,8 @@ archiveToDocx archive = do
255262 rels = archiveToRelationships archive
256263 media = archiveToMedia archive
257264 (styles, parstyles) = archiveToStyles archive
258− rEnv = ReaderEnv notes numbering rels media Nothing styles parstyles
265+ rEnv =
266+ ReaderEnv notes numbering rels media Nothing styles parstyles InDocument
259267 doc <- runD (archiveToDocument archive) rEnv
260268 return $ Docx doc
261269
@@ -362,29 +370,30 @@ archiveToNotes zf =
362370 in
363371 Notes ns fn en
364372
365−filePathIsRel :: FilePath -> Bool
366−filePathIsRel fp =
367− let (dir, name) = splitFileName fp
368− in
369− (dir == "word/_rels/") && ((takeExtension name) == ".rels")
373+filePathToRelType :: FilePath -> Maybe DocumentLocation
374+filePathToRelType "word/_rels/document.xml.rels" = Just InDocument
375+filePathToRelType "word/_rels/footnotes.xml.rels" = Just InFootnote
376+filePathToRelType "word/_rels/endnotes.xml.rels" = Just InEndnote
377+filePathToRelType _ = Nothing
370378
371−relElemToRelationship :: Element -> Maybe Relationship
372−relElemToRelationship element | qName (elName element) == "Relationship" =
379+relElemToRelationship :: DocumentLocation -> Element -> Maybe Relationship
380+relElemToRelationship relType element | qName (elName element) == "Relationship" =
373381 do
374382 relId <- findAttr (QName "Id" Nothing Nothing) element
375383 target <- findAttr (QName "Target" Nothing Nothing) element
376− return $ Relationship (relId, target)
377−relElemToRelationship _ = Nothing
378−
379−
384+ return $ Relationship relType relId target
385+relElemToRelationship _ _ = Nothing
386+
387+filePathToRelationships :: Archive -> FilePath -> [Relationship]
388+filePathToRelationships ar fp | Just relType <- filePathToRelType fp
389+ , Just entry <- findEntryByPath fp ar
390+ , Just relElems <- (parseXMLDoc . UTF8.toStringLazy . fromEntry) entry =
391+ mapMaybe (relElemToRelationship relType) $ elChildren relElems
392+filePathToRelationships _ _ = []
393+
380394archiveToRelationships :: Archive -> [Relationship]
381395archiveToRelationships archive =
382− let relPaths = filter filePathIsRel (filesInArchive archive)
383− entries = mapMaybe (\f -> findEntryByPath f archive) relPaths
384− relElems = mapMaybe (parseXMLDoc . UTF8.toStringLazy . fromEntry) entries
385− rels = mapMaybe relElemToRelationship $ concatMap elChildren relElems
386− in
387− rels
396+ concatMap (filePathToRelationships archive) $ filesInArchive archive
388397
389398filePathIsMedia :: FilePath -> Bool
390399filePathIsMedia fp =
@@ -596,13 +605,16 @@ elemToBodyPart ns element
596605 return $ Tbl caption grid tblLook rows
597606elemToBodyPart _ _ = throwError WrongElem
598607
599−lookupRelationship :: RelId -> [Relationship] -> Maybe Target
600−lookupRelationship relid rels =
601− lookup relid (map (\(Relationship pair) -> pair) rels)
608+lookupRelationship :: DocumentLocation -> RelId -> [Relationship] -> Maybe Target
609+lookupRelationship docLocation relid rels =
610+ lookup (docLocation, relid) pairs
611+ where
612+ pairs = map (\(Relationship loc relid' target) -> ((loc, relid'), target)) rels
602613
603614expandDrawingId :: String -> D (FilePath, B.ByteString)
604615expandDrawingId s = do
605− target <- asks (lookupRelationship s . envRelationships)
616+ location <- asks envLocation
617+ target <- asks (lookupRelationship location s . envRelationships)
606618 case target of
607619 Just filepath -> do
608620 bytes <- asks (lookup ("word/" ++ filepath) . envMedia)
@@ -657,9 +669,10 @@ elemToParPart ns element
657669elemToParPart ns element
658670 | isElem ns "w" "hyperlink" element
659671 , Just relId <- findAttr (elemName ns "r" "id") element = do
672+ location <- asks envLocation
660673 runs <- mapD (elemToRun ns) (elChildren element)
661674 rels <- asks envRelationships
662− case lookupRelationship relId rels of
675+ case lookupRelationship location relId rels of
663676 Just target -> do
664677 case findAttr (elemName ns "w" "anchor") element of
665678 Just anchor -> return $ ExternalHyperLink (target ++ '#':anchor) runs
@@ -699,7 +712,7 @@ elemToRun ns element
699712 , Just fnId <- findAttr (elemName ns "w" "id") ref = do
700713 notes <- asks envNotes
701714 case lookupFootnote fnId notes of
702− Just e -> do bps <- mapD (elemToBodyPart ns) (elChildren e)
715+ Just e -> do bps <- local (\r -> r {envLocation=InFootnote}) $ mapD (elemToBodyPart ns) (elChildren e)
703716 return $ Footnote bps
704717 Nothing -> return $ Footnote []
705718elemToRun ns element
@@ -708,7 +721,7 @@ elemToRun ns element
708721 , Just enId <- findAttr (elemName ns "w" "id") ref = do
709722 notes <- asks envNotes
710723 case lookupEndnote enId notes of
711− Just e -> do bps <- mapD (elemToBodyPart ns) (elChildren e)
724+ Just e -> do bps <- local (\r -> r {envLocation=InEndnote}) $ mapD (elemToBodyPart ns) (elChildren e)
712725 return $ Endnote bps
713726 Nothing -> return $ Endnote []
714727elemToRun ns element