{-# LANGUAGE CPP                        #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{- |
   Module      : Text.Pandoc.MediaBag
   Copyright   : Copyright (C) 2014-2015, 2017-2021 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

Definition of a MediaBag object to hold binary resources, and an
interface for interacting with it.
-}
module Text.Pandoc.MediaBag (
                     MediaItem(..),
                     MediaBag,
                     deleteMedia,
                     lookupMedia,
                     insertMedia,
                     mediaDirectory,
                     mediaItems
                     ) where
import qualified Data.ByteString.Lazy as BL
import Data.Data (Data)
import qualified Data.Map as M
import Data.Maybe (fromMaybe, isNothing)
import Data.Typeable (Typeable)
import System.FilePath
import Text.Pandoc.MIME (MimeType, getMimeTypeDef, extensionFromMimeType)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Digest.Pure.SHA (sha1, showDigest)
import Network.URI (URI (..), parseURI)

data MediaItem =
  MediaItem
  { MediaItem -> MimeType
mediaMimeType :: MimeType
  , MediaItem -> FilePath
mediaPath :: FilePath
  , MediaItem -> ByteString
mediaContents :: BL.ByteString
  } deriving (MediaItem -> MediaItem -> Bool
(MediaItem -> MediaItem -> Bool)
-> (MediaItem -> MediaItem -> Bool) -> Eq MediaItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MediaItem -> MediaItem -> Bool
$c/= :: MediaItem -> MediaItem -> Bool
== :: MediaItem -> MediaItem -> Bool
$c== :: MediaItem -> MediaItem -> Bool
Eq, Eq MediaItem
Eq MediaItem
-> (MediaItem -> MediaItem -> Ordering)
-> (MediaItem -> MediaItem -> Bool)
-> (MediaItem -> MediaItem -> Bool)
-> (MediaItem -> MediaItem -> Bool)
-> (MediaItem -> MediaItem -> Bool)
-> (MediaItem -> MediaItem -> MediaItem)
-> (MediaItem -> MediaItem -> MediaItem)
-> Ord MediaItem
MediaItem -> MediaItem -> Bool
MediaItem -> MediaItem -> Ordering
MediaItem -> MediaItem -> MediaItem
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MediaItem -> MediaItem -> MediaItem
$cmin :: MediaItem -> MediaItem -> MediaItem
max :: MediaItem -> MediaItem -> MediaItem
$cmax :: MediaItem -> MediaItem -> MediaItem
>= :: MediaItem -> MediaItem -> Bool
$c>= :: MediaItem -> MediaItem -> Bool
> :: MediaItem -> MediaItem -> Bool
$c> :: MediaItem -> MediaItem -> Bool
<= :: MediaItem -> MediaItem -> Bool
$c<= :: MediaItem -> MediaItem -> Bool
< :: MediaItem -> MediaItem -> Bool
$c< :: MediaItem -> MediaItem -> Bool
compare :: MediaItem -> MediaItem -> Ordering
$ccompare :: MediaItem -> MediaItem -> Ordering
$cp1Ord :: Eq MediaItem
Ord, Int -> MediaItem -> ShowS
[MediaItem] -> ShowS
MediaItem -> FilePath
(Int -> MediaItem -> ShowS)
-> (MediaItem -> FilePath)
-> ([MediaItem] -> ShowS)
-> Show MediaItem
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MediaItem] -> ShowS
$cshowList :: [MediaItem] -> ShowS
show :: MediaItem -> FilePath
$cshow :: MediaItem -> FilePath
showsPrec :: Int -> MediaItem -> ShowS
$cshowsPrec :: Int -> MediaItem -> ShowS
Show, Typeable MediaItem
DataType
Constr
Typeable MediaItem
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> MediaItem -> c MediaItem)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c MediaItem)
-> (MediaItem -> Constr)
-> (MediaItem -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c MediaItem))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MediaItem))
-> ((forall b. Data b => b -> b) -> MediaItem -> MediaItem)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> MediaItem -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> MediaItem -> r)
-> (forall u. (forall d. Data d => d -> u) -> MediaItem -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> MediaItem -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> MediaItem -> m MediaItem)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> MediaItem -> m MediaItem)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> MediaItem -> m MediaItem)
-> Data MediaItem
MediaItem -> DataType
MediaItem -> Constr
(forall b. Data b => b -> b) -> MediaItem -> MediaItem
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MediaItem -> c MediaItem
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MediaItem
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> MediaItem -> u
forall u. (forall d. Data d => d -> u) -> MediaItem -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MediaItem -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MediaItem -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MediaItem -> m MediaItem
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MediaItem -> m MediaItem
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MediaItem
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MediaItem -> c MediaItem
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MediaItem)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MediaItem)
$cMediaItem :: Constr
$tMediaItem :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> MediaItem -> m MediaItem
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MediaItem -> m MediaItem
gmapMp :: (forall d. Data d => d -> m d) -> MediaItem -> m MediaItem
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MediaItem -> m MediaItem
gmapM :: (forall d. Data d => d -> m d) -> MediaItem -> m MediaItem
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MediaItem -> m MediaItem
gmapQi :: Int -> (forall d. Data d => d -> u) -> MediaItem -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> MediaItem -> u
gmapQ :: (forall d. Data d => d -> u) -> MediaItem -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> MediaItem -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MediaItem -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MediaItem -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MediaItem -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MediaItem -> r
gmapT :: (forall b. Data b => b -> b) -> MediaItem -> MediaItem
$cgmapT :: (forall b. Data b => b -> b) -> MediaItem -> MediaItem
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MediaItem)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MediaItem)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c MediaItem)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MediaItem)
dataTypeOf :: MediaItem -> DataType
$cdataTypeOf :: MediaItem -> DataType
toConstr :: MediaItem -> Constr
$ctoConstr :: MediaItem -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MediaItem
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MediaItem
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MediaItem -> c MediaItem
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MediaItem -> c MediaItem
$cp1Data :: Typeable MediaItem
Data, Typeable)

