{-# 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 (hashlazy, Digest, SHA1)
import qualified Data.ByteString.Lazy as BL
import Data.Char (toLower)
import Data.Data (Data)
import qualified Data.Map.Strict 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 Text.Pandoc.Shared (makeCanonical)
import Data.Text (Text)
import qualified Data.Text as T
import Network.URI (URI (..), parseURI, unEscapeString)
import Text.Pandoc.URI (isURI)

data MediaItem =
  MediaItem
  { MediaItem -> Text
mediaMimeType :: !MimeType
  , MediaItem -> [Char]
mediaPath :: !FilePath
  , MediaItem -> ByteString
mediaContents :: BL.ByteString
    -- ^ Left lazy so that contents need not be forced at insert time.
  } 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 -> [Char]
(Int -> MediaItem -> ShowS)
-> (MediaItem -> [Char])
-> ([MediaItem] -> ShowS)
-> Show MediaItem
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MediaItem -> ShowS
showsPrec :: Int -> MediaItem -> ShowS
$cshow :: MediaItem -> [Char]
show :: MediaItem -> [Char]
$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 -> [Char]
show MediaBag
bag = [Char]
"MediaBag " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [([Char], Text, Int)] -> [Char]
forall a. Show a => a -> [Char]
show (MediaBag -> [([Char], Text, Int)]
mediaDirectory MediaBag
bag)

-- | Check for the (case-insensitive) @data:@ URI scheme.
isDataURI :: FilePath -> Bool
isDataURI :: [Char] -> Bool
isDataURI = ([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"data:") ([Char] -> Bool) -> ShowS -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
5

-- | We represent paths with /, in canonical form (redundant @.@ and
-- @..@ components removed).  Percent-encoding is not resolved.
canonicalize :: FilePath -> Text
canonicalize :: [Char] -> Text
canonicalize [Char]
fp
  -- avoid an expensive call to isURI for data URIs:
  | [Char] -> Bool
isDataURI [Char]
fp = Text
fp'
  | Text -> Bool
isURI Text
fp' = Text
fp'
  | Bool
otherwise = [Char] -> Text
T.pack ([Char] -> Text) -> ShowS -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
makeCanonical ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
slashify ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
fp
 where
  fp' :: Text
fp' = [Char] -> Text
T.pack [Char]
fp
  slashify :: Char -> Char
slashify Char
'\\' = Char
'/'
  slashify Char
c    = Char
c

-- | 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 :: [Char] -> MediaBag -> MediaBag
deleteMedia [Char]
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 ([Char] -> Text
canonicalize [Char]
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 :: [Char] -> Maybe Text -> ByteString -> MediaBag -> MediaBag
insertMedia [Char]
fp Maybe Text
mbMime ByteString
contents (MediaBag Map Text MediaItem
mediamap)
 | [Char] -> Bool
isDataURI [Char]
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 :: [Char]
mediaPath = [Char]
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 :: [Char]
mediaPath = [Char]
newpath
                       , mediaContents :: ByteString
mediaContents = ByteString
contents
                       , mediaMimeType :: Text
mediaMimeType = Text
mt }
  fp' :: Text
fp' = [Char] -> Text
canonicalize [Char]
fp
  fp'' :: [Char]
fp'' = ShowS
unEscapeString ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
fp'
  uri :: Maybe URI
uri = [Char] -> Maybe URI
parseURI [Char]
fp
  hashpath :: [Char]
hashpath = Digest SHA1 -> [Char]
forall a. Show a => a -> [Char]
show (ByteString -> Digest SHA1
forall a. HashAlgorithm a => ByteString -> Digest a
hashlazy ByteString
contents :: Digest SHA1) [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
ext
  -- We only keep the original name if the key contains no
  -- percent-encoding, i.e., unescaping is the identity; otherwise
  -- distinct keys (e.g. "a%20b.png" and "a b.png") could unescape
  -- to the same mediaPath and clobber each other on extraction.
  newpath :: [Char]
newpath = if [Char] -> Bool
Posix.isRelative [Char]
fp''
                 Bool -> Bool -> Bool
&& [Char] -> Bool
Windows.isRelative [Char]
fp''
                 Bool -> Bool -> Bool
&& Maybe URI -> Bool
forall a. Maybe a -> Bool
isNothing Maybe URI
uri
                 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
containsParentRef
                 Bool -> Bool -> Bool
&& Bool -> Bool
not ((Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'%') Text
fp')
               then [Char]
fp''
               else [Char]
hashpath
  -- Check for a ".." path component (treating both / and \ as
  -- separators, since the unescaped path may contain backslashes
  -- from percent-encoding); a mere ".." substring (as in
  -- "foo..bar.png") is harmless.
  containsParentRef :: Bool
containsParentRef = [Char]
".." [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`
    [Char] -> [[Char]]
Posix.splitDirectories ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\' then Char
'/' else Char
c) [Char]
fp'')
  fallback :: Text
fallback = case ShowS
takeExtension [Char]
fp'' of
                  [Char]
".gz" -> [Char] -> Text
getMimeTypeDef ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
dropExtension [Char]
fp''
                  [Char]
_     -> [Char] -> Text
getMimeTypeDef [Char]
fp''
  mt :: Text
mt = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
fallback Maybe Text
mbMime
  path :: [Char]
path = [Char] -> (URI -> [Char]) -> Maybe URI -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
fp'' (ShowS
unEscapeString ShowS -> (URI -> [Char]) -> URI -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> [Char]
uriPath) Maybe URI
uri
  ext :: [Char]
ext = case Text -> Maybe Text
extensionFromMimeType Text
mt of
             Just Text
e -> Char
'.'Char -> ShowS
forall a. a -> [a] -> [a]
:Text -> [Char]
T.unpack Text
e
             Maybe Text
Nothing -> case ShowS
takeExtension [Char]
path of
                             Char
'.':[Char]
e | Char
'%' Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char]
e -> Char
'.'Char -> ShowS
forall a. a -> [a] -> [a]
:[Char]
e
                             [Char]
_ -> [Char]
""

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

mediaItems :: MediaBag -> [(FilePath, MimeType, BL.ByteString)]
mediaItems :: MediaBag -> [([Char], Text, ByteString)]
mediaItems (MediaBag Map Text MediaItem
mediamap) =
  (MediaItem -> ([Char], Text, ByteString))
-> [MediaItem] -> [([Char], Text, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map (\MediaItem
item -> (MediaItem -> [Char]
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)