{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

{-# HLINT ignore "Evaluate" #-}

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

import Control.Monad
  ( replicateM,
  )
import Data.List
  ( intercalate,
  )
import Network.URI
  ( URI (..),
    URIAuth (..),
    parseURIReference,
    uriToString,
  )
import Test.QuickCheck
  ( Arbitrary (arbitrary, shrink),
    Gen,
    choose,
    elements,
    listOf,
    listOf1,
    oneof,
    suchThat,
  )

instance Arbitrary URI where
  arbitrary :: Gen URI
arbitrary = do
    String
uriScheme <- [Gen String] -> Gen String
forall a. HasCallStack => [Gen a] -> Gen a
oneof [String -> Gen String
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"", Gen String
scheme]
    Maybe URIAuth
uriAuthority <- Gen (Maybe URIAuth)
forall a. Arbitrary a => Gen a
arbitrary :: Gen (Maybe URIAuth)
    String
uriPath <- Bool -> Bool -> Gen String
path (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
uriScheme) (Bool -> Gen String) -> Bool -> Gen String
forall a b. (a -> b) -> a -> b
$ Bool -> (URIAuth -> Bool) -> Maybe URIAuth -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True URIAuth -> Bool
emptyAuthority Maybe URIAuth
uriAuthority
    String
uriQuery <- [Gen String] -> Gen String
forall a. HasCallStack => [Gen a] -> Gen a
oneof [Gen String
query, String -> Gen String
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return String
""]
    String
uriFragment <- [Gen String] -> Gen String
forall a. HasCallStack => [Gen a] -> Gen a
oneof [Gen String
fragment, String -> Gen String
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return String
""]

    URI -> Gen URI
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return URI {String
Maybe URIAuth
uriScheme :: String
uriAuthority :: Maybe URIAuth
uriPath :: String
uriQuery :: String
uriFragment :: String
uriScheme :: String
uriAuthority :: Maybe URIAuth
uriPath :: String
uriQuery :: String
uriFragment :: String
..}
    where
      emptyAuthority :: URIAuth -> Bool
emptyAuthority URIAuth {String
uriUserInfo :: String
uriRegName :: String
uriPort :: String
uriUserInfo :: URIAuth -> String
uriRegName :: URIAuth -> String
uriPort :: URIAuth -> String
..} = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String
uriUserInfo, String
uriRegName, String
uriPort]

  shrink :: URI -> [URI]
shrink URI {String
Maybe URIAuth
uriScheme :: URI -> String
uriAuthority :: URI -> Maybe URIAuth
uriPath :: URI -> String
uriQuery :: URI -> String
uriFragment :: URI -> String
uriScheme :: String
uriAuthority :: Maybe URIAuth
uriPath :: String
uriQuery :: String
uriFragment :: String
..} =
    (URI -> Bool) -> [URI] -> [URI]
forall a. (a -> Bool) -> [a] -> [a]
filter
      URI -> Bool
isURI
      [ String -> Maybe URIAuth -> String -> String -> String -> URI
URI String
uriScheme' Maybe URIAuth
uriAuthority' String
uriPath' String
uriQuery' String
uriFragment'
        | (String
uriScheme', Maybe URIAuth
uriAuthority', String
uriPath', String
uriQuery', String
uriFragment') <-
            (String, Maybe URIAuth, String, String, String)
-> [(String, Maybe URIAuth, String, String, String)]
forall a. Arbitrary a => a -> [a]
shrink
              (String
uriScheme, Maybe URIAuth
uriAuthority, String
uriPath, String
uriQuery, String
uriFragment)
      ]
    where
      isURI :: URI -> Bool
isURI URI
u = case String -> Maybe URI
parseURIReference ((String -> String) -> URI -> String -> String
uriToString String -> String
forall a. a -> a
id URI
u String
"") of
        Just URI
u' -> URI
u' URI -> URI -> Bool
forall a. Eq a => a -> a -> Bool
== URI
u
        Maybe URI
Nothing -> Bool
False

instance Arbitrary URIAuth where
  arbitrary :: Gen URIAuth
arbitrary = String -> String -> String -> URIAuth
URIAuth (String -> String -> String -> URIAuth)
-> Gen String -> Gen (String -> String -> URIAuth)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
userinfo Gen (String -> String -> URIAuth)
-> Gen String -> Gen (String -> URIAuth)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen String
host Gen String -> (String -> Bool) -> Gen String
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) Gen (String -> URIAuth) -> Gen String -> Gen URIAuth
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen String
port

  shrink :: URIAuth -> [URIAuth]
shrink URIAuth {String
uriUserInfo :: URIAuth -> String
uriRegName :: URIAuth -> String
uriPort :: URIAuth -> String
uriUserInfo :: String
uriRegName :: String
uriPort :: String
..} =
    [ String -> String -> String -> URIAuth
URIAuth String
uriUserInfo' String
uriRegName' String
uriPort'
      | (String
uriUserInfo', String
uriRegName', String
uriPort') <-
          (String, String, String) -> [(String, String, String)]
forall a. Arbitrary a => a -> [a]
shrink
            (String
uriUserInfo, String
uriRegName, String
uriPort)
    ]

-- * RFC 3986 Generators

--
--   Some generators are handled by the 'Arbitrary' instances above, and
--   others are folded into symbols that are preceded or followed by
--   identifying tokens.

scheme :: Gen String
scheme :: Gen String
scheme = do
  Char
a <- Gen Char
alpha
  String
r <- Gen Char -> Gen String
forall a. Gen a -> Gen [a]
listOf (Gen Char -> Gen String) -> Gen Char -> Gen String
forall a b. (a -> b) -> a -> b
$ [Gen Char] -> Gen Char
forall a. HasCallStack => [Gen a] -> Gen a
oneof [Gen Char
alpha, Gen Char
digit, String -> Gen Char
forall a. HasCallStack => [a] -> Gen a
elements [Char
'+', Char
'-', Char
'.']]
  String -> Gen String
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Gen String) -> String -> Gen String
forall a b. (a -> b) -> a -> b
$ Char
a Char -> String -> String
forall a. a -> [a] -> [a]
: (String
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":")

userinfo :: Gen String
userinfo :: Gen String
userinfo = do
  String
u <- [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> Gen [String] -> Gen String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [String]
userinfo'
  if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
u then String -> Gen String
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"" else String -> Gen String
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Gen String) -> String -> Gen String
forall a b. (a -> b) -> a -> b
$ String
u String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"@"
  where
    userinfo' :: Gen [String]
userinfo' =
      Gen String -> Gen [String]
forall a. Gen a -> Gen [a]
listOf (Gen String -> Gen [String]) -> Gen String -> Gen [String]
forall a b. (a -> b) -> a -> b
$
        [Gen String] -> Gen String
forall a. HasCallStack => [Gen a] -> Gen a
oneof
          [Int -> Gen Char -> Gen String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
1 (Gen Char -> Gen String) -> Gen Char -> Gen String
forall a b. (a -> b) -> a -> b
$ [Gen Char] -> Gen Char
forall a. HasCallStack => [Gen a] -> Gen a
oneof [Gen Char
unreserved, Gen Char
subDelims, Char -> Gen Char
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
':'], Gen String
percentEncoded]

host :: Gen String
host :: Gen String
host = [Gen String] -> Gen String
forall a. HasCallStack => [Gen a] -> Gen a
oneof [Gen String
ipLiteral, Gen String
ipv4Address, Gen String
regName]

port :: Gen String
port :: Gen String
port = do
  String
p <- Gen Char -> Gen String
forall a. Gen a -> Gen [a]
listOf Gen Char
digit
  if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
p then String -> Gen String
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"" else String -> Gen String
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Gen String) -> String -> Gen String
forall a b. (a -> b) -> a -> b
$ Char
':' Char -> String -> String
forall a. a -> [a] -> [a]
: String
p

