{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{- |
   Module      : Text.Pandoc.MediaBag
   Copyright   : Copyright (C) 2014-2015, 2017–2020 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 (
                     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)
import Data.Typeable (Typeable)
import System.FilePath
import qualified System.FilePath.Posix as Posix
import Text.Pandoc.MIME (MimeType, getMimeTypeDef)

-- | 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 [FilePath] (MimeType, BL.ByteString))
        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 -> String
show MediaBag
bag = String
"MediaBag " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(String, MimeType, Int)] -> String
forall a. Show a => a -> String
show (MediaBag -> [(String, MimeType, Int)]
mediaDirectory MediaBag
bag)

-- | 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 :: String -> MediaBag -> MediaBag
deleteMedia String
fp (MediaBag Map [String] (MimeType, ByteString)
mediamap) =
  Map [String] (MimeType, ByteString) -> MediaBag
MediaBag (Map [String] (MimeType, ByteString) -> MediaBag)
-> Map [String] (MimeType, ByteString) -> MediaBag
forall a b. (a -> b) -> a -> b
$ [String]
-> Map [String] (MimeType, ByteString)
-> Map [String] (MimeType, ByteString)
forall k a. Ord k => k -> Map k a -> Map k a
M.delete (String -> [String]
splitDirectories String
fp) Map [String] (MimeType, ByteString)
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 :: String -> Maybe MimeType -> ByteString -> MediaBag -> MediaBag
insertMedia String
fp Maybe MimeType
mbMime ByteString
contents (MediaBag Map [String] (MimeType, ByteString)
mediamap) =
  Map [String] (MimeType, ByteString) -> MediaBag
MediaBag ([String]
-> (MimeType, ByteString)
-> Map [String] (MimeType, ByteString)
-> Map [String] (MimeType, ByteString)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (String -> [String]
splitDirectories String
fp) (MimeType
mime, ByteString
contents) Map [String] (MimeType, ByteString)
mediamap)
  where mime :: MimeType
mime = MimeType -> Maybe MimeType -> MimeType
forall a. a -> Maybe a -> a
fromMaybe MimeType
fallback Maybe MimeType
mbMime
        fallback :: MimeType
fallback = case ShowS
takeExtension String
fp of
                        String
".gz" -> String -> MimeType
getMimeTypeDef (String -> MimeType) -> String -> MimeType
forall a b. (a -> b) -> a -> b
$ ShowS
dropExtension String
fp
                        String
_     -> String -> MimeType
getMimeTypeDef String
fp

-- | Lookup a media item in a 'MediaBag', returning mime type and contents.
lookupMedia :: FilePath
            -> MediaBag
            -> Maybe (MimeType, BL.ByteString)
lookupMedia :: String -> MediaBag -> Maybe (MimeType, ByteString)
lookupMedia String
fp (MediaBag Map [String] (MimeType, ByteString)
mediamap) = [String]
-> Map [String] (MimeType, ByteString)
-> Maybe (MimeType, ByteString)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (String -> [String]
splitDirectories String
fp) Map [String] (MimeType, ByteString)
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 -> [(String, MimeType, Int)]
mediaDirectory (MediaBag Map [String] (MimeType, ByteString)
mediamap) =
  ([String]
 -> (MimeType, ByteString)
 -> [(String, MimeType, Int)]
 -> [(String, MimeType, Int)])
-> [(String, MimeType, Int)]
-> Map [String] (MimeType, ByteString)
-> [(String, MimeType, Int)]
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
M.foldrWithKey (\[String]
fp (MimeType
mime,ByteString
contents) ->
      (([String] -> String
Posix.joinPath [String]
fp, MimeType
mime, Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BL.length ByteString
contents)(String, MimeType, Int)
-> [(String, MimeType, Int)] -> [(String, MimeType, Int)]
forall a. a -> [a] -> [a]
:)) [] Map [String] (MimeType, ByteString)
mediamap

mediaItems :: MediaBag -> [(FilePath, MimeType, BL.ByteString)]
mediaItems :: MediaBag -> [(String, MimeType, ByteString)]
mediaItems (MediaBag Map [String] (MimeType, ByteString)
mediamap) =
  ([String]
 -> (MimeType, ByteString)
 -> [(String, MimeType, ByteString)]
 -> [(String, MimeType, ByteString)])
-> [(String, MimeType, ByteString)]
-> Map [String] (MimeType, ByteString)
-> [(String, MimeType, ByteString)]
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
M.foldrWithKey (\[String]
fp (MimeType
mime,ByteString
contents) ->
      (([String] -> String
Posix.joinPath [String]
fp, MimeType
mime, ByteString
contents)(String, MimeType, ByteString)
-> [(String, MimeType, ByteString)]
-> [(String, MimeType, ByteString)]
forall a. a -> [a] -> [a]
:)) [] Map [String] (MimeType, ByteString)
mediamap