    -- | Defines the 'Charset' accept header with an 'Accept' instance for use in
    -- language negotiation.
    module Network.HTTP.Media.Charset.Internal
      ( Charset (..),
      )
    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 charset as defined in
    -- <https://tools.ietf.org/html/rfc7231#section-5.3.3 RFC7231>.
    --
    -- Specifically:
    --
    -- > charset = token / "*"
    newtype Charset = Charset (CI ByteString)
      deriving (Charset -> Charset -> Bool
    (Charset -> Charset -> Bool)
    -> (Charset -> Charset -> Bool) -> Eq Charset
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Charset -> Charset -> Bool
    == :: Charset -> Charset -> Bool
    $c/= :: Charset -> Charset -> Bool
    /= :: Charset -> Charset -> Bool
    Eq, Eq Charset
    Eq Charset =>
    (Charset -> Charset -> Ordering)
    -> (Charset -> Charset -> Bool)
    -> (Charset -> Charset -> Bool)
    -> (Charset -> Charset -> Bool)
    -> (Charset -> Charset -> Bool)
    -> (Charset -> Charset -> Charset)
    -> (Charset -> Charset -> Charset)
    -> Ord Charset
    Charset -> Charset -> Bool
    Charset -> Charset -> Ordering
    Charset -> Charset -> Charset
    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 :: Charset -> Charset -> Ordering
    compare :: Charset -> Charset -> Ordering
    $c< :: Charset -> Charset -> Bool
    < :: Charset -> Charset -> Bool
    $c<= :: Charset -> Charset -> Bool
    <= :: Charset -> Charset -> Bool
    $c> :: Charset -> Charset -> Bool
    > :: Charset -> Charset -> Bool
    $c>= :: Charset -> Charset -> Bool
    >= :: Charset -> Charset -> Bool
    $cmax :: Charset -> Charset -> Charset
    max :: Charset -> Charset -> Charset
    $cmin :: Charset -> Charset -> Charset
    min :: Charset -> Charset -> Charset
    Ord)

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

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

    instance Accept Charset where
      parseAccept :: ByteString -> Maybe Charset
    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
        Charset -> Maybe Charset
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Charset -> Maybe Charset) -> Charset -> Maybe Charset
    forall a b. (a -> b) -> a -> b
    $ CI ByteString -> Charset
    Charset (ByteString -> CI ByteString
    forall s. FoldCase s => s -> CI s
    CI.mk ByteString
    bs)

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

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

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