-- | 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 Text MediaItem)
        deriving (b -> MediaBag -> MediaBag
NonEmpty MediaBag -> MediaBag
MediaBag -> MediaBag -> MediaBag
(MediaBag -> MediaBag -> MediaBag)
-> (NonEmpty MediaBag -> MediaBag)
-> (forall b. Integral b => b -> MediaBag -> MediaBag)
-> Semigroup MediaBag
forall b. Integral b => b -> MediaBag -> MediaBag
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> MediaBag -> MediaBag
$cstimes :: forall b. Integral b => b -> MediaBag -> MediaBag
sconcat :: NonEmpty MediaBag -> MediaBag
$csconcat :: NonEmpty MediaBag -> MediaBag
<> :: MediaBag -> MediaBag -> MediaBag
$c<> :: MediaBag -> MediaBag -> MediaBag
Semigroup, Semigroup MediaBag
MediaBag
Semigroup MediaBag
-> MediaBag
-> (MediaBag -> MediaBag -> MediaBag)
-> ([MediaBag] -> MediaBag)
-> Monoid MediaBag
[MediaBag] -> MediaBag
MediaBag -> MediaBag -> MediaBag
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [MediaBag] -> MediaBag
$cmconcat :: [MediaBag] -> MediaBag
mappend :: MediaBag -> MediaBag -> MediaBag
$cmappend :: MediaBag -> MediaBag -> MediaBag
mempty :: MediaBag
$cmempty :: MediaBag
$cp1Monoid :: Semigroup MediaBag
Monoid, Typeable MediaBag
DataType
Constr
Typeable MediaBag
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> MediaBag -> c MediaBag)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c MediaBag)
-> (MediaBag -> Constr)
-> (MediaBag -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c MediaBag))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MediaBag))
-> ((forall b. Data b => b -> b) -> MediaBag -> MediaBag)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> MediaBag -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> MediaBag -> r)
-> (forall u. (forall d. Data d => d -> u) -> MediaBag -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> MediaBag -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> MediaBag -> m MediaBag)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> MediaBag -> m MediaBag)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> MediaBag -> m MediaBag)
-> Data MediaBag
MediaBag -> DataType
MediaBag -> Constr
(forall b. Data b => b -> b) -> MediaBag -> MediaBag
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MediaBag -> c MediaBag
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MediaBag
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> MediaBag -> u
forall u. (forall d. Data d => d -> u) -> MediaBag -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MediaBag -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MediaBag -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MediaBag -> m MediaBag
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MediaBag -> m MediaBag
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MediaBag
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MediaBag -> c MediaBag
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MediaBag)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MediaBag)
$cMediaBag :: Constr
$tMediaBag :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> MediaBag -> m MediaBag
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MediaBag -> m MediaBag
gmapMp :: (forall d. Data d => d -> m d) -> MediaBag -> m MediaBag
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MediaBag -> m MediaBag
gmapM :: (forall d. Data d => d -> m d) -> MediaBag -> m MediaBag
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MediaBag -> m MediaBag
gmapQi :: Int -> (forall d. Data d => d -> u) -> MediaBag -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> MediaBag -> u
gmapQ :: (forall d. Data d => d -> u) -> MediaBag -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> MediaBag -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MediaBag -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MediaBag -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MediaBag -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MediaBag -> r
gmapT :: (forall b. Data b => b -> b) -> MediaBag -> MediaBag
$cgmapT :: (forall b. Data b => b -> b) -> MediaBag -> MediaBag
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MediaBag)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MediaBag)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c MediaBag)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MediaBag)
dataTypeOf :: MediaBag -> DataType
$cdataTypeOf :: MediaBag -> DataType
toConstr :: MediaBag -> Constr
$ctoConstr :: MediaBag -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MediaBag
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MediaBag
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MediaBag -> c MediaBag
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MediaBag -> c MediaBag
$cp1Data :: Typeable MediaBag
Data, Typeable)

