@@ -1,4 +1,5 @@
1{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
2+{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE DeriveDataTypeable #-}
3{-# LANGUAGE DeriveDataTypeable #-}
3{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4{-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -27,26 +28,31 @@ import qualified Data.Map as M
27import Data.Maybe (fromMaybe)
28import Data.Maybe (fromMaybe)
28import Data.Typeable (Typeable)
29import Data.Typeable (Typeable)
29import System.FilePath
30import System.FilePath
30−import qualified System.FilePath.Posix as Posix
31import Text.Pandoc.MIME (MimeType, getMimeTypeDef)
31import Text.Pandoc.MIME (MimeType, getMimeTypeDef)
32+import Data.Text (Text)
33+import qualified Data.Text as T
33-- | A container for a collection of binary resources, with names and
35-- | A container for a collection of binary resources, with names and
34-- mime types. Note that a 'MediaBag' is a Monoid, so 'mempty'
36-- mime types. Note that a 'MediaBag' is a Monoid, so 'mempty'
35-- can be used for an empty 'MediaBag', and '<>' can be used to append
37-- can be used for an empty 'MediaBag', and '<>' can be used to append
36-- two 'MediaBag's.
38-- two 'MediaBag's.
37−newtype MediaBag = MediaBag (M.Map [FilePath] (MimeType, BL.ByteString))
39+newtype MediaBag = MediaBag (M.Map Text (MimeType, BL.ByteString))
38 deriving (Semigroup, Monoid, Data, Typeable)
40 deriving (Semigroup, Monoid, Data, Typeable)
40instance Show MediaBag where
42instance Show MediaBag where
41 show bag = "MediaBag " ++ show (mediaDirectory bag)
43 show bag = "MediaBag " ++ show (mediaDirectory bag)
45+-- | We represent paths with /, in normalized form.
46+canonicalize :: FilePath -> Text
47+canonicalize = T.replace "\\" "/" . T.pack . normalise
43-- | Delete a media item from a 'MediaBag', or do nothing if no item corresponds
49-- | Delete a media item from a 'MediaBag', or do nothing if no item corresponds
44-- to the given path.
50-- to the given path.
45deleteMedia :: FilePath -- ^ relative path and canonical name of resource
51deleteMedia :: FilePath -- ^ relative path and canonical name of resource
46 -> MediaBag
52 -> MediaBag
47 -> MediaBag
53 -> MediaBag
48deleteMedia fp (MediaBag mediamap) =
54deleteMedia fp (MediaBag mediamap) =
49− MediaBag $ M.delete (splitDirectories fp) mediamap
55+ MediaBag $ M.delete (canonicalize fp) mediamap
51-- | Insert a media item into a 'MediaBag', replacing any existing
57-- | Insert a media item into a 'MediaBag', replacing any existing
52-- value with the same name.
58-- value with the same name.
@@ -56,7 +62,7 @@ insertMedia :: FilePath -- ^ relative path and canonical name of resource
56 -> MediaBag
62 -> MediaBag
57 -> MediaBag
63 -> MediaBag
58insertMedia fp mbMime contents (MediaBag mediamap) =
64insertMedia fp mbMime contents (MediaBag mediamap) =
59− MediaBag (M.insert (splitDirectories fp) (mime, contents) mediamap)
65+ MediaBag (M.insert (canonicalize fp) (mime, contents) mediamap)
60 where mime = fromMaybe fallback mbMime
66 where mime = fromMaybe fallback mbMime
61 fallback = case takeExtension fp of
67 fallback = case takeExtension fp of
62 ".gz" -> getMimeTypeDef $ dropExtension fp
68 ".gz" -> getMimeTypeDef $ dropExtension fp
@@ -66,16 +72,16 @@ insertMedia fp mbMime contents (MediaBag mediamap) =
66lookupMedia :: FilePath
72lookupMedia :: FilePath
67 -> MediaBag
73 -> MediaBag
68 -> Maybe (MimeType, BL.ByteString)
74 -> Maybe (MimeType, BL.ByteString)
69−lookupMedia fp (MediaBag mediamap) = M.lookup (splitDirectories fp) mediamap
75+lookupMedia fp (MediaBag mediamap) = M.lookup (canonicalize fp) mediamap
71-- | Get a list of the file paths stored in a 'MediaBag', with
77-- | Get a list of the file paths stored in a 'MediaBag', with
72-- their corresponding mime types and the lengths in bytes of the contents.
78-- their corresponding mime types and the lengths in bytes of the contents.
73mediaDirectory :: MediaBag -> [(FilePath, MimeType, Int)]
79mediaDirectory :: MediaBag -> [(FilePath, MimeType, Int)]
74mediaDirectory (MediaBag mediamap) =
80mediaDirectory (MediaBag mediamap) =
75 M.foldrWithKey (\fp (mime,contents) ->
81 M.foldrWithKey (\fp (mime,contents) ->
76− ((Posix.joinPath fp, mime, fromIntegral $ BL.length contents):)) [] mediamap
82+ ((T.unpack fp, mime, fromIntegral (BL.length contents)):)) [] mediamap
78mediaItems :: MediaBag -> [(FilePath, MimeType, BL.ByteString)]
84mediaItems :: MediaBag -> [(FilePath, MimeType, BL.ByteString)]
79mediaItems (MediaBag mediamap) =
85mediaItems (MediaBag mediamap) =
80 M.foldrWithKey (\fp (mime,contents) ->
86 M.foldrWithKey (\fp (mime,contents) ->
81− ((Posix.joinPath fp, mime, contents):)) [] mediamap
87+ ((T.unpack fp, mime, contents):)) [] mediamap