{-# OPTIONS_GHC -fno-warn-orphans #-}
module Network.HTTP.Media.MediaType.Arbitrary
()
where
import Prelude hiding
( concat
)
import Control.Applicative
( (<*>)
)
import Control.Monad
( replicateM
)
import Data.ByteString
( ByteString
, append
, concat
)
import Data.ByteString.Char8
( singleton
)
import Data.Functor
( (<$>)
)
import Network.HTTP.Media.MediaType
( MediaType
, (//)
, (/:)
)
import Test.QuickCheck
( Arbitrary (arbitrary)
, Gen
, choose
, elements
, listOf
, oneof
, sized
)
instance Arbitrary MediaType where
arbitrary :: Gen MediaType
arbitrary = do
MediaType
n <- ByteString -> ByteString -> MediaType
(//) (ByteString -> ByteString -> MediaType)
-> Gen ByteString -> Gen (ByteString -> MediaType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
restrictedName Gen (ByteString -> MediaType) -> Gen ByteString -> Gen MediaType
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ByteString
restrictedName
[(ByteString, ByteString)]
ps <- Gen (ByteString, ByteString) -> Gen [(ByteString, ByteString)]
forall a. Gen a -> Gen [a]
listOf (Gen (ByteString, ByteString) -> Gen [(ByteString, ByteString)])
-> Gen (ByteString, ByteString) -> Gen [(ByteString, ByteString)]
forall a b. (a -> b) -> a -> b
$ (,) (ByteString -> ByteString -> (ByteString, ByteString))
-> Gen ByteString -> Gen (ByteString -> (ByteString, ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
restrictedName Gen (ByteString -> (ByteString, ByteString))
-> Gen ByteString -> Gen (ByteString, ByteString)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ByteString
restrictedName
MediaType -> Gen MediaType
forall (m :: * -> *) a. Monad m => a -> m a
return (MediaType -> Gen MediaType) -> MediaType -> Gen MediaType
forall a b. (a -> b) -> a -> b
$ (MediaType -> (ByteString, ByteString) -> MediaType)
-> MediaType -> [(ByteString, ByteString)] -> MediaType
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl MediaType -> (ByteString, ByteString) -> MediaType
(/:) MediaType
n [(ByteString, ByteString)]
ps
restrictedName :: Gen ByteString
restrictedName :: Gen ByteString
restrictedName = (Int -> Gen ByteString) -> Gen ByteString
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen ByteString) -> Gen ByteString)
-> (Int -> Gen ByteString) -> Gen ByteString
forall a b. (a -> b) -> a -> b
$ \Int
s -> do
Int
n <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
126 Int
s)
ByteString
rs <- [ByteString] -> ByteString
concat ([ByteString] -> ByteString) -> Gen [ByteString] -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen ByteString -> Gen [ByteString]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n Gen ByteString
restrictedNameChar
(ByteString -> ByteString -> ByteString
`append` ByteString
rs) (ByteString -> ByteString) -> Gen ByteString -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
restrictedNameFirst
restrictedNameFirst :: Gen ByteString
restrictedNameFirst :: Gen ByteString
restrictedNameFirst = Char -> ByteString
singleton (Char -> ByteString) -> Gen Char -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Gen Char] -> Gen Char
forall a. [Gen a] -> Gen a
oneof [Gen Char
alpha, Gen Char
digit]
restrictedNameChar :: Gen ByteString
restrictedNameChar :: Gen ByteString
restrictedNameChar = Char -> ByteString
singleton (Char -> ByteString) -> Gen Char -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Gen Char] -> Gen Char
forall a. [Gen a] -> Gen a
oneof
[Gen Char
alpha, Gen Char
digit, [Char] -> Gen Char
forall a. [a] -> Gen a
elements [Char
'!', Char
'#', Char
'$', Char
'&', Char
'-', Char
'^', Char
'_', Char
'.', Char
'+']]
alpha :: Gen Char
alpha :: Gen Char
alpha = [Char] -> Gen Char
forall a. [a] -> Gen a
elements ([Char] -> Gen Char) -> [Char] -> Gen Char
forall a b. (a -> b) -> a -> b
$ [Char
'a' .. Char
'z'] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
'A' .. Char
'Z']
digit :: Gen Char
digit :: Gen Char
digit = [Char] -> Gen Char
forall a. [a] -> Gen a
elements [Char
'0' .. Char
'9']