git.iko.soy/typeable/pandoc
on master help sign in
Merge pull request #3165 from hubertp-lshift/feature/odt-image
0cd11b3John MacFarlane
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+106−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
@@ -511,6 +543,10 @@ read_plain_text = fst ^&&& read_plain_text' >>% recover
511 extractText (XML.Text cData) = succeedWith (XML.cdData cData)
543 extractText (XML.Text cData) = succeedWith (XML.cdData cData)
512 extractText _ = failEmpty
544 extractText _ = failEmpty
513
545
546+read_text_seq :: InlineMatcher
547+read_text_seq = matchingElement NsText "sequence"
548+ $ matchChildContent [] read_plain_text
549+
514
550
515-- specifically. I honor that, although the current implementation of '(<>)'
551-- specifically. I honor that, although the current implementation of '(<>)'
516-- for 'Inlines' in "Text.Pandoc.Builder" will collaps them agein.
552-- for 'Inlines' in "Text.Pandoc.Builder" will collaps them agein.
@@ -559,6 +595,8 @@ read_paragraph = matchingElement NsText "p"
559 , read_reference_start
595 , read_reference_start
560 , read_bookmark_ref
596 , read_bookmark_ref
561 , read_reference_ref
597 , read_reference_ref
598+ , read_maybe_nested_img_frame
599+ , read_text_seq
562 ] read_plain_text
600 ] read_plain_text
563
601
564
602
@@ -583,6 +621,7 @@ read_header = matchingElement NsText "h"
583 , read_reference_start
621 , read_reference_start
584 , read_bookmark_ref
622 , read_bookmark_ref
585 , read_reference_ref
623 , read_reference_ref
624+ , read_maybe_nested_img_frame
586 ] read_plain_text
625 ] read_plain_text
587 ) -< blocks
626 ) -< blocks
588 anchor <- getHeaderAnchor -< children
627 anchor <- getHeaderAnchor -< children
@@ -687,6 +726,64 @@ read_table_cell = matchingElement NsTable "table-cell"
687 $ matchChildContent' [ read_paragraph
726 $ matchChildContent' [ read_paragraph
688 ]
727 ]
689
728
729+----------------------
730+-- Images
731+----------------------
732+
733+--
734+read_maybe_nested_img_frame :: InlineMatcher
735+read_maybe_nested_img_frame = matchingElement NsDraw "frame"
736+ $ proc blocks -> do
737+ img <- (findChild' NsDraw "image") -< ()
738+ case img of
739+ Just _ -> read_frame -< blocks
740+ Nothing -> matchChildContent' [ read_frame_text_box ] -< blocks
741+
742+read_frame :: OdtReaderSafe Inlines Inlines
743+read_frame =
744+ proc blocks -> do
745+ w <- ( findAttr' NsSVG "width" ) -< ()
746+ h <- ( findAttr' NsSVG "height" ) -< ()
747+ titleNodes <- ( matchChildContent' [ read_frame_title ] ) -< blocks
748+ src <- matchChildContent' [ read_image_src ] -< blocks
749+ resource <- lookupResource -< src
750+ _ <- updateMediaWithResource -< resource
751+ alt <- (matchChildContent [] read_plain_text) -< blocks
752+ arr (uncurry4 imageWith ) -<
753+ (image_attributes w h, src, inlineListToIdentifier (toList titleNodes), alt)
754+
755+image_attributes :: Maybe String -> Maybe String -> Attr
756+image_attributes x y =
757+ ( "", [], (dim "width" x) ++ (dim "height" y))
758+ where
759+ dim _ (Just "") = []
760+ dim name (Just v) = [(name, v)]
761+ dim _ Nothing = []
762+
763+read_image_src :: (Namespace, ElementName, OdtReader Anchor Anchor)
764+read_image_src = matchingElement NsDraw "image"
765+ $ proc _ -> do
766+ imgSrc <- findAttr NsXLink "href" -< ()
767+ case imgSrc of
768+ Right src -> returnV src -<< ()
769+ Left _ -> returnV "" -< ()
770+
771+read_frame_title :: InlineMatcher
772+read_frame_title = matchingElement NsSVG "title"
773+ $ (matchChildContent [] read_plain_text)
774+
775+read_frame_text_box :: InlineMatcher
776+read_frame_text_box = matchingElement NsDraw "text-box"
777+ $ proc blocks -> do
778+ paragraphs <- (matchChildContent' [ read_paragraph ]) -< blocks
779+ arr read_img_with_caption -< toList paragraphs
780+
781+read_img_with_caption :: [Block] -> Inlines
782+read_img_with_caption ((Para ((Image attr _ target) : txt)) : _) =
783+ singleton (Image attr txt target) -- override caption with the text that follows
784+read_img_with_caption _ =
785+ mempty
786+
690----------------------
787----------------------
691-- Internal links
788-- Internal links
692----------------------
789----------------------
@@ -783,8 +880,11 @@ read_text = matchChildContent' [ read_header
783 ]
880 ]
784 >>^ doc
881 >>^ doc
785
882
786−read_body :: OdtReader _x Pandoc
883+read_body :: OdtReader _x (Pandoc, MediaBag)
787read_body = executeIn NsOffice "body"
884read_body = executeIn NsOffice "body"
788 $ executeIn NsOffice "text"
885 $ executeIn NsOffice "text"
789− $ liftAsSuccess read_text
886+ $ liftAsSuccess
790−
887+ $ proc inlines -> do
888+ txt <- read_text -< inlines
889+ state <- getExtraState -< ()
890+ returnA -< (txt, getMediaBag state)
src/Text/Pandoc/Shared.hs+13
@@ -68,6 +68,7 @@ module Text.Pandoc.Shared (
68 Element (..),
68 Element (..),
69 hierarchicalize,
69 hierarchicalize,
70 uniqueIdent,
70 uniqueIdent,
71+ inlineListToIdentifier,
71 isHeaderBlock,
72 isHeaderBlock,
72 headerShift,
73 headerShift,
73 isTightList,
74 isTightList,
@@ -85,6 +86,7 @@ module Text.Pandoc.Shared (
85 fetchItem',
86 fetchItem',
86 openURL,
87 openURL,
87 collapseFilePath,
88 collapseFilePath,
89+ filteredFilesFromArchive,
88 -- * Error handling
90 -- * Error handling
89 err,
91 err,
90 warn,
92 warn,
@@ -111,6 +113,7 @@ import System.Exit (exitWith, ExitCode(..))
111import Data.Char ( toLower, isLower, isUpper, isAlpha,
113import Data.Char ( toLower, isLower, isUpper, isAlpha,
112 isLetter, isDigit, isSpace )
114 isLetter, isDigit, isSpace )
113import Data.List ( find, stripPrefix, intercalate )
115import Data.List ( find, stripPrefix, intercalate )
116+import Data.Maybe (mapMaybe)
114import Data.Version ( showVersion )
117import Data.Version ( showVersion )
115import qualified Data.Map as M
118import qualified Data.Map as M
116import Network.URI ( escapeURIString, nonStrictRelativeTo,
119import Network.URI ( escapeURIString, nonStrictRelativeTo,
@@ -1031,6 +1034,16 @@ collapseFilePath = Posix.joinPath . reverse . foldl go [] . splitDirectories
1031 isSingleton _ = Nothing
1034 isSingleton _ = Nothing
1032 checkPathSeperator = fmap isPathSeparator . isSingleton
1035 checkPathSeperator = fmap isPathSeparator . isSingleton
1033
1036
1037+--
1038+-- File selection from the archive
1039+--
1040+filteredFilesFromArchive :: Archive -> (FilePath -> Bool) -> [(FilePath, BL.ByteString)]
1041+filteredFilesFromArchive zf f =
1042+ mapMaybe (fileAndBinary zf) (filter f (filesInArchive zf))
1043+ where
1044+ fileAndBinary :: Archive -> FilePath -> Maybe (FilePath, BL.ByteString)
1045+ fileAndBinary a fp = findEntryByPath fp a >>= \e -> Just (fp, fromEntry e)
1046+
1034---
1047---
1035--- Squash blocks into inlines
1048--- Squash blocks into inlines
1036---
1049---
tests/Tests/Readers/Odt.hs+4−2
@@ -141,7 +141,6 @@ namesOfTestsComparingToMarkdown = [ "bold"
141 , "footnote"
141 , "footnote"
142 , "headers"
142 , "headers"
143-- , "horizontalRule"
143-- , "horizontalRule"
144−-- , "image"
145 , "italic"
144 , "italic"
146-- , "listBlocks"
145-- , "listBlocks"
147 , "paragraph"
146 , "paragraph"
@@ -152,6 +151,9 @@ namesOfTestsComparingToMarkdown = [ "bold"
152
151
153namesOfTestsComparingToNative :: [ String ]
152namesOfTestsComparingToNative :: [ String ]
154namesOfTestsComparingToNative = [ "blockquote"
153namesOfTestsComparingToNative = [ "blockquote"
154+ , "image"
155+ , "imageIndex"
156+ , "imageWithCaption"
155 , "orderedListMixed"
157 , "orderedListMixed"
156 , "orderedListRoman"
158 , "orderedListRoman"
157 , "orderedListSimple"
159 , "orderedListSimple"
@@ -162,4 +164,4 @@ namesOfTestsComparingToNative = [ "blockquote"
162-- , "table"
164-- , "table"
163 , "unicode"
165 , "unicode"
164 , "unorderedList"
166 , "unorderedList"
165− ]
167+ ]
tests/odt/native/image.nativenew file+1
@@ -0,0 +1 @@
1+[Para [Image ("",[],[("width","5.292cm"),("height","5.292cm")]) [] ("Pictures/10000000000000FA000000FAD6A15225.jpg","")]]
tests/odt/native/imageIndex.nativenew file+1
@@ -0,0 +1 @@
1+[Para [Image ("",[],[("width","5.292cm"),("height","5.292cm")]) [Str "Abbildung",Space,Str "1:",Space,Str "Image",Space,Str "caption"] ("Pictures/10000000000000FA000000FAD6A15225.jpg","")]]
tests/odt/native/imageWithCaption.nativenew file+1
@@ -0,0 +1 @@
1+[Para [Image ("",[],[("width","5.292cm"),("height","5.292cm")]) [Str "Abbildung",Space,Str "1:",Space,Str "Image",Space,Str "caption"] ("Pictures/10000000000000FA000000FAD6A15225.jpg","")]]