Basic support for images in ODT documents

Highly influenced by the docx support, refactored
some code to avoid DRY.

1 files changed, 83 insertions, 6 deletions

diff --git a/src/Text/Pandoc/Readers/Odt/ContentReader.hs b/src/Text/Pandoc/Readers/Odt/ContentReader.hs
index 8c475eefc..d61707976 100644
--- a/src/Text/Pandoc/Readers/Odt/ContentReader.hs
+++ b/src/Text/Pandoc/Readers/Odt/ContentReader.hs
@@ -42,6 +42,7 @@ module Text.Pandoc.Readers.Odt.ContentReader
 import           Control.Arrow
 import           Control.Applicative    hiding ( liftA, liftA2, liftA3 )
 
+import qualified Data.ByteString.Lazy   as B
 import qualified Data.Map               as M
 import           Data.List                     ( find )
 import           Data.Maybe
@@ -50,6 +51,7 @@ import qualified Text.XML.Light         as XML
 
 import           Text.Pandoc.Definition
 import           Text.Pandoc.Builder
+import           Text.Pandoc.MediaBag (insertMedia, MediaBag)
 import           Text.Pandoc.Shared
 
 import           Text.Pandoc.Readers.Odt.Base
@@ -68,6 +70,7 @@ import qualified Data.Set as Set
 --------------------------------------------------------------------------------
 
 type Anchor = String
+type Media = [(FilePath, B.ByteString)]
 
 data ReaderState
    = ReaderState { -- | A collection of styles read somewhere else.
@@ -87,14 +90,17 @@ data ReaderState
                    -- | A map from internal anchor names to "pretty" ones.
                    -- The mapping is a purely cosmetic one.
                  , bookmarkAnchors  :: M.Map Anchor Anchor
-
+                   -- | A map of files / binary data from the archive
+                 , envMedia         :: Media
+                   -- | Hold binary resources used in the document
+                 , odtMediaBag      :: MediaBag
 --               , sequences
 --               , trackedChangeIDs
                  }
   deriving ( Show )
 
-readerState :: Styles -> ReaderState
-readerState styles = ReaderState styles [] 0 Nothing M.empty
+readerState :: Styles -> Media -> ReaderState
+readerState styles media = ReaderState styles [] 0 Nothing M.empty media mempty
 
 --
 pushStyle'  :: Style -> ReaderState -> ReaderState
@@ -134,6 +140,16 @@ putPrettyAnchor ugly pretty state@ReaderState{..}
 usedAnchors :: ReaderState -> [Anchor]
 usedAnchors ReaderState{..} = M.elems bookmarkAnchors
 
+getMediaBag :: ReaderState -> MediaBag
+getMediaBag ReaderState{..} = odtMediaBag
+
+getMediaEnv :: ReaderState -> Media
+getMediaEnv ReaderState{..} = envMedia
+
+insertMedia' :: (FilePath, B.ByteString) -> ReaderState ->  ReaderState
+insertMedia' (fp, bs) state@ReaderState{..}
+  = state { odtMediaBag = insertMedia fp Nothing bs odtMediaBag }
+
 --------------------------------------------------------------------------------
 -- Reader type and associated tools
 --------------------------------------------------------------------------------
@@ -190,6 +206,22 @@ popStyle =     keepingTheValue (
 getCurrentListLevel :: OdtReaderSafe _x ListLevel
 getCurrentListLevel = getExtraState >>^ currentListLevel
 
+--
+updateMediaWithResource :: OdtReaderSafe (FilePath, B.ByteString) (FilePath, B.ByteString)
+updateMediaWithResource = keepingTheValue (
+                 (keepingTheValue getExtraState
+                  >>% insertMedia'
+                  )
+                 >>> setExtraState
+               )
+           >>^ fst
+
+lookupResource :: OdtReaderSafe String (FilePath, B.ByteString)
+lookupResource = proc target -> do
+    state <- getExtraState -< ()
+    case lookup target (getMediaEnv state) of
+      Just bs -> returnV (target, bs) -<< ()
+      Nothing -> returnV ("", B.empty) -< ()
 
 type AnchorPrefix = String
 
@@ -559,6 +591,7 @@ read_paragraph    = matchingElement NsText "p"
                                         , read_reference_start
                                         , read_bookmark_ref
                                         , read_reference_ref
+                                        , read_frame
                                         ] read_plain_text
 
 
@@ -583,6 +616,7 @@ read_header       = matchingElement NsText "h"
                                   , read_reference_start
                                   , read_bookmark_ref
                                   , read_reference_ref
+                                  , read_frame
                                   ] read_plain_text
               ) -< blocks
   anchor   <- getHeaderAnchor -< children
@@ -688,6 +722,46 @@ read_table_cell    = matchingElement NsTable "table-cell"
                                           ]
 
 ----------------------
+-- Images
+----------------------
+
+--
+read_frame  :: InlineMatcher
+read_frame   = matchingElement NsDraw "frame"
+               $ proc blocks -> do
+                  w          <- ( findAttr' NsSVG "width" ) -< ()
+                  h          <- ( findAttr' NsSVG "height" ) -< ()
+                  attr       <- arr (uncurry image_attributes) -< (w, h)
+                  titleNodes <- ( matchChildContent' [ read_frame_title ] ) -< blocks
+                  title      <- arr inlineListToIdentifier -< (toList titleNodes)
+                  src        <-  matchChildContent' [ read_image_src ] -< blocks
+                  resource   <- lookupResource -< src
+                  _          <- updateMediaWithResource -< resource
+                  arr (uncurry4 imageWith ) -< (attr, src, title, mempty)
+
+image_attributes :: Maybe String -> Maybe String -> Attr
+image_attributes x y =
+  ( "", [], (dim "width" x) ++ (dim "height" y))
+  where
+    dim _ (Just "")   = []
+    dim name (Just v) = [(name, v)]
+    dim _ Nothing     = []
+
+read_image_src :: (Namespace, ElementName, OdtReader Anchor Anchor)
+read_image_src = matchingElement NsDraw "image"
+                   $ proc _ -> do
+                       imgSrc <- findAttr NsXLink "href" -< ()
+                       case imgSrc of
+                          Right src -> returnV src -<< ()
+                          Left _    -> returnV "" -< ()
+
+read_frame_title :: InlineMatcher
+read_frame_title = matchingElement NsSVG "title"
+                   $ (matchChildContent [] read_plain_text)
+
+
+
+----------------------
 -- Internal links
 ----------------------
 
@@ -783,8 +857,11 @@ read_text = matchChildContent' [ read_header
                                ]
             >>^ doc
 
-read_body :: OdtReader _x Pandoc
+read_body :: OdtReader _x (Pandoc, MediaBag)
 read_body = executeIn NsOffice "body"
           $ executeIn NsOffice "text"
-          $ liftAsSuccess read_text
-
+          $ liftAsSuccess
+          $ proc inlines -> do
+             txt   <- read_text     -< inlines
+             state <- getExtraState -< ()
+             returnA                -< (txt, getMediaBag state)