ipLiteral :: Gen String
ipLiteral :: Gen String
ipLiteral = do
  String
x <-
    [Gen String] -> Gen String
forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ Gen String
ipv6Address
      -- , ipvFuture
      ]
  String -> Gen String
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Gen String) -> String -> Gen String
forall a b. (a -> b) -> a -> b
$ String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"

{- TODO Check that "Network.URI" implements this correctly.
ipvFuture :: Gen String
ipvFuture =
  do h <- hexdig
     o <- oneof [ unreserved, subDelims, return ':' ]
     return ['v', h, '.', o]
-}

ipv6Address :: Gen String
ipv6Address :: Gen String
ipv6Address =
  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    ([String] -> String) -> Gen [String] -> Gen String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Gen [String]] -> Gen [String]
forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ [Gen String] -> Gen [String]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Int -> Gen String
b Int
6, Gen String
ls32],
        [Gen String] -> Gen [String]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [String -> Gen String
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"::", Int -> Gen String
b Int
5, Gen String
ls32],
        [Gen String] -> Gen [String]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Gen String
h16, String -> Gen String
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"::", Int -> Gen String
b Int
4, Gen String
ls32],
        [Gen String] -> Gen [String]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Int -> Gen String
b Int
1, Gen String
h16, String -> Gen String
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"::", Int -> Gen String
b Int
3, Gen String
ls32],
        [Gen String] -> Gen [String]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Int -> Gen String
