Text.Pandoc.MediaBag: change type to use a Text key...

instead of `[FilePath]`.
We normalize the path and use `/` separators for consistency.

2 files changed, 14 insertions, 7 deletions

diff --git a/src/Text/Pandoc/Class/PandocMonad.hs b/src/Text/Pandoc/Class/PandocMonad.hs
index 7559cd7cd..226194503 100644
--- a/src/Text/Pandoc/Class/PandocMonad.hs
+++ b/src/Text/Pandoc/Class/PandocMonad.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
diff --git a/src/Text/Pandoc/MediaBag.hs b/src/Text/Pandoc/MediaBag.hs
index 3249bcdeb..4a9b4efa1 100644
--- a/src/Text/Pandoc/MediaBag.hs
+++ b/src/Text/Pandoc/MediaBag.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP                        #-}
+{-# LANGUAGE OverloadedStrings          #-}
 {-# LANGUAGE DeriveDataTypeable         #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {- |
@@ -27,26 +28,31 @@ import qualified Data.Map as M
 import Data.Maybe (fromMaybe)
 import Data.Typeable (Typeable)
 import System.FilePath
-import qualified System.FilePath.Posix as Posix
 import Text.Pandoc.MIME (MimeType, getMimeTypeDef)
+import Data.Text (Text)
+import qualified Data.Text as T
 
 -- | A container for a collection of binary resources, with names and
 -- mime types.  Note that a 'MediaBag' is a Monoid, so 'mempty'
 -- can be used for an empty 'MediaBag', and '<>' can be used to append
 -- two 'MediaBag's.
-newtype MediaBag = MediaBag (M.Map [FilePath] (MimeType, BL.ByteString))
+newtype MediaBag = MediaBag (M.Map Text (MimeType, BL.ByteString))
         deriving (Semigroup, Monoid, Data, Typeable)
 
 instance Show MediaBag where
   show bag = "MediaBag " ++ show (mediaDirectory bag)
 
+-- | We represent paths with /, in normalized form.
+canonicalize :: FilePath -> Text
+canonicalize = T.replace "\\" "/" . T.pack . normalise
+
 -- | Delete a media item from a 'MediaBag', or do nothing if no item corresponds
 -- to the given path.
 deleteMedia :: FilePath       -- ^ relative path and canonical name of resource
             -> MediaBag
             -> MediaBag
 deleteMedia fp (MediaBag mediamap) =
-  MediaBag $ M.delete (splitDirectories fp) mediamap
+  MediaBag $ M.delete (canonicalize fp) mediamap
 
 -- | Insert a media item into a 'MediaBag', replacing any existing
 -- value with the same name.
@@ -56,7 +62,7 @@ insertMedia :: FilePath       -- ^ relative path and canonical name of resource
             -> MediaBag
             -> MediaBag
 insertMedia fp mbMime contents (MediaBag mediamap) =
-  MediaBag (M.insert (splitDirectories fp) (mime, contents) mediamap)
+  MediaBag (M.insert (canonicalize fp) (mime, contents) mediamap)
   where mime = fromMaybe fallback mbMime
         fallback = case takeExtension fp of
                         ".gz" -> getMimeTypeDef $ dropExtension fp
@@ -66,16 +72,16 @@ insertMedia fp mbMime contents (MediaBag mediamap) =
 lookupMedia :: FilePath
             -> MediaBag
             -> Maybe (MimeType, BL.ByteString)
-lookupMedia fp (MediaBag mediamap) = M.lookup (splitDirectories fp) mediamap
+lookupMedia fp (MediaBag mediamap) = M.lookup (canonicalize fp) mediamap
 
 -- | Get a list of the file paths stored in a 'MediaBag', with
 -- their corresponding mime types and the lengths in bytes of the contents.
 mediaDirectory :: MediaBag -> [(FilePath, MimeType, Int)]
 mediaDirectory (MediaBag mediamap) =
   M.foldrWithKey (\fp (mime,contents) ->
-      ((Posix.joinPath fp, mime, fromIntegral $ BL.length contents):)) [] mediamap
+      ((T.unpack fp, mime, fromIntegral (BL.length contents)):)) [] mediamap
 
 mediaItems :: MediaBag -> [(FilePath, MimeType, BL.ByteString)]
 mediaItems (MediaBag mediamap) =
   M.foldrWithKey (\fp (mime,contents) ->
-      ((Posix.joinPath fp, mime, contents):)) [] mediamap
+      ((T.unpack fp, mime, contents):)) [] mediamap