{-# LANGUAGE CPP                        #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{- |
   Module      : Text.Pandoc.MediaBag
   Copyright   : Copyright (C) 2014-2015, 2017-2022 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 qualified System.FilePath.Posix as Posix
import qualified System.FilePath.Windows as Windows
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
Posix.isRelative FilePath
fp
                       Bool -> Bool -> Bool
&& FilePath -> Bool
Windows.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]
splitDirectories 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)