{-# LANGUAGE RecordWildCards #-}

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

{-|
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.Applicative
  ( (<$>)
  , (<*>)
  )
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
    [Char]
uriScheme    <- [Gen [Char]] -> Gen [Char]
forall a. [Gen a] -> Gen a
oneof [[Char] -> Gen [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
"", Gen [Char]
scheme]
    Maybe URIAuth
uriAuthority <- Gen (Maybe URIAuth)
forall a. Arbitrary a => Gen a
arbitrary :: Gen (Maybe URIAuth)
    [Char]
uriPath <- Bool -> Bool -> Gen [Char]
path ([Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
uriScheme) (Bool -> Gen [Char]) -> Bool -> Gen [Char]
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
    [Char]
uriQuery     <- [Gen [Char]] -> Gen [Char]
forall a. [Gen a] -> Gen a
oneof [Gen [Char]
query, [Char] -> Gen [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
""]
    [Char]
uriFragment  <- [Gen [Char]] -> Gen [Char]
forall a. [Gen a] -> Gen a
oneof [Gen [Char]
fragment, [Char] -> Gen [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
""]

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

  shrink :: URI -> [URI]
shrink URI {[Char]
Maybe URIAuth
uriFragment :: [Char]
uriQuery :: [Char]
uriPath :: [Char]
uriAuthority :: Maybe URIAuth
uriScheme :: [Char]
uriScheme :: URI -> [Char]
uriAuthority :: URI -> Maybe URIAuth
uriPath :: URI -> [Char]
uriQuery :: URI -> [Char]
uriFragment :: URI -> [Char]
..} = (URI -> Bool) -> [URI] -> [URI]
forall a. (a -> Bool) -> [a] -> [a]
filter
    URI -> Bool
isURI
    [ [Char] -> Maybe URIAuth -> [Char] -> [Char] -> [Char] -> URI
URI [Char]
uriScheme' Maybe URIAuth
uriAuthority' [Char]
uriPath' [Char]
uriQuery' [Char]
uriFragment'
    | ([Char]
uriScheme', Maybe URIAuth
uriAuthority', [Char]
uriPath', [Char]
uriQuery', [Char]
uriFragment') <- ([Char], Maybe URIAuth, [Char], [Char], [Char])
-> [([Char], Maybe URIAuth, [Char], [Char], [Char])]
forall a. Arbitrary a => a -> [a]
shrink
      ([Char]
uriScheme, Maybe URIAuth
uriAuthority, [Char]
uriPath, [Char]
uriQuery, [Char]
uriFragment)
    ]
   where
    isURI :: URI -> Bool
isURI URI
u = case [Char] -> Maybe URI
parseURIReference (([Char] -> [Char]) -> URI -> [Char] -> [Char]
uriToString [Char] -> [Char]
forall a. a -> a
id URI
u [Char]
"") 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 = [Char] -> [Char] -> [Char] -> URIAuth
URIAuth ([Char] -> [Char] -> [Char] -> URIAuth)
-> Gen [Char] -> Gen ([Char] -> [Char] -> URIAuth)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [Char]
userinfo Gen ([Char] -> [Char] -> URIAuth)
-> Gen [Char] -> Gen ([Char] -> URIAuth)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen [Char]
host Gen [Char] -> ([Char] -> Bool) -> Gen [Char]
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (Bool -> Bool
not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) Gen ([Char] -> URIAuth) -> Gen [Char] -> Gen URIAuth
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen [Char]
port

  shrink :: URIAuth -> [URIAuth]
shrink URIAuth {[Char]
uriPort :: [Char]
uriRegName :: [Char]
uriUserInfo :: [Char]
uriUserInfo :: URIAuth -> [Char]
uriRegName :: URIAuth -> [Char]
uriPort :: URIAuth -> [Char]
..} =
    [ [Char] -> [Char] -> [Char] -> URIAuth
URIAuth [Char]
uriUserInfo' [Char]
uriRegName' [Char]
uriPort'
    | ([Char]
uriUserInfo', [Char]
uriRegName', [Char]
uriPort') <- ([Char], [Char], [Char]) -> [([Char], [Char], [Char])]
forall a. Arbitrary a => a -> [a]
shrink
      ([Char]
uriUserInfo, [Char]
uriRegName, [Char]
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 [Char]
scheme = do
  Char
a <- Gen Char
alpha
  [Char]
r <- Gen Char -> Gen [Char]
forall a. Gen a -> Gen [a]
listOf (Gen Char -> Gen [Char]) -> Gen Char -> Gen [Char]
forall a b. (a -> b) -> a -> 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] -> Gen [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Gen [Char]) -> [Char] -> Gen [Char]
forall a b. (a -> b) -> a -> b
$ Char
a Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: ([Char]
r [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":")

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

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

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

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

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

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

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

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

decOctet :: Gen String
decOctet :: Gen [Char]
decOctet = (Int -> [Char]
forall a. Show a => a -> [Char]
show :: Int -> String) (Int -> [Char]) -> Gen Int -> Gen [Char]
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 [Char]
regName = ([[Char]] -> [Char]) -> Gen [[Char]] -> Gen [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Gen [[Char]] -> Gen [Char]) -> Gen [[Char]] -> Gen [Char]
forall a b. (a -> b) -> a -> b
$ Gen [Char] -> Gen [[Char]]
forall a. Gen a -> Gen [a]
listOf (Gen [Char] -> Gen [[Char]]) -> Gen [Char] -> Gen [[Char]]
forall a b. (a -> b) -> a -> b
$ [Gen [Char]] -> Gen [Char]
forall a. [Gen a] -> Gen a
oneof
  [Int -> Gen Char -> Gen [Char]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
1 Gen Char
unreserved, Gen [Char]
percentEncoded, Int -> Gen Char -> Gen [Char]
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 [Char]
path Bool
emptyScheme Bool
emptyURIAuth = if Bool
emptyURIAuth
  then [Gen [Char]] -> Gen [Char]
forall a. [Gen a] -> Gen a
oneof
    [ Gen [Char]
pathAbsolute
    , if Bool
emptyScheme then Gen [Char]
pathNoScheme else Gen [Char]
pathRootless
    , [Char] -> Gen [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
""
    ]
  else Gen [Char]
pathAbEmpty

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

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

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

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

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

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

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

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

percentEncoded :: Gen String
percentEncoded :: Gen [Char]
percentEncoded = (Char
'%' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:) ([Char] -> [Char]) -> Gen [Char] -> Gen [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Char -> Gen [Char]
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. [Gen a] -> Gen a
oneof [Gen Char
alpha, Gen Char
digit, [Char] -> Gen Char
forall a. [a] -> Gen a
elements [Char
'-', Char
'.', Char
'_', Char
'~']]

subDelims :: Gen Char
subDelims :: Gen Char
subDelims = [Char] -> Gen Char
forall a. [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 = [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']

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