module Network.HTTP.Media.Charset.Internal
( Charset (..)
) where
import qualified Data.ByteString.Char8 as BS
import qualified Data.CaseInsensitive as CI
import Control.Monad (guard)
import Data.ByteString (ByteString)
import Data.CaseInsensitive (CI, original)
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)
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
/= :: Charset -> Charset -> Bool
$c/= :: Charset -> Charset -> Bool
== :: Charset -> Charset -> Bool
$c== :: 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
min :: Charset -> Charset -> Charset
$cmin :: Charset -> Charset -> Charset
max :: Charset -> Charset -> Charset
$cmax :: Charset -> Charset -> Charset
>= :: Charset -> Charset -> Bool
$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
compare :: Charset -> Charset -> Ordering
$ccompare :: Charset -> Charset -> Ordering
$cp1Ord :: Eq 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 str :: 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
$ "Invalid encoding literal " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str
instance Accept Charset where
parseAccept :: ByteString -> Maybe Charset
parseAccept bs :: 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 (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 "*") = Bool
True
matches a :: Charset
a b :: Charset
b = Charset
a Charset -> Charset -> Bool
forall a. Eq a => a -> a -> Bool
== Charset
b
moreSpecificThan :: Charset -> Charset -> Bool
moreSpecificThan _ (Charset "*") = Bool
True
moreSpecificThan _ _ = Bool
False
instance RenderHeader Charset where
renderHeader :: Charset -> ByteString
renderHeader (Charset e :: CI ByteString
e) = CI ByteString -> ByteString
forall s. CI s -> s
original CI ByteString
e