instance Show MediaBag where
  show :: MediaBag -> FilePath
show MediaBag
bag = FilePath
"MediaBag " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ [(FilePath, MimeType, Int)] -> FilePath
forall a. Show a => a -> FilePath
show (MediaBag -> [(FilePath, MimeType, Int)]
mediaDirectory MediaBag
bag)

-- | We represent paths with /, in normalized form.
canonicalize :: FilePath -> Text
canonicalize :: FilePath -> MimeType
canonicalize = MimeType -> MimeType -> MimeType -> MimeType
T.replace MimeType
"\\" MimeType
"/" (MimeType -> MimeType)
-> (FilePath -> MimeType) -> FilePath -> MimeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> MimeType
T.pack (FilePath -> MimeType) -> ShowS -> FilePath -> MimeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
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 :: FilePath -> MediaBag -> MediaBag
deleteMedia FilePath
fp (MediaBag Map MimeType MediaItem
mediamap) =
  Map MimeType MediaItem -> MediaBag
MediaBag (Map MimeType MediaItem -> MediaBag)
-> Map MimeType MediaItem -> MediaBag
forall a b. (a -> b) -> a -> b
$ MimeType -> Map MimeType MediaItem -> Map MimeType MediaItem
forall k a. Ord k => k -> Map k a -> Map k a
M.delete (FilePath -> MimeType
canonicalize FilePath
fp) Map MimeType MediaItem
mediamap

-- | Insert a media item into a 'MediaBag', replacing any existing
-- value with the same name.
insertMedia :: FilePath       -- ^ relative path and canonical name of resource
            -> Maybe MimeType -- ^ mime type (Nothing = determine from extension)
            -> BL.ByteString  -- ^ contents of resource
            -> MediaBag
            -> MediaBag
insertMedia :: FilePath -> Maybe MimeType -> ByteString -> MediaBag -> MediaBag
insertMedia FilePath
fp Maybe MimeType
mbMime ByteString
contents (MediaBag Map MimeType MediaItem
mediamap) =
  Map MimeType MediaItem -> MediaBag
MediaBag (MimeType
-> MediaItem -> Map MimeType MediaItem -> Map MimeType MediaItem
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert MimeType
fp' MediaItem
mediaItem Map MimeType MediaItem
mediamap)
  where mediaItem :: MediaItem
