module Network.HTTP.Media.MediaType
(
MediaType
, Parameters
, (//)
, (/:)
, mainType
, subType
, parameters
, (/?)
, (/.)
) where
import qualified Data.ByteString.Char8 as BS
import qualified Data.CaseInsensitive as CI
import qualified Data.Map as Map
import Data.ByteString (ByteString)
import Data.CaseInsensitive (CI)
import Data.Map (empty, insert)
import qualified Network.HTTP.Media.MediaType.Internal as Internal
import Network.HTTP.Media.MediaType.Internal (MediaType (MediaType))
import Network.HTTP.Media.MediaType.Internal hiding (MediaType (..))
import Network.HTTP.Media.Utils
mainType :: MediaType -> CI ByteString
mainType :: MediaType -> CI ByteString
mainType = MediaType -> CI ByteString
Internal.mainType
subType :: MediaType -> CI ByteString
subType :: MediaType -> CI ByteString
subType = MediaType -> CI ByteString
Internal.subType
parameters :: MediaType -> Parameters
parameters :: MediaType -> Parameters
parameters = MediaType -> Parameters
Internal.parameters
(//) :: ByteString -> ByteString -> MediaType
a :: ByteString
a // :: ByteString -> ByteString -> MediaType
// b :: ByteString
b
| ByteString
a ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== "*" Bool -> Bool -> Bool
&& ByteString
b ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== "*" = CI ByteString -> CI ByteString -> Parameters -> MediaType
MediaType (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk ByteString
a) (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk ByteString
b) Parameters
forall k a. Map k a
empty
| ByteString
b ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== "*" = CI ByteString -> CI ByteString -> Parameters -> MediaType
MediaType (ByteString -> CI ByteString
ensureR ByteString
a) (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk ByteString
b) Parameters
forall k a. Map k a
empty
| Bool
otherwise = CI ByteString -> CI ByteString -> Parameters -> MediaType
MediaType (ByteString -> CI ByteString
ensureR ByteString
a) (ByteString -> CI ByteString
ensureR ByteString
b) Parameters
forall k a. Map k a
empty
(/:) :: MediaType -> (ByteString, ByteString) -> MediaType
(MediaType a :: CI ByteString
a b :: CI ByteString
b p :: Parameters
p) /: :: MediaType -> (ByteString, ByteString) -> MediaType
/: (k :: ByteString
k, v :: ByteString
v) = CI ByteString -> CI ByteString -> Parameters -> MediaType
MediaType CI ByteString
a CI ByteString
b (Parameters -> MediaType) -> Parameters -> MediaType
forall a b. (a -> b) -> a -> b
$ CI ByteString -> CI ByteString -> Parameters -> Parameters
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert (ByteString -> CI ByteString
ensureR ByteString
k) (ByteString -> CI ByteString
ensureV ByteString
v) Parameters
p
(/?) :: MediaType -> ByteString -> Bool
(MediaType _ _ p :: Parameters
p) /? :: MediaType -> ByteString -> Bool
/? k :: ByteString
k = CI ByteString -> Parameters -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk ByteString
k) Parameters
p
(/.) :: MediaType -> ByteString -> Maybe (CI ByteString)
(MediaType _ _ p :: Parameters
p) /. :: MediaType -> ByteString -> Maybe (CI ByteString)
/. k :: ByteString
k = CI ByteString -> Parameters -> Maybe (CI ByteString)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk ByteString
k) Parameters
p
ensureR :: ByteString -> CI ByteString
ensureR :: ByteString -> CI ByteString
ensureR bs :: ByteString
bs = ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk (ByteString -> CI ByteString) -> ByteString -> CI ByteString
forall a b. (a -> b) -> a -> b
$ if Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 Bool -> Bool -> Bool
|| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 127
then [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ "Invalid length for " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
forall a. Show a => a -> [Char]
show ByteString
bs else (Char -> Bool) -> ByteString -> ByteString
ensure Char -> Bool
isMediaChar ByteString
bs
where l :: Int
l = ByteString -> Int
BS.length ByteString
bs
ensureV :: ByteString -> CI ByteString
ensureV :: ByteString -> CI ByteString
ensureV = ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk (ByteString -> CI ByteString)
-> (ByteString -> ByteString) -> ByteString -> CI ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
ensure (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [',', ';'])
ensure :: (Char -> Bool) -> ByteString -> ByteString
ensure :: (Char -> Bool) -> ByteString -> ByteString
ensure f :: Char -> Bool
f bs :: ByteString
bs = ByteString -> (Char -> ByteString) -> Maybe Char -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
([Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ "Invalid character in " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
forall a. Show a => a -> [Char]
show ByteString
bs) (ByteString -> Char -> ByteString
forall a b. a -> b -> a
const ByteString
bs) ((Char -> Bool) -> ByteString -> Maybe Char
BS.find Char -> Bool
f ByteString
bs)