    -- | Defined to allow the constructor of 'MediaType' to be exposed to tests.
    module Network.HTTP.Media.MediaType.Internal
      ( MediaType (..),
        Parameters,
      )
    where

    import Control.Monad (foldM, guard)
    import Data.ByteString (ByteString)
    import qualified Data.ByteString.Char8 as BS
    import Data.CaseInsensitive (CI, original)
    import qualified Data.CaseInsensitive as CI
    import Data.Map (Map)
    import qualified Data.Map as Map
    import Data.Maybe (fromMaybe)
    import Data.Monoid ((<>))
    import Data.String (IsString (..))
    import Network.HTTP.Media.Accept (Accept (..))
    import Network.HTTP.Media.RenderHeader (RenderHeader (..))
    import Network.HTTP.Media.Utils (breakChar, trimBS)
    import Prelude hiding ((<>))

    -- | An HTTP media type, consisting of the type, subtype, and parameters.
    data MediaType = MediaType
      { -- | The main type of the MediaType
        MediaType -> CI ByteString
    mainType :: CI ByteString,
        -- | The sub type of the MediaType
        MediaType -> CI ByteString
    subType :: CI ByteString,
        -- | The parameters of the MediaType
        MediaType -> Parameters
    parameters :: Parameters
      }
      deriving (MediaType -> MediaType -> Bool
    (MediaType -> MediaType -> Bool)
    -> (MediaType -> MediaType -> Bool) -> Eq MediaType
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: MediaType -> MediaType -> Bool
    == :: MediaType -> MediaType -> Bool
    $c/= :: MediaType -> MediaType -> Bool
    /= :: MediaType -> MediaType -> Bool
    Eq, Eq MediaType
    Eq MediaType =>
    (MediaType -> MediaType -> Ordering)
    -> (MediaType -> MediaType -> Bool)
    -> (MediaType -> MediaType -> Bool)
    -> (MediaType -> MediaType -> Bool)
    -> (MediaType -> MediaType -> Bool)
    -> (MediaType -> MediaType -> MediaType)
    -> (MediaType -> MediaType -> MediaType)
    -> Ord MediaType
    MediaType -> MediaType -> Bool
    MediaType -> MediaType -> Ordering
    MediaType -> MediaType -> MediaType
    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 :: MediaType -> MediaType -> Ordering
    compare :: MediaType -> MediaType -> Ordering
    $c< :: MediaType -> MediaType -> Bool
    < :: MediaType -> MediaType -> Bool
    $c<= :: MediaType -> MediaType -> Bool
    <= :: MediaType -> MediaType -> Bool
    $c> :: MediaType -> MediaType -> Bool
    > :: MediaType -> MediaType -> Bool
    $c>= :: MediaType -> MediaType -> Bool
    >= :: MediaType -> MediaType -> Bool
    $cmax :: MediaType -> MediaType -> MediaType
    max :: MediaType -> MediaType -> MediaType
    $cmin :: MediaType -> MediaType -> MediaType
    min :: MediaType -> MediaType -> MediaType
    Ord)

    instance Show MediaType where
      show :: MediaType -> String
    show = ByteString -> String
    BS.unpack (ByteString -> String)
    -> (MediaType -> ByteString) -> MediaType -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . MediaType -> ByteString
    forall h. RenderHeader h => h -> ByteString
    renderHeader

    instance IsString MediaType where
      fromString :: String -> MediaType
    fromString String
    str =
        (MediaType -> Maybe MediaType -> MediaType)
    -> Maybe MediaType -> MediaType -> MediaType
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip MediaType -> Maybe MediaType -> MediaType
    forall a. a -> Maybe a -> a
    fromMaybe (ByteString -> Maybe MediaType
    forall a. Accept a => ByteString -> Maybe a
    parseAccept (ByteString -> Maybe MediaType) -> ByteString -> Maybe MediaType
    forall a b. (a -> b) -> a -> b
    $ String -> ByteString
    BS.pack String
    str) (MediaType -> MediaType) -> MediaType -> MediaType
    forall a b. (a -> b) -> a -> b
    $
          String -> MediaType
    forall a. HasCallStack => String -> a
    error (String -> MediaType) -> String -> MediaType
    forall a b. (a -> b) -> a -> b
    $
            String
    "Invalid media type literal " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    str

    instance Accept MediaType where
      parseAccept :: ByteString -> Maybe MediaType
    parseAccept ByteString
    bs = do
        (s, ps) <- [ByteString] -> Maybe (ByteString, [ByteString])
    forall {a}. [a] -> Maybe (a, [a])
    uncons ((ByteString -> ByteString) -> [ByteString] -> [ByteString]
    forall a b. (a -> b) -> [a] -> [b]
    map ByteString -> ByteString
    trimBS (Char -> ByteString -> [ByteString]
    BS.split Char
    ';' ByteString
    bs))
        (a, b) <- breakChar '/' s
        guard $ not (BS.null a || BS.null b) && (a /= "*" || b == "*")
        ps' <- foldM insert Map.empty ps
        return $ MediaType (CI.mk a) (CI.mk b) ps'
        where
          uncons :: [a] -> Maybe (a, [a])
    uncons [] = Maybe (a, [a])
    forall a. Maybe a
    Nothing
          uncons (a
    a : [a]
    b) = (a, [a]) -> Maybe (a, [a])
    forall a. a -> Maybe a
    Just (a
    a, [a]
    b)
          both :: (t -> b) -> (t, t) -> (b, b)
    both t -> b
    f (t
    a, t
    b) = (t -> b
    f t
    a, t -> b
    f t
    b)
          insert :: Parameters -> ByteString -> Maybe Parameters
    insert Parameters
    ps =
            ((ByteString, ByteString) -> Parameters)
    -> Maybe (ByteString, ByteString) -> Maybe Parameters
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (((CI ByteString, CI ByteString) -> Parameters -> Parameters)
    -> Parameters -> (CI ByteString, CI ByteString) -> Parameters
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ((CI ByteString -> CI ByteString -> Parameters -> Parameters)
    -> (CI ByteString, CI ByteString) -> Parameters -> Parameters
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry CI ByteString -> CI ByteString -> Parameters -> Parameters
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert) Parameters
    ps ((CI ByteString, CI ByteString) -> Parameters)
    -> ((ByteString, ByteString) -> (CI ByteString, CI ByteString))
    -> (ByteString, ByteString)
    -> Parameters
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ByteString -> CI ByteString)
    -> (ByteString, ByteString) -> (CI ByteString, CI ByteString)
    forall {t} {b}. (t -> b) -> (t, t) -> (b, b)
    both ByteString -> CI ByteString
    forall s. FoldCase s => s -> CI s
    CI.mk) (Maybe (ByteString, ByteString) -> Maybe Parameters)
    -> (ByteString -> Maybe (ByteString, ByteString))
    -> ByteString
    -> Maybe Parameters
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ByteString -> Maybe (ByteString, ByteString)
    breakChar Char
    '='

      matches :: MediaType -> MediaType -> Bool
    matches MediaType
    a MediaType
    b
        | MediaType -> CI ByteString
    mainType MediaType
    b CI ByteString -> CI ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == CI ByteString
    "*" = Bool
    params
        | MediaType -> CI ByteString
    subType MediaType
    b CI ByteString -> CI ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == CI ByteString
    "*" = MediaType -> CI ByteString
    mainType MediaType
    a CI ByteString -> CI ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == MediaType -> CI ByteString
    mainType MediaType
    b Bool -> Bool -> Bool
    && Bool
    params
        | Bool
    otherwise = Bool
    main Bool -> Bool -> Bool
    && Bool
    sub Bool -> Bool -> Bool
    && Bool
    params
        where
          main :: Bool
    main = MediaType -> CI ByteString
    mainType MediaType
    a CI ByteString -> CI ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == MediaType -> CI ByteString
    mainType MediaType
    b
          sub :: Bool
    sub = MediaType -> CI ByteString
    subType MediaType
    a CI ByteString -> CI ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == MediaType -> CI ByteString
    subType MediaType
    b
          params :: Bool
    params = Parameters -> Bool
    forall k a. Map k a -> Bool
    Map.null (MediaType -> Parameters
    parameters MediaType
    b) Bool -> Bool -> Bool
    || MediaType -> Parameters
    parameters MediaType
    a Parameters -> Parameters -> Bool
    forall a. Eq a => a -> a -> Bool
    == MediaType -> Parameters
    parameters MediaType
    b

      moreSpecificThan :: MediaType -> MediaType -> Bool
    moreSpecificThan MediaType
    a MediaType
    b =
        (MediaType
    a MediaType -> MediaType -> Bool
    forall a. Accept a => a -> a -> Bool
    `matches` MediaType
    b Bool -> Bool -> Bool
    &&) (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $
          MediaType -> CI ByteString
    mainType MediaType
    a CI ByteString -> CI ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == CI ByteString
    "*" Bool -> Bool -> Bool
    && Bool
    anyB Bool -> Bool -> Bool
    && Bool
    params
            Bool -> Bool -> Bool
    || MediaType -> CI ByteString
    subType MediaType
    a CI ByteString -> CI ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == CI ByteString
    "*" Bool -> Bool -> Bool
    && (Bool
    anyB Bool -> Bool -> Bool
    || Bool
    subB Bool -> Bool -> Bool
    && Bool
    params)
            Bool -> Bool -> Bool
    || Bool
    anyB
            Bool -> Bool -> Bool
    || Bool
    subB
            Bool -> Bool -> Bool
    || Bool
    params
        where
          anyB :: Bool
    anyB = MediaType -> CI ByteString
    mainType MediaType
    b CI ByteString -> CI ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == CI ByteString
    "*"
          subB :: Bool
    subB = MediaType -> CI ByteString
    subType MediaType
    b CI ByteString -> CI ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == CI ByteString
    "*"
          params :: Bool
    params = Bool -> Bool
    not (Parameters -> Bool
    forall k a. Map k a -> Bool
    Map.null (Parameters -> Bool) -> Parameters -> Bool
    forall a b. (a -> b) -> a -> b
    $ MediaType -> Parameters
    parameters MediaType
    a) Bool -> Bool -> Bool
    && Parameters -> Bool
    forall k a. Map k a -> Bool
    Map.null (MediaType -> Parameters
    parameters MediaType
    b)

      hasExtensionParameters :: Proxy MediaType -> Bool
    hasExtensionParameters Proxy MediaType
    _ = Bool
    True

    instance RenderHeader MediaType where
      renderHeader :: MediaType -> ByteString
    renderHeader (MediaType CI ByteString
    a CI ByteString
    b Parameters
    p) =
        (CI ByteString -> CI ByteString -> ByteString -> ByteString)
    -> ByteString -> Parameters -> ByteString
    forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
    Map.foldrWithKey CI ByteString -> CI ByteString -> ByteString -> ByteString
    forall {a}. (Semigroup a, IsString a) => CI a -> CI a -> a -> a
    f (CI ByteString -> ByteString
    forall s. CI s -> s
    original CI ByteString
    a ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> ByteString
    "/" ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> CI ByteString -> ByteString
    forall s. CI s -> s
    original CI ByteString
    b) Parameters
    p
        where
          f :: CI a -> CI a -> a -> a
    f CI a
    k CI a
    v = (a -> a -> a
    forall a. Semigroup a => a -> a -> a
    <> a
    ";" a -> a -> a
    forall a. Semigroup a => a -> a -> a
    <> CI a -> a
    forall s. CI s -> s
    original CI a
    k a -> a -> a
    forall a. Semigroup a => a -> a -> a
    <> a
    "=" a -> a -> a
    forall a. Semigroup a => a -> a -> a
    <> CI a -> a
    forall s. CI s -> s
    original CI a
    v)

    -- | 'MediaType' parameters.
    type Parameters = Map (CI ByteString) (CI ByteString)