Merge pull request #1473 from jkr/mediabag-test-2

Docx tests: rewrite mediabag tests.

5 files changed, 44 insertions, 23 deletions

diff --git a/pandoc.cabal b/pandoc.cabal
index 47bdb6587..1c74933ab 100644
--- a/pandoc.cabal
+++ b/pandoc.cabal
@@ -386,7 +386,6 @@ Test-Suite test-pandoc
                   syb >= 0.1 && < 0.5,
                   pandoc,
                   pandoc-types >= 1.12.3.3 && < 1.13,
-                  base64-bytestring >= 0.1 && < 1.1,
                   bytestring >= 0.9 && < 0.11,
                   text >= 0.11 && < 1.2,
                   directory >= 1 && < 1.3,
@@ -400,7 +399,8 @@ Test-Suite test-pandoc
                   QuickCheck >= 2.4 && < 2.8,
                   HUnit >= 1.2 && < 1.3,
                   containers >= 0.1 && < 0.6,
-                  ansi-terminal >= 0.5 && < 0.7
+                  ansi-terminal >= 0.5 && < 0.7,
+                  zip-archive >= 0.2.3.2 && < 0.3
   Other-Modules:  Tests.Old
                   Tests.Helpers
                   Tests.Arbitrary
diff --git a/tests/Tests/Readers/Docx.hs b/tests/Tests/Readers/Docx.hs
index 85a02debd..efc520dba 100644
--- a/tests/Tests/Readers/Docx.hs
+++ b/tests/Tests/Readers/Docx.hs
@@ -5,14 +5,15 @@ import Text.Pandoc.Readers.Native
 import Text.Pandoc.Definition
 import Tests.Helpers
 import Test.Framework
-import qualified Data.ByteString as BS
+import Test.HUnit (assertBool)
+import Test.Framework.Providers.HUnit
 import qualified Data.ByteString.Lazy as B
-import qualified Data.ByteString.Char8 as B8
-import qualified Data.ByteString.Base64 as B64
 import Text.Pandoc.Readers.Docx
 import Text.Pandoc.Writers.Native (writeNative)
 import qualified Data.Map as M
-import Text.Pandoc.MediaBag (lookupMedia)
+import Text.Pandoc.MediaBag (MediaBag, lookupMedia, mediaDirectory)
+import Codec.Archive.Zip
+import System.FilePath (combine)
 
 -- We define a wrapper around pandoc that doesn't normalize in the
 -- tests. Since we do our own normalization, we want to make sure
@@ -56,22 +57,44 @@ testCompareWithOpts opts name docxFile nativeFile =
 testCompare :: String -> FilePath -> FilePath -> Test
 testCompare = testCompareWithOpts def
 
-testCompareMediaIO :: String -> FilePath -> FilePath -> FilePath -> IO Test
-testCompareMediaIO name docxFile mediaPath mediaFile = do
+getMedia :: FilePath -> FilePath -> IO (Maybe B.ByteString)
+getMedia archivePath mediaPath = do
+  zf <- B.readFile archivePath >>= return . toArchive
+  return $ findEntryByPath (combine "word" mediaPath) zf >>= (Just . fromEntry)
+
+compareMediaPathIO :: FilePath -> MediaBag -> FilePath -> IO Bool
+compareMediaPathIO mediaPath mediaBag docxPath = do
+  docxMedia <- getMedia docxPath mediaPath
+  let mbBS   = case lookupMedia mediaPath mediaBag of
+                 Just (_, bs) -> bs
+                 Nothing      -> error ("couldn't find " ++
+                                        mediaPath ++
+                                        " in media bag")
+      docxBS = case docxMedia of
+                 Just bs -> bs
+                 Nothing -> error ("couldn't find " ++
+                                   mediaPath ++
+                                   " in media bag")
+  return $ mbBS == docxBS
+
+compareMediaBagIO :: FilePath -> IO Bool
+compareMediaBagIO docxFile = do
     df <- B.readFile docxFile
-    mf <- B.readFile mediaFile
     let (_, mb) = readDocx def df
-        dBytes = case lookupMedia mediaPath mb of
-          Just (_,bs) -> bs
-          Nothing -> error "Media file not found"
-        d64 = B8.unpack $ B64.encode $ BS.concat $ B.toChunks dBytes
-        m64 = B8.unpack $ B64.encode $ BS.concat $ B.toChunks mf
-    return $ test id name (d64, m64)
+    bools <- mapM
+             (\(fp, _, _) -> compareMediaPathIO fp mb docxFile) 
+             (mediaDirectory mb)
+    return $ and bools
 
-testCompareMedia :: String -> FilePath -> FilePath -> FilePath -> Test
-testCompareMedia name docxFile mediaPath mediaFile =
-  buildTest $ testCompareMediaIO name docxFile mediaPath mediaFile
+testMediaBagIO :: String -> FilePath -> IO Test
+testMediaBagIO name docxFile = do
+  outcome <- compareMediaBagIO docxFile
+  return $ testCase name (assertBool 
+                          ("Media didn't match media bag in file " ++ docxFile)
+                          outcome)
 
+testMediaBag :: String -> FilePath -> Test
+testMediaBag name docxFile = buildTest $ testMediaBagIO name docxFile
 
 tests :: [Test]
 tests = [ testGroup "inlines"
@@ -186,11 +209,9 @@ tests = [ testGroup "inlines"
             "docx.track_changes_deletion_all.native"
           ]
         , testGroup "media"
-          [ testCompareMedia
+          [ testMediaBag
             "image extraction"
             "docx.image.docx"
-            "media/image1.jpeg"
-            "docx.image1.jpeg"
           ]
         , testGroup "metadata"
           [ testCompareWithOpts def{readerStandalone=True}
diff --git a/tests/docx.image.docx b/tests/docx.image.docx
index 060f2b204..06e4efd1a 100644
--- a/tests/docx.image.docx
+++ b/tests/docx.image.docx
diff --git a/tests/docx.image1.jpeg b/tests/docx.image1.jpeg
deleted file mode 100644
index 423dff48b..000000000
--- a/tests/docx.image1.jpeg
+++ /dev/null
diff --git a/tests/docx.image_no_embed.native b/tests/docx.image_no_embed.native
index aa0f65d27..95c73610e 100644
--- a/tests/docx.image_no_embed.native
+++ b/tests/docx.image_no_embed.native
@@ -1,2 +1,2 @@
-[Header 2 ("an-image",[],[]) [Str "An",Space,Str "image"]
-,Para [Image [] ("media/image1.jpeg","")]]
+[Para [Str "An",Space,Str "image:"]
+,Para [Image [] ("media/image1.jpg","")]]