{-# OPTIONS_GHC -fno-warn-orphans #-}

-- |
-- Module      : Network.HTTP.Media.MediaType.Arbitrary
-- Description : Arbitrary Instances for Network.HTTP.Media.MediaType
-- Copyright   : (c) Alex Brandt, 2018
-- License     : MIT
--
-- Arbitrary instances for "Network.HTTP.Media.MediaType".
module Network.HTTP.Media.MediaType.Arbitrary () where

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,
  )
import Prelude hiding
  ( concat,
  )

--
--
-- Note: parameter---paramter values are supposed to be unrestricted but due to
--       the way that quickcheck validates values it's best if these are
--       printable.  Until we can use the new instances in quickcheck-2.10.*, we
--       shall simply use restrictedName for the values as well.
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 a b. Gen (a -> b) -> Gen a -> Gen b
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 a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ByteString
restrictedName -- see parameter note above
    MediaType -> Gen MediaType
forall a. a -> Gen a
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 b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl MediaType -> (ByteString, ByteString) -> MediaType
(/:) MediaType
n [(ByteString, ByteString)]
ps

-- * RFC 6838 Generators

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. HasCallStack => [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. HasCallStack => [Gen a] -> Gen a
oneof
      [Gen Char
alpha, Gen Char
digit, [Char] -> Gen Char
forall a. HasCallStack => [a] -> Gen a
elements [Char
'!', Char
'#', Char
'$', Char
'&', Char
'-', Char
'^', Char
'_', Char
'.', Char
'+']]

-- * RFC 2234 Generators

alpha :: Gen Char
alpha :: Gen Char
alpha = [Char] -> Gen Char
forall a. HasCallStack => [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. HasCallStack => [a] -> Gen a
elements [Char
'0' .. Char
'9']