{-# 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 Crypto.Hash (hashWith, SHA1(SHA1))
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 Network.URI (URI (..), isURI, parseURI, unEscapeString)
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
-- avoid an expensive call to isURI for data URIs:
canonicalize :: FilePath -> Text
canonicalize fp :: FilePath
fp@(Char
'd':Char
'a':Char
't':Char
'a':Char
':':FilePath
_) = FilePath -> Text
T.pack FilePath
fp
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)
 | Char
'd':Char
'a':Char
't':Char
'a':Char
':':FilePath
_ <- FilePath
fp
 , Just Text
mt' <- Maybe Text
mbMime
   = 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{ mediaPath :: FilePath
mediaPath = FilePath
hashpath
                        , mediaContents :: ByteString
mediaContents = ByteString
contents
                        , mediaMimeType :: Text
mediaMimeType = Text
mt' } Map Text MediaItem
mediamap)
 | Bool
otherwise = 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
  hashpath :: FilePath
hashpath = Digest SHA1 -> FilePath
forall a. Show a => a -> FilePath
show (SHA1 -> StrictByteString -> Digest SHA1
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA1
SHA1 (ByteString -> StrictByteString
BL.toStrict ByteString
contents)) FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
ext
  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 FilePath
hashpath
  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 Text -> Maybe Text
extensionFromMimeType Text
mt of
             Just Text
e -> Char
'.'Char -> ShowS
forall a. a -> [a] -> [a]
:Text -> FilePath
T.unpack Text
e
             Maybe Text
Nothing -> 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
""

-- | 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)