git.iko.soy/typeable/pandoc
on master help sign in
Basic support for images in ODT documents
c924611Hubert Plociniczak
src/Text/Pandoc/Readers/Docx/Parse.hs+4−16
compare with master
unifiedsplit
@@ -65,7 +65,7 @@ import Control.Monad.State
65import Control.Applicative ((<|>))
65import Control.Applicative ((<|>))
66import qualified Data.Map as M
66import qualified Data.Map as M
67import Control.Monad.Except
67import Control.Monad.Except
68−import Text.Pandoc.Shared (safeRead)
68+import Text.Pandoc.Shared (safeRead, filteredFilesFromArchive)
69import Text.TeXMath.Readers.OMML (readOMML)
69import Text.TeXMath.Readers.OMML (readOMML)
70import Text.Pandoc.Readers.Docx.Fonts (getUnicode, Font(..))
70import Text.Pandoc.Readers.Docx.Fonts (getUnicode, Font(..))
71import Text.TeXMath (Exp)
71import Text.TeXMath (Exp)
@@ -86,7 +86,6 @@ data ReaderEnv = ReaderEnv { envNotes :: Notes
86
86
87data ReaderState = ReaderState { stateWarnings :: [String] }
87data ReaderState = ReaderState { stateWarnings :: [String] }
88 deriving Show
88 deriving Show
89−
90
89
91data DocxError = DocxError | WrongElem
90data DocxError = DocxError | WrongElem
92 deriving Show
91 deriving Show
@@ -276,7 +275,7 @@ archiveToDocxWithWarnings archive = do
276 comments = archiveToComments archive
275 comments = archiveToComments archive
277 numbering = archiveToNumbering archive
276 numbering = archiveToNumbering archive
278 rels = archiveToRelationships archive
277 rels = archiveToRelationships archive
279− media = archiveToMedia archive
278+ media = filteredFilesFromArchive archive filePathIsMedia
280 (styles, parstyles) = archiveToStyles archive
279 (styles, parstyles) = archiveToStyles archive
281 rEnv =
280 rEnv =
282 ReaderEnv notes comments numbering rels media Nothing styles parstyles InDocument
281 ReaderEnv notes comments numbering rels media Nothing styles parstyles InDocument
@@ -402,7 +401,6 @@ archiveToComments zf =
402 case cmts of
401 case cmts of
403 Just c -> Comments cmts_namespaces c
402 Just c -> Comments cmts_namespaces c
404 Nothing -> Comments cmts_namespaces M.empty
403 Nothing -> Comments cmts_namespaces M.empty
405−
406
404
407filePathToRelType :: FilePath -> Maybe DocumentLocation
405filePathToRelType :: FilePath -> Maybe DocumentLocation
408filePathToRelType "word/_rels/document.xml.rels" = Just InDocument
406filePathToRelType "word/_rels/document.xml.rels" = Just InDocument
@@ -424,7 +422,7 @@ filePathToRelationships ar fp | Just relType <- filePathToRelType fp
424 , Just relElems <- (parseXMLDoc . UTF8.toStringLazy . fromEntry) entry =
422 , Just relElems <- (parseXMLDoc . UTF8.toStringLazy . fromEntry) entry =
425 mapMaybe (relElemToRelationship relType) $ elChildren relElems
423 mapMaybe (relElemToRelationship relType) $ elChildren relElems
426filePathToRelationships _ _ = []
424filePathToRelationships _ _ = []
427−
425+
428archiveToRelationships :: Archive -> [Relationship]
426archiveToRelationships :: Archive -> [Relationship]
429archiveToRelationships archive =
427archiveToRelationships archive =
430 concatMap (filePathToRelationships archive) $ filesInArchive archive
428 concatMap (filePathToRelationships archive) $ filesInArchive archive
@@ -435,16 +433,6 @@ filePathIsMedia fp =
435 in
433 in
436 (dir == "word/media/")
434 (dir == "word/media/")
437
435
438−getMediaPair :: Archive -> FilePath -> Maybe (FilePath, B.ByteString)
439−getMediaPair zf fp =
440− case findEntryByPath fp zf of
441− Just e -> Just (fp, fromEntry e)
442− Nothing -> Nothing
443−
444−archiveToMedia :: Archive -> Media
445−archiveToMedia zf =
446− mapMaybe (getMediaPair zf) (filter filePathIsMedia (filesInArchive zf))
447−
448lookupLevel :: String -> String -> Numbering -> Maybe Level
436lookupLevel :: String -> String -> Numbering -> Maybe Level
449lookupLevel numId ilvl (Numbering _ numbs absNumbs) = do
437lookupLevel numId ilvl (Numbering _ numbs absNumbs) = do
450 absNumId <- lookup numId $ map (\(Numb nid absnumid) -> (nid, absnumid)) numbs
438 absNumId <- lookup numId $ map (\(Numb nid absnumid) -> (nid, absnumid)) numbs
@@ -741,7 +729,7 @@ elemToCommentStart ns element
741 , Just cmtDate <- findAttr (elemName ns "w" "date") element = do
729 , Just cmtDate <- findAttr (elemName ns "w" "date") element = do
742 bps <- mapD (elemToBodyPart ns) (elChildren element)
730 bps <- mapD (elemToBodyPart ns) (elChildren element)
743 return $ CommentStart cmtId cmtAuthor cmtDate bps
731 return $ CommentStart cmtId cmtAuthor cmtDate bps
744−elemToCommentStart _ _ = throwError WrongElem
732+elemToCommentStart _ _ = throwError WrongElem
745
733
746lookupFootnote :: String -> Notes -> Maybe Element
734lookupFootnote :: String -> Notes -> Maybe Element
747lookupFootnote s (Notes _ fns _) = fns >>= (M.lookup s)
735lookupFootnote s (Notes _ fns _) = fns >>= (M.lookup s)
src/Text/Pandoc/Readers/Odt.hs+28−16
@@ -37,6 +37,8 @@ import qualified Text.XML.Light as XML
37
37
38import qualified Data.ByteString.Lazy as B
38import qualified Data.ByteString.Lazy as B
39
39
40+import System.FilePath
41+
40import Text.Pandoc.Definition
42import Text.Pandoc.Definition
41import Text.Pandoc.Error
43import Text.Pandoc.Error
42import Text.Pandoc.Options
44import Text.Pandoc.Options
@@ -48,39 +50,49 @@ import Text.Pandoc.Readers.Odt.StyleReader
48
50
49import Text.Pandoc.Readers.Odt.Generic.XMLConverter
51import Text.Pandoc.Readers.Odt.Generic.XMLConverter
50import Text.Pandoc.Readers.Odt.Generic.Fallible
52import Text.Pandoc.Readers.Odt.Generic.Fallible
53+import Text.Pandoc.Shared (filteredFilesFromArchive)
51
54
52--
55--
53readOdt :: ReaderOptions
56readOdt :: ReaderOptions
54 -> B.ByteString
57 -> B.ByteString
55 -> Either PandocError (Pandoc, MediaBag)
58 -> Either PandocError (Pandoc, MediaBag)
56−readOdt _ bytes = case bytesToOdt bytes of
59+readOdt _ bytes = bytesToOdt bytes-- of
57− Right pandoc -> Right (pandoc , mempty)
60+-- Right (pandoc, mediaBag) -> Right (pandoc , mediaBag)
58− Left err -> Left err
61+-- Left err -> Left err
59
62
60--
63--
61−bytesToOdt :: B.ByteString -> Either PandocError Pandoc
64+bytesToOdt :: B.ByteString -> Either PandocError (Pandoc, MediaBag)
62bytesToOdt bytes = case toArchiveOrFail bytes of
65bytesToOdt bytes = case toArchiveOrFail bytes of
63 Right archive -> archiveToOdt archive
66 Right archive -> archiveToOdt archive
64 Left _ -> Left $ ParseFailure "Couldn't parse odt file."
67 Left _ -> Left $ ParseFailure "Couldn't parse odt file."
65
68
66--
69--
67−archiveToOdt :: Archive -> Either PandocError Pandoc
70+archiveToOdt :: Archive -> Either PandocError (Pandoc, MediaBag)
68archiveToOdt archive
71archiveToOdt archive
69− | Just contentEntry <- findEntryByPath "content.xml" archive
72+ | Just contentEntry <- findEntryByPath "content.xml" archive
70− , Just stylesEntry <- findEntryByPath "styles.xml" archive
73+ , Just stylesEntry <- findEntryByPath "styles.xml" archive
71− , Just contentElem <- entryToXmlElem contentEntry
74+ , Just contentElem <- entryToXmlElem contentEntry
72− , Just stylesElem <- entryToXmlElem stylesEntry
75+ , Just stylesElem <- entryToXmlElem stylesEntry
73− , Right styles <- chooseMax (readStylesAt stylesElem )
76+ , Right styles <- chooseMax (readStylesAt stylesElem )
74− (readStylesAt contentElem)
77+ (readStylesAt contentElem)
78+ , media <- filteredFilesFromArchive archive filePathIsOdtMedia
75− , startState <- readerState styles
79+ , startState <- readerState styles media
76− , Right pandoc <- runConverter' read_body
80+ , Right pandocWithMedia <- runConverter' read_body
77− startState
81+ startState
78− contentElem
82+ contentElem
79− = Right pandoc
83+
84+ = Right pandocWithMedia
80
85
81 | otherwise
86 | otherwise
82 -- Not very detailed, but I don't think more information would be helpful
87 -- Not very detailed, but I don't think more information would be helpful
83 = Left $ ParseFailure "Couldn't parse odt file."
88 = Left $ ParseFailure "Couldn't parse odt file."
89+ where
90+ filePathIsOdtMedia :: FilePath -> Bool
91+ filePathIsOdtMedia fp =
92+ let (dir, _) = splitFileName fp
93+ in
94+ (dir == "Pictures/")
95+
84
96
85--
97--
86entryToXmlElem :: Entry -> Maybe XML.Element
98entryToXmlElem :: Entry -> Maybe XML.Element
src/Text/Pandoc/Readers/Odt/ContentReader.hs+83−6
@@ -42,6 +42,7 @@ module Text.Pandoc.Readers.Odt.ContentReader
42import Control.Arrow
42import Control.Arrow
43import Control.Applicative hiding ( liftA, liftA2, liftA3 )
43import Control.Applicative hiding ( liftA, liftA2, liftA3 )
44
44
45+import qualified Data.ByteString.Lazy as B
45import qualified Data.Map as M
46import qualified Data.Map as M
46import Data.List ( find )
47import Data.List ( find )
47import Data.Maybe
48import Data.Maybe
@@ -50,6 +51,7 @@ import qualified Text.XML.Light as XML
50
51
51import Text.Pandoc.Definition
52import Text.Pandoc.Definition
52import Text.Pandoc.Builder
53import Text.Pandoc.Builder
54+import Text.Pandoc.MediaBag (insertMedia, MediaBag)
53import Text.Pandoc.Shared
55import Text.Pandoc.Shared
54
56
55import Text.Pandoc.Readers.Odt.Base
57import Text.Pandoc.Readers.Odt.Base
@@ -68,6 +70,7 @@ import qualified Data.Set as Set
68--------------------------------------------------------------------------------
70--------------------------------------------------------------------------------
69
71
70type Anchor = String
72type Anchor = String
73+type Media = [(FilePath, B.ByteString)]
71
74
72data ReaderState
75data ReaderState
73 = ReaderState { -- | A collection of styles read somewhere else.
76 = ReaderState { -- | A collection of styles read somewhere else.
@@ -87,14 +90,17 @@ data ReaderState
87 -- | A map from internal anchor names to "pretty" ones.
90 -- | A map from internal anchor names to "pretty" ones.
88 -- The mapping is a purely cosmetic one.
91 -- The mapping is a purely cosmetic one.
89 , bookmarkAnchors :: M.Map Anchor Anchor
92 , bookmarkAnchors :: M.Map Anchor Anchor
90−
93+ -- | A map of files / binary data from the archive
94+ , envMedia :: Media
95+ -- | Hold binary resources used in the document
96+ , odtMediaBag :: MediaBag
91-- , sequences
97-- , sequences
92-- , trackedChangeIDs
98-- , trackedChangeIDs
93 }
99 }
94 deriving ( Show )
100 deriving ( Show )
95
101
96−readerState :: Styles -> ReaderState
102+readerState :: Styles -> Media -> ReaderState
97−readerState styles = ReaderState styles [] 0 Nothing M.empty
103+readerState styles media = ReaderState styles [] 0 Nothing M.empty media mempty
98
104
99--
105--
100pushStyle' :: Style -> ReaderState -> ReaderState
106pushStyle' :: Style -> ReaderState -> ReaderState
@@ -134,6 +140,16 @@ putPrettyAnchor ugly pretty state@ReaderState{..}
134usedAnchors :: ReaderState -> [Anchor]
140usedAnchors :: ReaderState -> [Anchor]
135usedAnchors ReaderState{..} = M.elems bookmarkAnchors
141usedAnchors ReaderState{..} = M.elems bookmarkAnchors
136
142
143+getMediaBag :: ReaderState -> MediaBag
144+getMediaBag ReaderState{..} = odtMediaBag
145+
146+getMediaEnv :: ReaderState -> Media
147+getMediaEnv ReaderState{..} = envMedia
148+
149+insertMedia' :: (FilePath, B.ByteString) -> ReaderState -> ReaderState
150+insertMedia' (fp, bs) state@ReaderState{..}
151+ = state { odtMediaBag = insertMedia fp Nothing bs odtMediaBag }
152+
137--------------------------------------------------------------------------------
153--------------------------------------------------------------------------------
138-- Reader type and associated tools
154-- Reader type and associated tools
139--------------------------------------------------------------------------------
155--------------------------------------------------------------------------------
@@ -190,6 +206,22 @@ popStyle = keepingTheValue (
190getCurrentListLevel :: OdtReaderSafe _x ListLevel
206getCurrentListLevel :: OdtReaderSafe _x ListLevel
191getCurrentListLevel = getExtraState >>^ currentListLevel
207getCurrentListLevel = getExtraState >>^ currentListLevel
192
208
209+--
210+updateMediaWithResource :: OdtReaderSafe (FilePath, B.ByteString) (FilePath, B.ByteString)
211+updateMediaWithResource = keepingTheValue (
212+ (keepingTheValue getExtraState
213+ >>% insertMedia'
214+ )
215+ >>> setExtraState
216+ )
217+ >>^ fst
218+
219+lookupResource :: OdtReaderSafe String (FilePath, B.ByteString)
220+lookupResource = proc target -> do
221+ state <- getExtraState -< ()
222+ case lookup target (getMediaEnv state) of
223+ Just bs -> returnV (target, bs) -<< ()
224+ Nothing -> returnV ("", B.empty) -< ()
193
225
194type AnchorPrefix = String
226type AnchorPrefix = String
195
227
@@ -559,6 +591,7 @@ read_paragraph = matchingElement NsText "p"
559 , read_reference_start
591 , read_reference_start
560 , read_bookmark_ref
592 , read_bookmark_ref
561 , read_reference_ref
593 , read_reference_ref
594+ , read_frame
562 ] read_plain_text
595 ] read_plain_text
563
596
564
597
@@ -583,6 +616,7 @@ read_header = matchingElement NsText "h"
583 , read_reference_start
616 , read_reference_start
584 , read_bookmark_ref
617 , read_bookmark_ref
585 , read_reference_ref
618 , read_reference_ref
619+ , read_frame
586 ] read_plain_text
620 ] read_plain_text
587 ) -< blocks
621 ) -< blocks
588 anchor <- getHeaderAnchor -< children
622 anchor <- getHeaderAnchor -< children
@@ -687,6 +721,46 @@ read_table_cell = matchingElement NsTable "table-cell"
687 $ matchChildContent' [ read_paragraph
721 $ matchChildContent' [ read_paragraph
688 ]
722 ]
689
723
724+----------------------
725+-- Images
726+----------------------
727+
728+--
729+read_frame :: InlineMatcher
730+read_frame = matchingElement NsDraw "frame"
731+ $ proc blocks -> do
732+ w <- ( findAttr' NsSVG "width" ) -< ()
733+ h <- ( findAttr' NsSVG "height" ) -< ()
734+ attr <- arr (uncurry image_attributes) -< (w, h)
735+ titleNodes <- ( matchChildContent' [ read_frame_title ] ) -< blocks
736+ title <- arr inlineListToIdentifier -< (toList titleNodes)
737+ src <- matchChildContent' [ read_image_src ] -< blocks
738+ resource <- lookupResource -< src
739+ _ <- updateMediaWithResource -< resource
740+ arr (uncurry4 imageWith ) -< (attr, src, title, mempty)
741+
742+image_attributes :: Maybe String -> Maybe String -> Attr
743+image_attributes x y =
744+ ( "", [], (dim "width" x) ++ (dim "height" y))
745+ where
746+ dim _ (Just "") = []
747+ dim name (Just v) = [(name, v)]
748+ dim _ Nothing = []
749+
750+read_image_src :: (Namespace, ElementName, OdtReader Anchor Anchor)
751+read_image_src = matchingElement NsDraw "image"
752+ $ proc _ -> do
753+ imgSrc <- findAttr NsXLink "href" -< ()
754+ case imgSrc of
755+ Right src -> returnV src -<< ()
756+ Left _ -> returnV "" -< ()
757+
758+read_frame_title :: InlineMatcher
759+read_frame_title = matchingElement NsSVG "title"
760+ $ (matchChildContent [] read_plain_text)
761+
762+
763+
690----------------------
764----------------------
691-- Internal links
765-- Internal links
692----------------------
766----------------------
@@ -783,8 +857,11 @@ read_text = matchChildContent' [ read_header
783 ]
857 ]
784 >>^ doc
858 >>^ doc
785
859
786−read_body :: OdtReader _x Pandoc
860+read_body :: OdtReader _x (Pandoc, MediaBag)
787read_body = executeIn NsOffice "body"
861read_body = executeIn NsOffice "body"
788 $ executeIn NsOffice "text"
862 $ executeIn NsOffice "text"
789− $ liftAsSuccess read_text
863+ $ liftAsSuccess
790−
864+ $ proc inlines -> do
865+ txt <- read_text -< inlines
866+ state <- getExtraState -< ()
867+ returnA -< (txt, getMediaBag state)
src/Text/Pandoc/Shared.hs+16
@@ -67,6 +67,7 @@ module Text.Pandoc.Shared (
67 Element (..),
67 Element (..),
68 hierarchicalize,
68 hierarchicalize,
69 uniqueIdent,
69 uniqueIdent,
70+ inlineListToIdentifier,
70 isHeaderBlock,
71 isHeaderBlock,
71 headerShift,
72 headerShift,
72 isTightList,
73 isTightList,
@@ -84,6 +85,7 @@ module Text.Pandoc.Shared (
84 fetchItem',
85 fetchItem',
85 openURL,
86 openURL,
86 collapseFilePath,
87 collapseFilePath,
88+ filteredFilesFromArchive,
87 -- * Error handling
89 -- * Error handling
88 err,
90 err,
89 warn,
91 warn,
@@ -110,6 +112,7 @@ import System.Exit (exitWith, ExitCode(..))
110import Data.Char ( toLower, isLower, isUpper, isAlpha,
112import Data.Char ( toLower, isLower, isUpper, isAlpha,
111 isLetter, isDigit, isSpace )
113 isLetter, isDigit, isSpace )
112import Data.List ( find, stripPrefix, intercalate )
114import Data.List ( find, stripPrefix, intercalate )
115+import Data.Maybe (mapMaybe)
113import Data.Version ( showVersion )
116import Data.Version ( showVersion )
114import qualified Data.Map as M
117import qualified Data.Map as M
115import Network.URI ( escapeURIString, nonStrictRelativeTo,
118import Network.URI ( escapeURIString, nonStrictRelativeTo,
@@ -1028,6 +1031,19 @@ collapseFilePath = Posix.joinPath . reverse . foldl go [] . splitDirectories
1028 isSingleton _ = Nothing
1031 isSingleton _ = Nothing
1029 checkPathSeperator = fmap isPathSeparator . isSingleton
1032 checkPathSeperator = fmap isPathSeparator . isSingleton
1030
1033
1034+--
1035+-- File selection from the archive
1036+--
1037+filteredFilesFromArchive :: Archive -> (FilePath -> Bool) -> [(FilePath, BL.ByteString)]
1038+filteredFilesFromArchive zf f =
1039+ mapMaybe (fileAndBinary zf) (filter f (filesInArchive zf))
1040+ where
1041+ fileAndBinary :: Archive -> FilePath -> Maybe (FilePath, BL.ByteString)
1042+ fileAndBinary a fp =
1043+ case findEntryByPath fp a of
1044+ Just e -> Just (fp, fromEntry e)
1045+ Nothing -> Nothing
1046+
1031---
1047---
1032--- Squash blocks into inlines
1048--- Squash blocks into inlines
1033---
1049---