b Int
2, Gen String
h16, String -> Gen String
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"::", Int -> Gen String
b Int
2, Gen String
ls32],
        [Gen String] -> Gen [String]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Int -> Gen String
b Int
3, Gen String
h16, String -> Gen String
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"::", Int -> Gen String
b Int
1, Gen String
ls32],
        [Gen String] -> Gen [String]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Int -> Gen String
b Int
4, Gen String
h16, String -> Gen String
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"::", Gen String
ls32],
        [Gen String] -> Gen [String]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Int -> Gen String
b Int
5, Gen String
h16, String -> Gen String
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"::", Gen String
h16],
        [Gen String] -> Gen [String]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Int -> Gen String
b Int
6, Gen String
h16, String -> Gen String
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"::"]
      ]
  where
    b :: Int -> Gen String
b Int
n = ([String] -> String) -> Gen [String] -> Gen String
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Gen [String] -> Gen String) -> Gen [String] -> Gen String
forall a b. (a -> b) -> a -> b
$ Int -> Gen String -> Gen [String]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (Gen String -> Gen [String]) -> Gen String -> Gen [String]
forall a b. (a -> b) -> a -> b
$ (String -> String) -> Gen String -> Gen String
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":") Gen String
h16 :: Gen String

h16 :: Gen String
h16 :: Gen String
h16 = Int -> Gen Char -> Gen String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
4 Gen Char
hexdig

ls32 :: Gen String
ls32 :: Gen String
ls32 = [Gen String] -> Gen String
forall a. HasCallStack => [Gen a] -> Gen a
oneof [String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
":" ([String] -> String) -> Gen [String] -> Gen String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen String -> Gen [String]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 Gen String
h16, Gen String
ipv4Address]

ipv4Address :: Gen String
ipv4Address :: Gen String
ipv4Address = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." ([String] -> String) -> Gen [String] -> Gen String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen String -> Gen [String]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
4 Gen String
decOctet

decOctet :: Gen String
decOctet :: Gen String
decOctet = (Int -> String
forall a. Show a => a -> String
show :: Int -> String) (Int -> String) -> Gen Int -> Gen String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
255)

regName :: Gen String
regName :: Gen String
regName =
  ([String] -> String) -> Gen [String] -> Gen String
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Gen [String] -> Gen String) -> Gen [String] -> Gen String
forall a b. (a -> b) -> a -> b
$
    Gen String -> Gen [String]
forall a. Gen a -> Gen [a]
listOf (Gen String -> Gen [String]) -> Gen String -> Gen [String]
forall a b. (a -> b) -> a -> b
$
      [Gen String] -> Gen String
forall a. HasCallStack => [Gen a] -> Gen a
oneof
        [Int -> Gen Char -> Gen String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
1 Gen Char
unreserved, Gen String
percentEncoded, Int -> Gen Char -> Gen String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
1 Gen Char
subDelims]

path :: Bool -> Bool -> Gen String
path :: Bool -> Bool -> Gen String
path Bool
emptyScheme Bool
emptyURIAuth =
  if Bool
emptyURIAuth
    then
      [Gen String] -> Gen String
forall a. HasCallStack => [Gen a] -> Gen a
oneof
        [ Gen String
pathAbsolute,
          if Bool
emptyScheme then Gen String
pathNoScheme else Gen String
pathRootless,
          String -> Gen String
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
        ]
    else Gen String
pathAbEmpty

pathAbEmpty :: Gen String
pathAbEmpty :: Gen String
pathAbEmpty = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> Gen [String] -> Gen String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String -> Gen [String]
forall a. Gen a -> Gen [a]
listOf ((Char
'/' Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> Gen [String] -> Gen String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String -> Gen [String]
forall a. Gen a -> Gen [a]
listOf Gen String
pchar)

pathAbsolute :: Gen String
pathAbsolute :: Gen String
pathAbsolute = (Char
'/' Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> Gen String -> Gen String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Gen String] -> Gen String
forall a. HasCallStack => [Gen a] -> Gen a
oneof [String -> Gen String
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"", Gen String
pathRootless]

pathNoScheme :: Gen String
pathNoScheme :: Gen String
pathNoScheme = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> Gen [String] -> Gen String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Gen String] -> Gen [String]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Gen String
segment1nc, Gen String
pathAbEmpty]

pathRootless :: Gen String
pathRootless :: Gen String
pathRootless = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> Gen [String] -> Gen String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Gen String] -> Gen [String]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> Gen [String] -> Gen String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String -> Gen [String]
forall a. Gen a -> Gen [a]
listOf1 Gen String
pchar, Gen String
pathAbEmpty]

