    -- | Defines the 'Encoding' accept header with an 'Accept' instance for use in
    -- language negotiation.
    module Network.HTTP.Media.Encoding.Internal
      ( Encoding (..),
      )
    where

    import Control.Monad (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.Maybe (fromMaybe)
    import Data.String (IsString (..))
    import Network.HTTP.Media.Accept (Accept (..))
    import Network.HTTP.Media.RenderHeader (RenderHeader (..))
    import Network.HTTP.Media.Utils (isValidToken)

    -- | Suitable for HTTP encoding as defined in
    -- <https://tools.ietf.org/html/rfc7231#section-5.3.4 RFC7231>.
    --
    -- Specifically:
    --
    -- > codings = content-coding / "identity" / "*"
    newtype Encoding = Encoding (CI ByteString)
      deriving (Encoding -> Encoding -> Bool
    (Encoding -> Encoding -> Bool)
    -> (Encoding -> Encoding -> Bool) -> Eq Encoding
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Encoding -> Encoding -> Bool
    == :: Encoding -> Encoding -> Bool
    $c/= :: Encoding -> Encoding -> Bool
    /= :: Encoding -> Encoding -> Bool
    Eq, Eq Encoding
    Eq Encoding =>
    (Encoding -> Encoding -> Ordering)
    -> (Encoding -> Encoding -> Bool)
    -> (Encoding -> Encoding -> Bool)
    -> (Encoding -> Encoding -> Bool)
    -> (Encoding -> Encoding -> Bool)
    -> (Encoding -> Encoding -> Encoding)
    -> (Encoding -> Encoding -> Encoding)
    -> Ord Encoding
    Encoding -> Encoding -> Bool
    Encoding -> Encoding -> Ordering
    Encoding -> Encoding -> Encoding
    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 :: Encoding -> Encoding -> Ordering
    compare :: Encoding -> Encoding -> Ordering
    $c< :: Encoding -> Encoding -> Bool
    < :: Encoding -> Encoding -> Bool
    $c<= :: Encoding -> Encoding -> Bool
    <= :: Encoding -> Encoding -> Bool
    $c> :: Encoding -> Encoding -> Bool
    > :: Encoding -> Encoding -> Bool
    $c>= :: Encoding -> Encoding -> Bool
    >= :: Encoding -> Encoding -> Bool
    $cmax :: Encoding -> Encoding -> Encoding
    max :: Encoding -> Encoding -> Encoding
    $cmin :: Encoding -> Encoding -> Encoding
    min :: Encoding -> Encoding -> Encoding
    Ord)

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

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

    instance Accept Encoding where
      -- This handles the case where the header value is empty, but it also
      -- allows technically invalid values such as "compress;q=0.8,;q=0.5".
      parseAccept :: ByteString -> Maybe Encoding
    parseAccept ByteString
    "" = Encoding -> Maybe Encoding
    forall a. a -> Maybe a
    Just (Encoding -> Maybe Encoding) -> Encoding -> Maybe Encoding
    forall a b. (a -> b) -> a -> b
    $ CI ByteString -> Encoding
    Encoding CI ByteString
    "identity"
      parseAccept ByteString
    bs = do
        Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Bool -> Maybe ()) -> Bool -> Maybe ()
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Bool
    isValidToken ByteString
    bs
        Encoding -> Maybe Encoding
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Encoding -> Maybe Encoding) -> Encoding -> Maybe Encoding
    forall a b. (a -> b) -> a -> b
    $ CI ByteString -> Encoding
    Encoding (ByteString -> CI ByteString
    forall s. FoldCase s => s -> CI s
    CI.mk ByteString
    bs)

      matches :: Encoding -> Encoding -> Bool
    matches Encoding
    _ (Encoding CI ByteString
    "*") = Bool
    True
      matches Encoding
    a Encoding
    b = Encoding
    a Encoding -> Encoding -> Bool
    forall a. Eq a => a -> a -> Bool
    == Encoding
    b

      moreSpecificThan :: Encoding -> Encoding -> Bool
    moreSpecificThan Encoding
    _ (Encoding CI ByteString
    "*") = Bool
    True
      moreSpecificThan Encoding
    _ Encoding
    _ = Bool
    False

    instance RenderHeader Encoding where
      renderHeader :: Encoding -> ByteString
    renderHeader (Encoding CI ByteString
    e) = CI ByteString -> ByteString
    forall s. CI s -> s
    original CI ByteString
    e