mediaItem = MediaItem :: MimeType -> FilePath -> ByteString -> MediaItem
MediaItem{ mediaPath :: FilePath
mediaPath = FilePath
newpath
                             , mediaContents :: ByteString
mediaContents = ByteString
contents
                             , mediaMimeType :: MimeType
mediaMimeType = MimeType
mt }
        fp' :: MimeType
fp' = FilePath -> MimeType
canonicalize FilePath
fp
        uri :: Maybe URI
uri = FilePath -> Maybe URI
parseURI FilePath
fp
        newpath :: FilePath
newpath = if FilePath -> Bool
isRelative FilePath
fp
                       Bool -> Bool -> Bool
&& Maybe URI -> Bool
forall a. Maybe a -> Bool
isNothing Maybe URI
uri
                       Bool -> Bool -> Bool
&& FilePath
".." FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` FilePath -> [FilePath]
splitPath FilePath
fp
                     then MimeType -> FilePath
T.unpack MimeType
fp'
                     else Digest SHA1State -> FilePath
forall t. Digest t -> FilePath
showDigest (ByteString -> Digest SHA1State
sha1 ByteString
contents) FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"." FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
ext
        fallback :: MimeType
fallback = case ShowS
takeExtension FilePath
fp of
                        FilePath
".gz" -> FilePath -> MimeType
getMimeTypeDef (FilePath -> MimeType) -> FilePath -> MimeType
forall a b. (a -> b) -> a -> b
$ ShowS
dropExtension FilePath
fp
                        FilePath
_     -> FilePath -> MimeType
getMimeTypeDef FilePath
fp
        mt :: MimeType
mt = MimeType -> Maybe MimeType -> MimeType
forall a. a -> Maybe a -> a
fromMaybe MimeType
fallback Maybe MimeType
mbMime
        path :: FilePath
path = FilePath -> (URI -> FilePath) -> Maybe URI -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
fp URI -> FilePath
uriPath Maybe URI
uri
        ext :: FilePath
ext = case ShowS
takeExtension FilePath
path of
                Char
'.':FilePath
e -> FilePath
e
                FilePath
_ -> FilePath -> (MimeType -> FilePath) -> Maybe MimeType -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"" MimeType -> FilePath
T.unpack (Maybe MimeType -> FilePath) -> Maybe MimeType -> FilePath
forall a b. (a -> b) -> a -> b
$ MimeType -> Maybe MimeType
extensionFromMimeType MimeType
mt


-- | Lookup a media item in a 'MediaBag', returning mime type and contents.
lookupMedia :: FilePath
            -> MediaBag
            -> Maybe MediaItem
lookupMedia :: FilePath -> MediaBag -> Maybe MediaItem
lookupMedia FilePath
fp (MediaBag Map MimeType MediaItem
mediamap) = MimeType -> Map MimeType MediaItem -> Maybe MediaItem
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (FilePath -> MimeType
canonicalize FilePath
fp) Map MimeType MediaItem
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 -> [(FilePath, MimeType, Int)]
mediaDirectory MediaBag
mediabag =
  ((FilePath, MimeType, ByteString) -> (FilePath, MimeType, Int))
-> [(FilePath, MimeType, ByteString)]
-> [(FilePath, MimeType, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\(FilePath
fp, MimeType
mt, ByteString
bs) -> (FilePath
fp, MimeType
mt, Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BL.length ByteString
bs)))
    (MediaBag -> [(FilePath, MimeType, ByteString)]
mediaItems MediaBag
mediabag)

mediaItems :: MediaBag -> [(FilePath, MimeType, BL.ByteString)]
mediaItems :: MediaBag -> [(FilePath, MimeType, ByteString)]
mediaItems (MediaBag Map MimeType MediaItem
mediamap) =
  (MediaItem -> (FilePath, MimeType, ByteString))
-> [MediaItem] -> [(FilePath, MimeType, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map (\MediaItem
item -> (MediaItem -> FilePath
mediaPath MediaItem
item, MediaItem -> MimeType
mediaMimeType MediaItem
item, MediaItem -> ByteString
mediaContents MediaItem
item))
      (Map MimeType MediaItem -> [MediaItem]
forall k a. Map k a -> [a]
M.elems Map MimeType MediaItem
mediamap)