{-# LANGUAGE CPP                        #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{- |
   Module      : Text.Pandoc.MediaBag
   Copyright   : Copyright (C) 2014-2015, 2017-2024 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 Network.URI (unEscapeString)
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, isURI)
import Data.List (isInfixOf)

data MediaItem =
  MediaItem
  { MediaItem -> Text
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
$c== :: MediaItem -> MediaItem -> Bool
== :: MediaItem -> MediaItem -> Bool
$c/= :: MediaItem -> MediaItem -> Bool
/= :: 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
$ccompare :: MediaItem -> MediaItem -> Ordering
compare :: MediaItem -> MediaItem -> Ordering
$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
>= :: MediaItem -> MediaItem -> Bool
$cmax :: MediaItem -> MediaItem -> MediaItem
max :: MediaItem -> MediaItem -> MediaItem
$cmin :: MediaItem -> MediaItem -> MediaItem
min :: MediaItem -> MediaItem -> 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
$cshowsPrec :: Int -> MediaItem -> ShowS
showsPrec :: Int -> MediaItem -> ShowS
$cshow :: MediaItem -> FilePath
show :: MediaItem -> FilePath
$cshowList :: [MediaItem] -> ShowS
showList :: [MediaItem] -> ShowS
Show, Typeable MediaItem
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 -> Constr
MediaItem -> DataType
(forall b. Data b => b -> b) -> MediaItem -> 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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MediaItem -> c MediaItem
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MediaItem -> c MediaItem
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MediaItem
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MediaItem
$ctoConstr :: MediaItem -> Constr
toConstr :: MediaItem -> Constr
$cdataTypeOf :: MediaItem -> DataType
dataTypeOf :: MediaItem -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MediaItem)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MediaItem)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MediaItem)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MediaItem)
$cgmapT :: (forall b. Data b => b -> b) -> MediaItem -> MediaItem
gmapT :: (forall b. Data b => b -> b) -> MediaItem -> MediaItem
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MediaItem -> r
gmapQl :: forall r r'.
(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
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MediaItem -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> MediaItem -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> MediaItem -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> MediaItem -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> MediaItem -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MediaItem -> m MediaItem
gmapM :: forall (m :: * -> *).
Monad m =>
(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
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(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
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MediaItem -> m 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 (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
$c<> :: MediaBag -> MediaBag -> MediaBag
<> :: MediaBag -> MediaBag -> MediaBag
$csconcat :: NonEmpty MediaBag -> MediaBag
sconcat :: NonEmpty MediaBag -> MediaBag
$cstimes :: forall b. Integral b => b -> MediaBag -> MediaBag
stimes :: forall b. Integral b => b -> 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
$cmempty :: MediaBag
mempty :: MediaBag
$cmappend :: MediaBag -> MediaBag -> MediaBag
mappend :: MediaBag -> MediaBag -> MediaBag
$cmconcat :: [MediaBag] -> MediaBag
mconcat :: [MediaBag] -> MediaBag
Monoid, Typeable MediaBag
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 -> Constr
MediaBag -> DataType
(forall b. Data b => b -> b) -> MediaBag -> 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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MediaBag -> c MediaBag
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MediaBag -> c MediaBag
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MediaBag
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MediaBag
$ctoConstr :: MediaBag -> Constr
toConstr :: MediaBag -> Constr
$cdataTypeOf :: MediaBag -> DataType
dataTypeOf :: MediaBag -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MediaBag)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MediaBag)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MediaBag)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MediaBag)
$cgmapT :: (forall b. Data b => b -> b) -> MediaBag -> MediaBag
gmapT :: (forall b. Data b => b -> b) -> MediaBag -> MediaBag
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MediaBag -> r
gmapQl :: forall r r'.
(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
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MediaBag -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> MediaBag -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> MediaBag -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> MediaBag -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> MediaBag -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MediaBag -> m MediaBag
gmapM :: forall (m :: * -> *).
Monad m =>
(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
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(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
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MediaBag -> m MediaBag
Data, Typeable)

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

-- | We represent paths with /, in normalized form.  Percent-encoding
-- is not resolved.
canonicalize :: FilePath -> Text
canonicalize :: FilePath -> Text
canonicalize FilePath
fp
  | FilePath -> Bool
isURI FilePath
fp = FilePath -> Text
T.pack FilePath
fp
  | Bool
otherwise = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\\" Text
"/" (Text -> Text) -> (FilePath -> Text) -> FilePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> Text) -> ShowS -> FilePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
normalise (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath
fp

-- | 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 Text MediaItem
mediamap) =
  Map Text MediaItem -> MediaBag
MediaBag (Map Text MediaItem -> MediaBag) -> Map Text MediaItem -> MediaBag
forall a b. (a -> b) -> a -> b
$ Text -> Map Text MediaItem -> Map Text MediaItem
forall k a. Ord k => k -> Map k a -> Map k a
M.delete (FilePath -> Text
canonicalize FilePath
fp) Map Text 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 Text -> ByteString -> MediaBag -> MediaBag
insertMedia FilePath
fp Maybe Text
mbMime ByteString
contents (MediaBag Map Text MediaItem
mediamap) =
  Map Text MediaItem -> MediaBag
MediaBag (Text -> MediaItem -> Map Text MediaItem -> Map Text MediaItem
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
fp' MediaItem
mediaItem Map Text MediaItem
mediamap)
  where mediaItem :: MediaItem
mediaItem = MediaItem{ mediaPath :: FilePath
mediaPath = FilePath
newpath
                             , mediaContents :: ByteString
mediaContents = ByteString
contents
                             , mediaMimeType :: Text
mediaMimeType = Text
mt }
        fp' :: Text
fp' = FilePath -> Text
canonicalize FilePath
fp
        fp'' :: FilePath
fp'' = ShowS
unEscapeString ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
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
&& Bool -> Bool
not (FilePath
".." FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` FilePath
fp'')
                       Bool -> Bool -> Bool
&& Char
'%' Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` FilePath
fp''
                     then FilePath
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
ext
        fallback :: Text
fallback = case ShowS
takeExtension FilePath
fp'' of
                        FilePath
".gz" -> FilePath -> Text
getMimeTypeDef (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
dropExtension FilePath
fp''
                        FilePath
_     -> FilePath -> Text
getMimeTypeDef FilePath
fp''
        mt :: Text
mt = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
fallback Maybe Text
mbMime
        path :: FilePath
path = FilePath -> (URI -> FilePath) -> Maybe URI -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
fp'' (ShowS
unEscapeString ShowS -> (URI -> FilePath) -> URI -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> FilePath
uriPath) Maybe URI
uri
        ext :: FilePath
ext = case ShowS
takeExtension FilePath
path of
                Char
'.':FilePath
e | Char
'%' Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` FilePath
e -> Char
'.'Char -> ShowS
forall a. a -> [a] -> [a]
:FilePath
e
                FilePath
_ -> FilePath -> (Text -> FilePath) -> Maybe Text -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"" (\Text
x -> Char
'.'Char -> ShowS
forall a. a -> [a] -> [a]
:Text -> FilePath
T.unpack Text
x) (Maybe Text -> FilePath) -> Maybe Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
extensionFromMimeType Text
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 Text MediaItem
mediamap) = Text -> Map Text MediaItem -> Maybe MediaItem
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (FilePath -> Text
canonicalize FilePath
fp) Map Text 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, Text, Int)]
mediaDirectory MediaBag
mediabag =
  ((FilePath, Text, ByteString) -> (FilePath, Text, Int))
-> [(FilePath, Text, ByteString)] -> [(FilePath, Text, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\(FilePath
fp, Text
mt, ByteString
bs) -> (FilePath
fp, Text
mt, Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BL.length ByteString
bs)))
    (MediaBag -> [(FilePath, Text, ByteString)]
mediaItems MediaBag
mediabag)

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