segment1nc :: Gen String
segment1nc :: Gen String
segment1nc =
  [Gen String] -> Gen String
forall a. HasCallStack => [Gen a] -> Gen a
oneof
    [ Int -> Gen Char -> Gen String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
1 Gen Char
unreserved,
      Gen String
percentEncoded,
      Int -> Gen Char -> Gen String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
1 Gen Char
subDelims,
      Int -> Gen Char -> Gen String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
1 (Gen Char -> Gen String) -> Gen Char -> Gen String
forall a b. (a -> b) -> a -> b
$ Char -> Gen Char
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'@'
    ]

pchar :: Gen String
pchar :: Gen String
pchar =
  [Gen String] -> Gen String
forall a. HasCallStack => [Gen a] -> Gen a
oneof
    [ Int -> Gen Char -> Gen String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
1 Gen Char
unreserved,
      Gen String
percentEncoded,
      Int -> Gen Char -> Gen String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
1 Gen Char
subDelims,
      Int -> Gen Char -> Gen String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
1 (Gen Char -> Gen String) -> Gen Char -> Gen String
forall a b. (a -> b) -> a -> b
$ Char -> Gen Char
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
':',
      Int -> Gen Char -> Gen String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
1 (Gen Char -> Gen String) -> Gen Char -> Gen String
forall a b. (a -> b) -> a -> b
$ Char -> Gen Char
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'@'
    ]

query :: Gen String
query :: Gen String
query =
  ([String] -> String) -> Gen [String] -> Gen String
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Char
'?' Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) (Gen [String] -> Gen String) -> Gen [String] -> Gen String
forall a b. (a -> b) -> a -> b
$ Gen String -> Gen [String]
forall a. Gen a -> Gen [a]
listOf (Gen String -> Gen [String]) -> Gen String -> Gen [String]
forall a b. (a -> b) -> a -> b
$ [Gen String] -> Gen String
forall a. HasCallStack => [Gen a] -> Gen a
oneof [Gen String
pchar, String -> Gen String
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"/", String -> Gen String
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"?"]

fragment :: Gen String
fragment :: Gen String
fragment =
  ([String] -> String) -> Gen [String] -> Gen String
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Char
'#' Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) (Gen [String] -> Gen String) -> Gen [String] -> Gen String
forall a b. (a -> b) -> a -> b
$ Gen String -> Gen [String]
forall a. Gen a -> Gen [a]
listOf (Gen String -> Gen [String]) -> Gen String -> Gen [String]
forall a b. (a -> b) -> a -> b
$ [Gen String] -> Gen String
forall a. HasCallStack => [Gen a] -> Gen a
oneof [Gen String
pchar, String -> Gen String
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"/", String -> Gen String
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"?"]

percentEncoded :: Gen String
percentEncoded :: Gen String
percentEncoded = (Char
'%' Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> Gen String -> Gen String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Char -> Gen String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 Gen Char
hexdig

unreserved :: Gen Char
unreserved :: Gen Char
unreserved = [Gen Char] -> Gen Char
forall a. HasCallStack => [Gen a] -> Gen a
oneof [Gen Char
alpha, Gen Char
digit, String -> Gen Char
forall a. HasCallStack => [a] -> Gen a
elements [Char
'-', Char
'.', Char
'_', Char
'~']]

subDelims :: Gen Char
subDelims :: Gen Char
subDelims = String -> Gen Char
forall a. HasCallStack => [a] -> Gen a
elements [Char
'!', Char
'$', Char
'&', Char
'\'', Char
'(', Char
')', Char
'*', Char
'+', Char
',', Char
';', Char
'=']

-- * RFC 2234 Generators

alpha :: Gen Char
alpha :: Gen Char
alpha = String -> Gen Char
forall a. HasCallStack => [a] -> Gen a
elements (String -> Gen Char) -> String -> Gen Char
forall a b. (a -> b) -> a -> b
$ [Char
'a' .. Char
'z'] String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
'A' .. Char
'Z']

digit :: Gen Char
digit :: Gen Char
digit = String -> Gen Char
forall a. HasCallStack => [a] -> Gen a
elements [Char
'0' .. Char
'9']

hexdig :: Gen Char
hexdig :: Gen Char
hexdig = [Gen Char] -> Gen Char
forall a. HasCallStack => [Gen a] -> Gen a
oneof [Gen Char
digit, String -> Gen Char
forall a. HasCallStack => [a] -> Gen a
elements [Char
'A' .. Char
'F']]