{-# LANGUAGE CPP            #-}
{-# LANGUAGE DataKinds      #-}
{-# LANGUAGE KindSignatures #-}

module Network.Wai.Predicate.MediaType where

import Data.ByteString (ByteString)
import Data.Singletons
import Data.Singletons.TypeLits

#if MIN_VERSION_singletons(2,3,0)
import Data.Text.Encoding (encodeUtf8)
#else
import Data.ByteString.Char8 (pack)
#endif

data Media (t :: Symbol) (s :: Symbol) = Media
    { Media t s -> ByteString
rawType      :: !ByteString
    , Media t s -> ByteString
rawSubTypes  :: !ByteString
    , Media t s -> Double
mediaQuality :: !Double
    , Media t s -> [(ByteString, ByteString)]
mediaParams  :: ![(ByteString, ByteString)]
    } deriving (Media t s -> Media t s -> Bool
(Media t s -> Media t s -> Bool)
-> (Media t s -> Media t s -> Bool) -> Eq (Media t s)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (t :: Symbol) (s :: Symbol). Media t s -> Media t s -> Bool
/= :: Media t s -> Media t s -> Bool
$c/= :: forall (t :: Symbol) (s :: Symbol). Media t s -> Media t s -> Bool
== :: Media t s -> Media t s -> Bool
$c== :: forall (t :: Symbol) (s :: Symbol). Media t s -> Media t s -> Bool
Eq, Int -> Media t s -> ShowS
[Media t s] -> ShowS
Media t s -> String
(Int -> Media t s -> ShowS)
-> (Media t s -> String)
-> ([Media t s] -> ShowS)
-> Show (Media t s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (t :: Symbol) (s :: Symbol). Int -> Media t s -> ShowS
forall (t :: Symbol) (s :: Symbol). [Media t s] -> ShowS
forall (t :: Symbol) (s :: Symbol). Media t s -> String
showList :: [Media t s] -> ShowS
$cshowList :: forall (t :: Symbol) (s :: Symbol). [Media t s] -> ShowS
show :: Media t s -> String
$cshow :: forall (t :: Symbol) (s :: Symbol). Media t s -> String
showsPrec :: Int -> Media t s -> ShowS
$cshowsPrec :: forall (t :: Symbol) (s :: Symbol). Int -> Media t s -> ShowS
Show)

mediaType :: KnownSymbol t => Media t s -> ByteString
mediaType :: Media t s -> ByteString
mediaType Media t s
m = (Sing t -> ByteString) -> ByteString
forall k (a :: k) b. SingI a => (Sing a -> b) -> b
withSing (Media t s -> Sing t -> ByteString
forall (t :: Symbol) (s :: Symbol).
Media t s -> Sing t -> ByteString
f Media t s
m)
  where
    f :: Media t s -> Sing t -> ByteString
#if MIN_VERSION_singletons(2,3,0)
    f :: Media t s -> Sing t -> ByteString
f Media t s
_ Sing t
t = Text -> ByteString
encodeUtf8 (Sing t -> Demote Symbol
forall k (a :: k). SingKind k => Sing a -> Demote k
fromSing Sing t
t)
#else
    f _ t = pack (fromSing t)
#endif

mediaSubType :: KnownSymbol s => Media t s -> ByteString
mediaSubType :: Media t s -> ByteString
mediaSubType Media t s
m = (Sing s -> ByteString) -> ByteString
forall k (a :: k) b. SingI a => (Sing a -> b) -> b
withSing (Media t s -> Sing s -> ByteString
forall (t :: Symbol) (s :: Symbol).
Media t s -> Sing s -> ByteString
f Media t s
m)
  where
    f :: Media t s -> Sing s -> ByteString
#if MIN_VERSION_singletons(2,3,0)
    f :: Media t s -> Sing s -> ByteString
f Media t s
_ Sing s
s = Text -> ByteString
encodeUtf8 (Sing s -> Demote Symbol
forall k (a :: k). SingKind k => Sing a -> Demote k
fromSing Sing s
s)
#else
    f _ s = pack (fromSing s)
#endif