{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}

-- |
-- Module      :  Text.URI.Types
-- Copyright   :  © 2017–present Mark Karpov
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- 'URI' types, an internal module.
module Text.URI.Types
  ( -- * Data types
    URI (..),
    makeAbsolute,
    isPathAbsolute,
    Authority (..),
    UserInfo (..),
    QueryParam (..),
    ParseException (..),
    ParseExceptionBs (..),

    -- * Refined text
    RText,
    RTextLabel (..),
    mkScheme,
    mkHost,
    mkUsername,
    mkPassword,
    mkPathPiece,
    mkQueryKey,
    mkQueryValue,
    mkFragment,
    unRText,
    RTextException (..),

    -- * Utils
    pHost,
  )
where

import Control.DeepSeq
import Control.Monad
import Control.Monad.Catch (Exception (..), MonadThrow (..))
import Data.ByteString (ByteString)
import Data.Char
import Data.Data (Data)
import Data.Either (fromLeft)
import Data.List (intercalate)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Maybe (fromJust, fromMaybe, isJust)
import Data.Proxy
import Data.Text (Text)
import qualified Data.Text as T
import Data.Typeable (Typeable, cast)
import Data.Void
import Data.Word (Word16, Word8)
import GHC.Generics
import qualified Language.Haskell.TH.Syntax as TH
import Numeric (showHex, showInt)
import Test.QuickCheck
import Text.Megaparsec
import Text.URI.Parser.Text.Utils (pHost)

----------------------------------------------------------------------------
-- Data types

-- | Uniform resource identifier (URI) reference. We use refined 'Text'
-- (@'RText' l@) here because information is presented in human-readable
-- form, i.e. percent-decoded, and thus it may contain Unicode characters.
data URI = URI
  { -- | URI scheme, if 'Nothing', then the URI reference is relative
    URI -> Maybe (RText 'Scheme)
uriScheme :: Maybe (RText 'Scheme),
    -- | 'Authority' component in 'Right' or a 'Bool' value in 'Left'
    -- indicating if 'uriPath' path is absolute ('True') or relative
    -- ('False'); if we have an 'Authority' component, then the path is
    -- necessarily absolute, see 'isPathAbsolute'
    --
    -- __Note__: before version /0.1.0.0/ type of 'uriAuthority' was
    -- @'Maybe' 'Authority'@
    URI -> Either Bool Authority
uriAuthority :: Either Bool Authority,
    -- | 'Nothing' represents the empty path, while 'Just' contains an
    -- indication 'Bool' whether the path component has a trailing slash,
    -- and the collection of path pieces @'NonEmpty' ('RText' 'PathPiece')@.
    --
    -- __Note__: before version /0.2.0.0/ type of 'uriPath' was @['RText'
    -- 'PathPiece']@.
    URI -> Maybe (Bool, NonEmpty (RText 'PathPiece))
uriPath :: Maybe (Bool, NonEmpty (RText 'PathPiece)),
    -- | Query parameters, RFC 3986 does not define the inner organization
    -- of query string, so we deconstruct it following RFC 1866 here
    URI -> [QueryParam]
uriQuery :: [QueryParam],
    -- | Fragment, without @#@
    URI -> Maybe (RText 'Fragment)
uriFragment :: Maybe (RText 'Fragment)
  }
  deriving (Int -> URI -> ShowS
[URI] -> ShowS
URI -> String
(Int -> URI -> ShowS)
-> (URI -> String) -> ([URI] -> ShowS) -> Show URI
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [URI] -> ShowS
$cshowList :: [URI] -> ShowS
show :: URI -> String
$cshow :: URI -> String
showsPrec :: Int -> URI -> ShowS
$cshowsPrec :: Int -> URI -> ShowS
Show, URI -> URI -> Bool
(URI -> URI -> Bool) -> (URI -> URI -> Bool) -> Eq URI
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: URI -> URI -> Bool
$c/= :: URI -> URI -> Bool
== :: URI -> URI -> Bool
$c== :: URI -> URI -> Bool
Eq, Eq URI
Eq URI
-> (URI -> URI -> Ordering)
-> (URI -> URI -> Bool)
-> (URI -> URI -> Bool)
-> (URI -> URI -> Bool)
-> (URI -> URI -> Bool)
-> (URI -> URI -> URI)
-> (URI -> URI -> URI)
-> Ord URI
URI -> URI -> Bool
URI -> URI -> Ordering
URI -> URI -> URI
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: URI -> URI -> URI
$cmin :: URI -> URI -> URI
max :: URI -> URI -> URI
$cmax :: URI -> URI -> URI
>= :: URI -> URI -> Bool
$c>= :: URI -> URI -> Bool
> :: URI -> URI -> Bool
$c> :: URI -> URI -> Bool
<= :: URI -> URI -> Bool
$c<= :: URI -> URI -> Bool
< :: URI -> URI -> Bool
$c< :: URI -> URI -> Bool
compare :: URI -> URI -> Ordering
$ccompare :: URI -> URI -> Ordering
$cp1Ord :: Eq URI
Ord, Typeable URI
DataType
Constr
Typeable URI
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> URI -> c URI)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c URI)
-> (URI -> Constr)
-> (URI -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c URI))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c URI))
-> ((forall b. Data b => b -> b) -> URI -> URI)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> URI -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> URI -> r)
-> (forall u. (forall d. Data d => d -> u) -> URI -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> URI -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> URI -> m URI)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> URI -> m URI)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> URI -> m URI)
-> Data URI
URI -> DataType
URI -> Constr
(forall b. Data b => b -> b) -> URI -> URI
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> URI -> c URI
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c URI
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> URI -> u
forall u. (forall d. Data d => d -> u) -> URI -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> URI -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> URI -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> URI -> m URI
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> URI -> m URI
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c URI
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> URI -> c URI
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c URI)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c URI)
$cURI :: Constr
$tURI :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> URI -> m URI
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> URI -> m URI
gmapMp :: (forall d. Data d => d -> m d) -> URI -> m URI
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> URI -> m URI
gmapM :: (forall d. Data d => d -> m d) -> URI -> m URI
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> URI -> m URI
gmapQi :: Int -> (forall d. Data d => d -> u) -> URI -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> URI -> u
gmapQ :: (forall d. Data d => d -> u) -> URI -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> URI -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> URI -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> URI -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> URI -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> URI -> r
gmapT :: (forall b. Data b => b -> b) -> URI -> URI
$cgmapT :: (forall b. Data b => b -> b) -> URI -> URI
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c URI)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c URI)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c URI)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c URI)
dataTypeOf :: URI -> DataType
$cdataTypeOf :: URI -> DataType
toConstr :: URI -> Constr
$ctoConstr :: URI -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c URI
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c URI
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> URI -> c URI
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> URI -> c URI
$cp1Data :: Typeable URI
Data, Typeable, (forall x. URI -> Rep URI x)
-> (forall x. Rep URI x -> URI) -> Generic URI
forall x. Rep URI x -> URI
forall x. URI -> Rep URI x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep URI x -> URI
$cfrom :: forall x. URI -> Rep URI x
Generic)

instance Arbitrary URI where
  arbitrary :: Gen URI
arbitrary =
    Maybe (RText 'Scheme)
-> Either Bool Authority
-> Maybe (Bool, NonEmpty (RText 'PathPiece))
-> [QueryParam]
-> Maybe (RText 'Fragment)
-> URI
URI
      (Maybe (RText 'Scheme)
 -> Either Bool Authority
 -> Maybe (Bool, NonEmpty (RText 'PathPiece))
 -> [QueryParam]
 -> Maybe (RText 'Fragment)
 -> URI)
-> Gen (Maybe (RText 'Scheme))
-> Gen
     (Either Bool Authority
      -> Maybe (Bool, NonEmpty (RText 'PathPiece))
      -> [QueryParam]
      -> Maybe (RText 'Fragment)
      -> URI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Maybe (RText 'Scheme))
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Either Bool Authority
   -> Maybe (Bool, NonEmpty (RText 'PathPiece))
   -> [QueryParam]
   -> Maybe (RText 'Fragment)
   -> URI)
-> Gen (Either Bool Authority)
-> Gen
     (Maybe (Bool, NonEmpty (RText 'PathPiece))
      -> [QueryParam] -> Maybe (RText 'Fragment) -> URI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Either Bool Authority)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Maybe (Bool, NonEmpty (RText 'PathPiece))
   -> [QueryParam] -> Maybe (RText 'Fragment) -> URI)
-> Gen (Maybe (Bool, NonEmpty (RText 'PathPiece)))
-> Gen ([QueryParam] -> Maybe (RText 'Fragment) -> URI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( do
              Maybe (NonEmpty (RText 'PathPiece))
mpieces <- [RText 'PathPiece] -> Maybe (NonEmpty (RText 'PathPiece))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty ([RText 'PathPiece] -> Maybe (NonEmpty (RText 'PathPiece)))
-> Gen [RText 'PathPiece]
-> Gen (Maybe (NonEmpty (RText 'PathPiece)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [RText 'PathPiece]
forall a. Arbitrary a => Gen a
arbitrary
              Bool
trailingSlash <- Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
              Maybe (Bool, NonEmpty (RText 'PathPiece))
-> Gen (Maybe (Bool, NonEmpty (RText 'PathPiece)))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Bool
trailingSlash,) (NonEmpty (RText 'PathPiece)
 -> (Bool, NonEmpty (RText 'PathPiece)))
-> Maybe (NonEmpty (RText 'PathPiece))
-> Maybe (Bool, NonEmpty (RText 'PathPiece))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (NonEmpty (RText 'PathPiece))
mpieces)
          )
      Gen ([QueryParam] -> Maybe (RText 'Fragment) -> URI)
-> Gen [QueryParam] -> Gen (Maybe (RText 'Fragment) -> URI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen [QueryParam]
forall a. Arbitrary a => Gen a
arbitrary
      Gen (Maybe (RText 'Fragment) -> URI)
-> Gen (Maybe (RText 'Fragment)) -> Gen URI
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe (RText 'Fragment))
forall a. Arbitrary a => Gen a
arbitrary

instance NFData URI

-- | @since 0.3.1.0
instance TH.Lift URI where
  lift :: URI -> Q Exp
lift = URI -> Q Exp
forall a. Data a => a -> Q Exp
liftData

#if MIN_VERSION_template_haskell(2,17,0)
  liftTyped = TH.Code . TH.unsafeTExpCoerce . TH.lift
#elif MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: URI -> Q (TExp URI)
liftTyped = Q Exp -> Q (TExp URI)
forall a. Q Exp -> Q (TExp a)
TH.unsafeTExpCoerce (Q Exp -> Q (TExp URI)) -> (URI -> Q Exp) -> URI -> Q (TExp URI)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> Q Exp
forall t. Lift t => t -> Q Exp
TH.lift
#endif

-- | Make a given 'URI' reference absolute using the supplied @'RText'
-- 'Scheme'@ if necessary.
makeAbsolute :: RText 'Scheme -> URI -> URI
makeAbsolute :: RText 'Scheme -> URI -> URI
makeAbsolute RText 'Scheme
scheme URI {[QueryParam]
Maybe (Bool, NonEmpty (RText 'PathPiece))
Maybe (RText 'Scheme)
Maybe (RText 'Fragment)
Either Bool Authority
uriFragment :: Maybe (RText 'Fragment)
uriQuery :: [QueryParam]
uriPath :: Maybe (Bool, NonEmpty (RText 'PathPiece))
uriAuthority :: Either Bool Authority
uriScheme :: Maybe (RText 'Scheme)
uriFragment :: URI -> Maybe (RText 'Fragment)
uriQuery :: URI -> [QueryParam]
uriPath :: URI -> Maybe (Bool, NonEmpty (RText 'PathPiece))
uriAuthority :: URI -> Either Bool Authority
uriScheme :: URI -> Maybe (RText 'Scheme)
..} =
  URI :: Maybe (RText 'Scheme)
-> Either Bool Authority
-> Maybe (Bool, NonEmpty (RText 'PathPiece))
-> [QueryParam]
-> Maybe (RText 'Fragment)
-> URI
URI
    { uriScheme :: Maybe (RText 'Scheme)
uriScheme = RText 'Scheme -> Maybe (RText 'Scheme)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RText 'Scheme -> Maybe (RText 'Scheme) -> RText 'Scheme
forall a. a -> Maybe a -> a
fromMaybe RText 'Scheme
scheme Maybe (RText 'Scheme)
uriScheme),
      [QueryParam]
Maybe (Bool, NonEmpty (RText 'PathPiece))
Maybe (RText 'Fragment)
Either Bool Authority
uriFragment :: Maybe (RText 'Fragment)
uriQuery :: [QueryParam]
uriPath :: Maybe (Bool, NonEmpty (RText 'PathPiece))
uriAuthority :: Either Bool Authority
uriFragment :: Maybe (RText 'Fragment)
uriQuery :: [QueryParam]
uriPath :: Maybe (Bool, NonEmpty (RText 'PathPiece))
uriAuthority :: Either Bool Authority
..
    }

-- | Return 'True' if path in a given 'URI' is absolute.
--
-- @since 0.1.0.0
isPathAbsolute :: URI -> Bool
isPathAbsolute :: URI -> Bool
isPathAbsolute = Bool -> Either Bool Authority -> Bool
forall a b. a -> Either a b -> a
fromLeft Bool
True (Either Bool Authority -> Bool)
-> (URI -> Either Bool Authority) -> URI -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> Either Bool Authority
uriAuthority

-- | Authority component of 'URI'.
data Authority = Authority
  { -- | User information
    Authority -> Maybe UserInfo
authUserInfo :: Maybe UserInfo,
    -- | Host
    Authority -> RText 'Host
authHost :: RText 'Host,
    -- | Port number
    Authority -> Maybe Word
authPort :: Maybe Word
  }
  deriving (Int -> Authority -> ShowS
[Authority] -> ShowS
Authority -> String
(Int -> Authority -> ShowS)
-> (Authority -> String)
-> ([Authority] -> ShowS)
-> Show Authority
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Authority] -> ShowS
$cshowList :: [Authority] -> ShowS
show :: Authority -> String
$cshow :: Authority -> String
showsPrec :: Int -> Authority -> ShowS
$cshowsPrec :: Int -> Authority -> ShowS
Show, Authority -> Authority -> Bool
(Authority -> Authority -> Bool)
-> (Authority -> Authority -> Bool) -> Eq Authority
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Authority -> Authority -> Bool
$c/= :: Authority -> Authority -> Bool
== :: Authority -> Authority -> Bool
$c== :: Authority -> Authority -> Bool
Eq, Eq Authority
Eq Authority
-> (Authority -> Authority -> Ordering)
-> (Authority -> Authority -> Bool)
-> (Authority -> Authority -> Bool)
-> (Authority -> Authority -> Bool)
-> (Authority -> Authority -> Bool)
-> (Authority -> Authority -> Authority)
-> (Authority -> Authority -> Authority)
-> Ord Authority
Authority -> Authority -> Bool
Authority -> Authority -> Ordering
Authority -> Authority -> Authority
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Authority -> Authority -> Authority
$cmin :: Authority -> Authority -> Authority
max :: Authority -> Authority -> Authority
$cmax :: Authority -> Authority -> Authority
>= :: Authority -> Authority -> Bool
$c>= :: Authority -> Authority -> Bool
> :: Authority -> Authority -> Bool
$c> :: Authority -> Authority -> Bool
<= :: Authority -> Authority -> Bool
$c<= :: Authority -> Authority -> Bool
< :: Authority -> Authority -> Bool
$c< :: Authority -> Authority -> Bool
compare :: Authority -> Authority -> Ordering
$ccompare :: Authority -> Authority -> Ordering
$cp1Ord :: Eq Authority
Ord, Typeable Authority
DataType
Constr
Typeable Authority
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Authority -> c Authority)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Authority)
-> (Authority -> Constr)
-> (Authority -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Authority))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Authority))
-> ((forall b. Data b => b -> b) -> Authority -> Authority)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Authority -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Authority -> r)
-> (forall u. (forall d. Data d => d -> u) -> Authority -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Authority -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Authority -> m Authority)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Authority -> m Authority)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Authority -> m Authority)
-> Data Authority
Authority -> DataType
Authority -> Constr
(forall b. Data b => b -> b) -> Authority -> Authority
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Authority -> c Authority
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Authority
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Authority -> u
forall u. (forall d. Data d => d -> u) -> Authority -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Authority -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Authority -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Authority -> m Authority
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Authority -> m Authority
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Authority
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Authority -> c Authority
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Authority)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Authority)
$cAuthority :: Constr
$tAuthority :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Authority -> m Authority
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Authority -> m Authority
gmapMp :: (forall d. Data d => d -> m d) -> Authority -> m Authority
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Authority -> m Authority
gmapM :: (forall d. Data d => d -> m d) -> Authority -> m Authority
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Authority -> m Authority
gmapQi :: Int -> (forall d. Data d => d -> u) -> Authority -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Authority -> u
gmapQ :: (forall d. Data d => d -> u) -> Authority -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Authority -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Authority -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Authority -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Authority -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Authority -> r
gmapT :: (forall b. Data b => b -> b) -> Authority -> Authority
$cgmapT :: (forall b. Data b => b -> b) -> Authority -> Authority
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Authority)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Authority)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Authority)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Authority)
dataTypeOf :: Authority -> DataType
$cdataTypeOf :: Authority -> DataType
toConstr :: Authority -> Constr
$ctoConstr :: Authority -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Authority
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Authority
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Authority -> c Authority
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Authority -> c Authority
$cp1Data :: Typeable Authority
Data, Typeable, (forall x. Authority -> Rep Authority x)
-> (forall x. Rep Authority x -> Authority) -> Generic Authority
forall x. Rep Authority x -> Authority
forall x. Authority -> Rep Authority x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Authority x -> Authority
$cfrom :: forall x. Authority -> Rep Authority x
Generic)

instance Arbitrary Authority where
  arbitrary :: Gen Authority
arbitrary =
    Maybe UserInfo -> RText 'Host -> Maybe Word -> Authority
Authority
      (Maybe UserInfo -> RText 'Host -> Maybe Word -> Authority)
-> Gen (Maybe UserInfo)
-> Gen (RText 'Host -> Maybe Word -> Authority)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Maybe UserInfo)
forall a. Arbitrary a => Gen a
arbitrary
      Gen (RText 'Host -> Maybe Word -> Authority)
-> Gen (RText 'Host) -> Gen (Maybe Word -> Authority)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (RText 'Host)
forall a. Arbitrary a => Gen a
arbitrary
      Gen (Maybe Word -> Authority) -> Gen (Maybe Word) -> Gen Authority
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Word)
forall a. Arbitrary a => Gen a
arbitrary

instance NFData Authority

-- | @since 0.3.1.0
instance TH.Lift Authority where
  lift :: Authority -> Q Exp
lift = Authority -> Q Exp
forall a. Data a => a -> Q Exp
liftData

#if MIN_VERSION_template_haskell(2,17,0)
  liftTyped = TH.Code . TH.unsafeTExpCoerce . TH.lift
#elif MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: Authority -> Q (TExp Authority)
liftTyped = Q Exp -> Q (TExp Authority)
forall a. Q Exp -> Q (TExp a)
TH.unsafeTExpCoerce (Q Exp -> Q (TExp Authority))
-> (Authority -> Q Exp) -> Authority -> Q (TExp Authority)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Authority -> Q Exp
forall t. Lift t => t -> Q Exp
TH.lift
#endif

-- | User info as a combination of username and password.
data UserInfo = UserInfo
  { -- | Username
    UserInfo -> RText 'Username
uiUsername :: RText 'Username,
    -- | Password, 'Nothing' means that there was no @:@ character in the
    -- user info string
    UserInfo -> Maybe (RText 'Password)
uiPassword :: Maybe (RText 'Password)
  }
  deriving (Int -> UserInfo -> ShowS
[UserInfo] -> ShowS
UserInfo -> String
(Int -> UserInfo -> ShowS)
-> (UserInfo -> String) -> ([UserInfo] -> ShowS) -> Show UserInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserInfo] -> ShowS
$cshowList :: [UserInfo] -> ShowS
show :: UserInfo -> String
$cshow :: UserInfo -> String
showsPrec :: Int -> UserInfo -> ShowS
$cshowsPrec :: Int -> UserInfo -> ShowS
Show, UserInfo -> UserInfo -> Bool
(UserInfo -> UserInfo -> Bool)
-> (UserInfo -> UserInfo -> Bool) -> Eq UserInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserInfo -> UserInfo -> Bool
$c/= :: UserInfo -> UserInfo -> Bool
== :: UserInfo -> UserInfo -> Bool
$c== :: UserInfo -> UserInfo -> Bool
Eq, Eq UserInfo
Eq UserInfo
-> (UserInfo -> UserInfo -> Ordering)
-> (UserInfo -> UserInfo -> Bool)
-> (UserInfo -> UserInfo -> Bool)
-> (UserInfo -> UserInfo -> Bool)
-> (UserInfo -> UserInfo -> Bool)
-> (UserInfo -> UserInfo -> UserInfo)
-> (UserInfo -> UserInfo -> UserInfo)
-> Ord UserInfo
UserInfo -> UserInfo -> Bool
UserInfo -> UserInfo -> Ordering
UserInfo -> UserInfo -> UserInfo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UserInfo -> UserInfo -> UserInfo
$cmin :: UserInfo -> UserInfo -> UserInfo
max :: UserInfo -> UserInfo -> UserInfo
$cmax :: UserInfo -> UserInfo -> UserInfo
>= :: UserInfo -> UserInfo -> Bool
$c>= :: UserInfo -> UserInfo -> Bool
> :: UserInfo -> UserInfo -> Bool
$c> :: UserInfo -> UserInfo -> Bool
<= :: UserInfo -> UserInfo -> Bool
$c<= :: UserInfo -> UserInfo -> Bool
< :: UserInfo -> UserInfo -> Bool
$c< :: UserInfo -> UserInfo -> Bool
compare :: UserInfo -> UserInfo -> Ordering
$ccompare :: UserInfo -> UserInfo -> Ordering
$cp1Ord :: Eq UserInfo
Ord, Typeable UserInfo
DataType
Constr
Typeable UserInfo
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> UserInfo -> c UserInfo)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c UserInfo)
-> (UserInfo -> Constr)
-> (UserInfo -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c UserInfo))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UserInfo))
-> ((forall b. Data b => b -> b) -> UserInfo -> UserInfo)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> UserInfo -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> UserInfo -> r)
-> (forall u. (forall d. Data d => d -> u) -> UserInfo -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> UserInfo -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> UserInfo -> m UserInfo)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> UserInfo -> m UserInfo)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> UserInfo -> m UserInfo)
-> Data UserInfo
UserInfo -> DataType
UserInfo -> Constr
(forall b. Data b => b -> b) -> UserInfo -> UserInfo
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UserInfo -> c UserInfo
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UserInfo
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> UserInfo -> u
forall u. (forall d. Data d => d -> u) -> UserInfo -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UserInfo -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UserInfo -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UserInfo -> m UserInfo
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UserInfo -> m UserInfo
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UserInfo
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UserInfo -> c UserInfo
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UserInfo)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UserInfo)
$cUserInfo :: Constr
$tUserInfo :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> UserInfo -> m UserInfo
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UserInfo -> m UserInfo
gmapMp :: (forall d. Data d => d -> m d) -> UserInfo -> m UserInfo
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UserInfo -> m UserInfo
gmapM :: (forall d. Data d => d -> m d) -> UserInfo -> m UserInfo
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UserInfo -> m UserInfo
gmapQi :: Int -> (forall d. Data d => d -> u) -> UserInfo -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UserInfo -> u
gmapQ :: (forall d. Data d => d -> u) -> UserInfo -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UserInfo -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UserInfo -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UserInfo -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UserInfo -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UserInfo -> r
gmapT :: (forall b. Data b => b -> b) -> UserInfo -> UserInfo
$cgmapT :: (forall b. Data b => b -> b) -> UserInfo -> UserInfo
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UserInfo)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UserInfo)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c UserInfo)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UserInfo)
dataTypeOf :: UserInfo -> DataType
$cdataTypeOf :: UserInfo -> DataType
toConstr :: UserInfo -> Constr
$ctoConstr :: UserInfo -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UserInfo
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UserInfo
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UserInfo -> c UserInfo
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UserInfo -> c UserInfo
$cp1Data :: Typeable UserInfo
Data, Typeable, (forall x. UserInfo -> Rep UserInfo x)
-> (forall x. Rep UserInfo x -> UserInfo) -> Generic UserInfo
forall x. Rep UserInfo x -> UserInfo
forall x. UserInfo -> Rep UserInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UserInfo x -> UserInfo
$cfrom :: forall x. UserInfo -> Rep UserInfo x
Generic)

instance Arbitrary UserInfo where
  arbitrary :: Gen UserInfo
arbitrary =
    RText 'Username -> Maybe (RText 'Password) -> UserInfo
UserInfo
      (RText 'Username -> Maybe (RText 'Password) -> UserInfo)
-> Gen (RText 'Username)
-> Gen (Maybe (RText 'Password) -> UserInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (RText 'Username)
forall a. Arbitrary a => Gen a
arbitrary
      Gen (Maybe (RText 'Password) -> UserInfo)
-> Gen (Maybe (RText 'Password)) -> Gen UserInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe (RText 'Password))
forall a. Arbitrary a => Gen a
arbitrary

instance NFData UserInfo

-- | @since 0.3.1.0
instance TH.Lift UserInfo where
  lift :: UserInfo -> Q Exp
lift = UserInfo -> Q Exp
forall a. Data a => a -> Q Exp
liftData

#if MIN_VERSION_template_haskell(2,17,0)
  liftTyped = TH.Code . TH.unsafeTExpCoerce . TH.lift
#elif MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: UserInfo -> Q (TExp UserInfo)
liftTyped = Q Exp -> Q (TExp UserInfo)
forall a. Q Exp -> Q (TExp a)
TH.unsafeTExpCoerce (Q Exp -> Q (TExp UserInfo))
-> (UserInfo -> Q Exp) -> UserInfo -> Q (TExp UserInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserInfo -> Q Exp
forall t. Lift t => t -> Q Exp
TH.lift
#endif

-- | Query parameter either in the form of flag or as a pair of key and
-- value. A key cannot be empty, while a value can.
data QueryParam
  = -- | Flag parameter
    QueryFlag (RText 'QueryKey)
  | -- | Key–value pair
    QueryParam (RText 'QueryKey) (RText 'QueryValue)
  deriving (Int -> QueryParam -> ShowS
[QueryParam] -> ShowS
QueryParam -> String
(Int -> QueryParam -> ShowS)
-> (QueryParam -> String)
-> ([QueryParam] -> ShowS)
-> Show QueryParam
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QueryParam] -> ShowS
$cshowList :: [QueryParam] -> ShowS
show :: QueryParam -> String
$cshow :: QueryParam -> String
showsPrec :: Int -> QueryParam -> ShowS
$cshowsPrec :: Int -> QueryParam -> ShowS
Show, QueryParam -> QueryParam -> Bool
(QueryParam -> QueryParam -> Bool)
-> (QueryParam -> QueryParam -> Bool) -> Eq QueryParam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueryParam -> QueryParam -> Bool
$c/= :: QueryParam -> QueryParam -> Bool
== :: QueryParam -> QueryParam -> Bool
$c== :: QueryParam -> QueryParam -> Bool
Eq, Eq QueryParam
Eq QueryParam
-> (QueryParam -> QueryParam -> Ordering)
-> (QueryParam -> QueryParam -> Bool)
-> (QueryParam -> QueryParam -> Bool)
-> (QueryParam -> QueryParam -> Bool)
-> (QueryParam -> QueryParam -> Bool)
-> (QueryParam -> QueryParam -> QueryParam)
-> (QueryParam -> QueryParam -> QueryParam)
-> Ord QueryParam
QueryParam -> QueryParam -> Bool
QueryParam -> QueryParam -> Ordering
QueryParam -> QueryParam -> QueryParam
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: QueryParam -> QueryParam -> QueryParam
$cmin :: QueryParam -> QueryParam -> QueryParam
max :: QueryParam -> QueryParam -> QueryParam
$cmax :: QueryParam -> QueryParam -> QueryParam
>= :: QueryParam -> QueryParam -> Bool
$c>= :: QueryParam -> QueryParam -> Bool
> :: QueryParam -> QueryParam -> Bool
$c> :: QueryParam -> QueryParam -> Bool
<= :: QueryParam -> QueryParam -> Bool
$c<= :: QueryParam -> QueryParam -> Bool
< :: QueryParam -> QueryParam -> Bool
$c< :: QueryParam -> QueryParam -> Bool
compare :: QueryParam -> QueryParam -> Ordering
$ccompare :: QueryParam -> QueryParam -> Ordering
$cp1Ord :: Eq QueryParam
Ord, Typeable QueryParam
DataType
Constr
Typeable QueryParam
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> QueryParam -> c QueryParam)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c QueryParam)
-> (QueryParam -> Constr)
-> (QueryParam -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c QueryParam))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c QueryParam))
-> ((forall b. Data b => b -> b) -> QueryParam -> QueryParam)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> QueryParam -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> QueryParam -> r)
-> (forall u. (forall d. Data d => d -> u) -> QueryParam -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> QueryParam -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> QueryParam -> m QueryParam)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> QueryParam -> m QueryParam)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> QueryParam -> m QueryParam)
-> Data QueryParam
QueryParam -> DataType
QueryParam -> Constr
(forall b. Data b => b -> b) -> QueryParam -> QueryParam
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QueryParam -> c QueryParam
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c QueryParam
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> QueryParam -> u
forall u. (forall d. Data d => d -> u) -> QueryParam -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> QueryParam -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> QueryParam -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> QueryParam -> m QueryParam
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> QueryParam -> m QueryParam
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c QueryParam
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QueryParam -> c QueryParam
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c QueryParam)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c QueryParam)
$cQueryParam :: Constr
$cQueryFlag :: Constr
$tQueryParam :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> QueryParam -> m QueryParam
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> QueryParam -> m QueryParam
gmapMp :: (forall d. Data d => d -> m d) -> QueryParam -> m QueryParam
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> QueryParam -> m QueryParam
gmapM :: (forall d. Data d => d -> m d) -> QueryParam -> m QueryParam
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> QueryParam -> m QueryParam
gmapQi :: Int -> (forall d. Data d => d -> u) -> QueryParam -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> QueryParam -> u
gmapQ :: (forall d. Data d => d -> u) -> QueryParam -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> QueryParam -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> QueryParam -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> QueryParam -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> QueryParam -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> QueryParam -> r
gmapT :: (forall b. Data b => b -> b) -> QueryParam -> QueryParam
$cgmapT :: (forall b. Data b => b -> b) -> QueryParam -> QueryParam
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c QueryParam)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c QueryParam)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c QueryParam)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c QueryParam)
dataTypeOf :: QueryParam -> DataType
$cdataTypeOf :: QueryParam -> DataType
toConstr :: QueryParam -> Constr
$ctoConstr :: QueryParam -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c QueryParam
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c QueryParam
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QueryParam -> c QueryParam
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QueryParam -> c QueryParam
$cp1Data :: Typeable QueryParam
Data, Typeable, (forall x. QueryParam -> Rep QueryParam x)
-> (forall x. Rep QueryParam x -> QueryParam) -> Generic QueryParam
forall x. Rep QueryParam x -> QueryParam
forall x. QueryParam -> Rep QueryParam x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep QueryParam x -> QueryParam
$cfrom :: forall x. QueryParam -> Rep QueryParam x
Generic)

instance Arbitrary QueryParam where
  arbitrary :: Gen QueryParam
arbitrary =
    [Gen QueryParam] -> Gen QueryParam
forall a. [Gen a] -> Gen a
oneof
      [ RText 'QueryKey -> QueryParam
QueryFlag (RText 'QueryKey -> QueryParam)
-> Gen (RText 'QueryKey) -> Gen QueryParam
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (RText 'QueryKey)
forall a. Arbitrary a => Gen a
arbitrary,
        RText 'QueryKey -> RText 'QueryValue -> QueryParam
QueryParam (RText 'QueryKey -> RText 'QueryValue -> QueryParam)
-> Gen (RText 'QueryKey) -> Gen (RText 'QueryValue -> QueryParam)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (RText 'QueryKey)
forall a. Arbitrary a => Gen a
arbitrary Gen (RText 'QueryValue -> QueryParam)
-> Gen (RText 'QueryValue) -> Gen QueryParam
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (RText 'QueryValue)
forall a. Arbitrary a => Gen a
arbitrary
      ]

instance NFData QueryParam

-- | @since 0.3.1.0
instance TH.Lift QueryParam where
  lift :: QueryParam -> Q Exp
lift = QueryParam -> Q Exp
forall a. Data a => a -> Q Exp
liftData

#if MIN_VERSION_template_haskell(2,17,0)
  liftTyped = TH.Code . TH.unsafeTExpCoerce . TH.lift
#elif MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: QueryParam -> Q (TExp QueryParam)
liftTyped = Q Exp -> Q (TExp QueryParam)
forall a. Q Exp -> Q (TExp a)
TH.unsafeTExpCoerce (Q Exp -> Q (TExp QueryParam))
-> (QueryParam -> Q Exp) -> QueryParam -> Q (TExp QueryParam)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryParam -> Q Exp
forall t. Lift t => t -> Q Exp
TH.lift
#endif

-- | Parse exception thrown by 'mkURI' when a given 'Text' value cannot be
-- parsed as a 'URI'.
newtype ParseException
  = -- | Arguments are: original input and parse error
    ParseException (ParseErrorBundle Text Void)
  deriving (Int -> ParseException -> ShowS
[ParseException] -> ShowS
ParseException -> String
(Int -> ParseException -> ShowS)
-> (ParseException -> String)
-> ([ParseException] -> ShowS)
-> Show ParseException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseException] -> ShowS
$cshowList :: [ParseException] -> ShowS
show :: ParseException -> String
$cshow :: ParseException -> String
showsPrec :: Int -> ParseException -> ShowS
$cshowsPrec :: Int -> ParseException -> ShowS
Show, ParseException -> ParseException -> Bool
(ParseException -> ParseException -> Bool)
-> (ParseException -> ParseException -> Bool) -> Eq ParseException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseException -> ParseException -> Bool
$c/= :: ParseException -> ParseException -> Bool
== :: ParseException -> ParseException -> Bool
$c== :: ParseException -> ParseException -> Bool
Eq, Typeable ParseException
DataType
Constr
Typeable ParseException
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ParseException -> c ParseException)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ParseException)
-> (ParseException -> Constr)
-> (ParseException -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ParseException))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ParseException))
-> ((forall b. Data b => b -> b)
    -> ParseException -> ParseException)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ParseException -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ParseException -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ParseException -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ParseException -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ParseException -> m ParseException)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ParseException -> m ParseException)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ParseException -> m ParseException)
-> Data ParseException
ParseException -> DataType
ParseException -> Constr
(forall b. Data b => b -> b) -> ParseException -> ParseException
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParseException -> c ParseException
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParseException
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ParseException -> u
forall u. (forall d. Data d => d -> u) -> ParseException -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParseException -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParseException -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ParseException -> m ParseException
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ParseException -> m ParseException
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParseException
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParseException -> c ParseException
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ParseException)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ParseException)
$cParseException :: Constr
$tParseException :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ParseException -> m ParseException
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ParseException -> m ParseException
gmapMp :: (forall d. Data d => d -> m d)
-> ParseException -> m ParseException
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ParseException -> m ParseException
gmapM :: (forall d. Data d => d -> m d)
-> ParseException -> m ParseException
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ParseException -> m ParseException
gmapQi :: Int -> (forall d. Data d => d -> u) -> ParseException -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ParseException -> u
gmapQ :: (forall d. Data d => d -> u) -> ParseException -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ParseException -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParseException -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParseException -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParseException -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParseException -> r
gmapT :: (forall b. Data b => b -> b) -> ParseException -> ParseException
$cgmapT :: (forall b. Data b => b -> b) -> ParseException -> ParseException
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ParseException)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ParseException)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ParseException)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ParseException)
dataTypeOf :: ParseException -> DataType
$cdataTypeOf :: ParseException -> DataType
toConstr :: ParseException -> Constr
$ctoConstr :: ParseException -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParseException
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParseException
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParseException -> c ParseException
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParseException -> c ParseException
$cp1Data :: Typeable ParseException
Data, Typeable, (forall x. ParseException -> Rep ParseException x)
-> (forall x. Rep ParseException x -> ParseException)
-> Generic ParseException
forall x. Rep ParseException x -> ParseException
forall x. ParseException -> Rep ParseException x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ParseException x -> ParseException
$cfrom :: forall x. ParseException -> Rep ParseException x
Generic)

instance Exception ParseException where
  displayException :: ParseException -> String
displayException (ParseException ParseErrorBundle Text Void
b) = ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle Text Void
b

instance NFData ParseException

-- | Parse exception thrown by 'mkURIBs' when a given 'ByteString' value cannot be
-- parsed as a 'URI'.
--
-- @since 0.3.3.0
newtype ParseExceptionBs
  = -- | Arguments are: original input and parse error
    ParseExceptionBs (ParseErrorBundle ByteString Void)
  deriving (Int -> ParseExceptionBs -> ShowS
[ParseExceptionBs] -> ShowS
ParseExceptionBs -> String
(Int -> ParseExceptionBs -> ShowS)
-> (ParseExceptionBs -> String)
-> ([ParseExceptionBs] -> ShowS)
-> Show ParseExceptionBs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseExceptionBs] -> ShowS
$cshowList :: [ParseExceptionBs] -> ShowS
show :: ParseExceptionBs -> String
$cshow :: ParseExceptionBs -> String
showsPrec :: Int -> ParseExceptionBs -> ShowS
$cshowsPrec :: Int -> ParseExceptionBs -> ShowS
Show, ParseExceptionBs -> ParseExceptionBs -> Bool
(ParseExceptionBs -> ParseExceptionBs -> Bool)
-> (ParseExceptionBs -> ParseExceptionBs -> Bool)
-> Eq ParseExceptionBs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseExceptionBs -> ParseExceptionBs -> Bool
$c/= :: ParseExceptionBs -> ParseExceptionBs -> Bool
== :: ParseExceptionBs -> ParseExceptionBs -> Bool
$c== :: ParseExceptionBs -> ParseExceptionBs -> Bool
Eq, Typeable ParseExceptionBs
DataType
Constr
Typeable ParseExceptionBs
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ParseExceptionBs -> c ParseExceptionBs)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ParseExceptionBs)
-> (ParseExceptionBs -> Constr)
-> (ParseExceptionBs -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ParseExceptionBs))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ParseExceptionBs))
-> ((forall b. Data b => b -> b)
    -> ParseExceptionBs -> ParseExceptionBs)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ParseExceptionBs -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ParseExceptionBs -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ParseExceptionBs -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ParseExceptionBs -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ParseExceptionBs -> m ParseExceptionBs)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ParseExceptionBs -> m ParseExceptionBs)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ParseExceptionBs -> m ParseExceptionBs)
-> Data ParseExceptionBs
ParseExceptionBs -> DataType
ParseExceptionBs -> Constr
(forall b. Data b => b -> b)
-> ParseExceptionBs -> ParseExceptionBs
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParseExceptionBs -> c ParseExceptionBs
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParseExceptionBs
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ParseExceptionBs -> u
forall u. (forall d. Data d => d -> u) -> ParseExceptionBs -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParseExceptionBs -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParseExceptionBs -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ParseExceptionBs -> m ParseExceptionBs
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ParseExceptionBs -> m ParseExceptionBs
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParseExceptionBs
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParseExceptionBs -> c ParseExceptionBs
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ParseExceptionBs)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ParseExceptionBs)
$cParseExceptionBs :: Constr
$tParseExceptionBs :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ParseExceptionBs -> m ParseExceptionBs
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ParseExceptionBs -> m ParseExceptionBs
gmapMp :: (forall d. Data d => d -> m d)
-> ParseExceptionBs -> m ParseExceptionBs
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ParseExceptionBs -> m ParseExceptionBs
gmapM :: (forall d. Data d => d -> m d)
-> ParseExceptionBs -> m ParseExceptionBs
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ParseExceptionBs -> m ParseExceptionBs
gmapQi :: Int -> (forall d. Data d => d -> u) -> ParseExceptionBs -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ParseExceptionBs -> u
gmapQ :: (forall d. Data d => d -> u) -> ParseExceptionBs -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ParseExceptionBs -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParseExceptionBs -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParseExceptionBs -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParseExceptionBs -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParseExceptionBs -> r
gmapT :: (forall b. Data b => b -> b)
-> ParseExceptionBs -> ParseExceptionBs
$cgmapT :: (forall b. Data b => b -> b)
-> ParseExceptionBs -> ParseExceptionBs
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ParseExceptionBs)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ParseExceptionBs)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ParseExceptionBs)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ParseExceptionBs)
dataTypeOf :: ParseExceptionBs -> DataType
$cdataTypeOf :: ParseExceptionBs -> DataType
toConstr :: ParseExceptionBs -> Constr
$ctoConstr :: ParseExceptionBs -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParseExceptionBs
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParseExceptionBs
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParseExceptionBs -> c ParseExceptionBs
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParseExceptionBs -> c ParseExceptionBs
$cp1Data :: Typeable ParseExceptionBs
Data, Typeable, (forall x. ParseExceptionBs -> Rep ParseExceptionBs x)
-> (forall x. Rep ParseExceptionBs x -> ParseExceptionBs)
-> Generic ParseExceptionBs
forall x. Rep ParseExceptionBs x -> ParseExceptionBs
forall x. ParseExceptionBs -> Rep ParseExceptionBs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ParseExceptionBs x -> ParseExceptionBs
$cfrom :: forall x. ParseExceptionBs -> Rep ParseExceptionBs x
Generic)

instance Exception ParseExceptionBs where
  displayException :: ParseExceptionBs -> String
displayException (ParseExceptionBs ParseErrorBundle ByteString Void
b) = ParseErrorBundle ByteString Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle ByteString Void
b

instance NFData ParseExceptionBs

----------------------------------------------------------------------------
-- Refined text

-- | Refined text labelled at the type level.
newtype RText (l :: RTextLabel) = RText Text
  deriving (RText l -> RText l -> Bool
(RText l -> RText l -> Bool)
-> (RText l -> RText l -> Bool) -> Eq (RText l)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (l :: RTextLabel). RText l -> RText l -> Bool
/= :: RText l -> RText l -> Bool
$c/= :: forall (l :: RTextLabel). RText l -> RText l -> Bool
== :: RText l -> RText l -> Bool
$c== :: forall (l :: RTextLabel). RText l -> RText l -> Bool
Eq, Eq (RText l)
Eq (RText l)
-> (RText l -> RText l -> Ordering)
-> (RText l -> RText l -> Bool)
-> (RText l -> RText l -> Bool)
-> (RText l -> RText l -> Bool)
-> (RText l -> RText l -> Bool)
-> (RText l -> RText l -> RText l)
-> (RText l -> RText l -> RText l)
-> Ord (RText l)
RText l -> RText l -> Bool
RText l -> RText l -> Ordering
RText l -> RText l -> RText l
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (l :: RTextLabel). Eq (RText l)
forall (l :: RTextLabel). RText l -> RText l -> Bool
forall (l :: RTextLabel). RText l -> RText l -> Ordering
forall (l :: RTextLabel). RText l -> RText l -> RText l
min :: RText l -> RText l -> RText l
$cmin :: forall (l :: RTextLabel). RText l -> RText l -> RText l
max :: RText l -> RText l -> RText l
$cmax :: forall (l :: RTextLabel). RText l -> RText l -> RText l
>= :: RText l -> RText l -> Bool
$c>= :: forall (l :: RTextLabel). RText l -> RText l -> Bool
> :: RText l -> RText l -> Bool
$c> :: forall (l :: RTextLabel). RText l -> RText l -> Bool
<= :: RText l -> RText l -> Bool
$c<= :: forall (l :: RTextLabel). RText l -> RText l -> Bool
< :: RText l -> RText l -> Bool
$c< :: forall (l :: RTextLabel). RText l -> RText l -> Bool
compare :: RText l -> RText l -> Ordering
$ccompare :: forall (l :: RTextLabel). RText l -> RText l -> Ordering
$cp1Ord :: forall (l :: RTextLabel). Eq (RText l)
Ord, Typeable (RText l)
DataType
Constr
Typeable (RText l)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> RText l -> c (RText l))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (RText l))
-> (RText l -> Constr)
-> (RText l -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (RText l)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (RText l)))
-> ((forall b. Data b => b -> b) -> RText l -> RText l)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RText l -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RText l -> r)
-> (forall u. (forall d. Data d => d -> u) -> RText l -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> RText l -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RText l -> m (RText l))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RText l -> m (RText l))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RText l -> m (RText l))
-> Data (RText l)
RText l -> DataType
RText l -> Constr
(forall b. Data b => b -> b) -> RText l -> RText l
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RText l -> c (RText l)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (RText l)
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RText l -> u
forall u. (forall d. Data d => d -> u) -> RText l -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RText l -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RText l -> r
forall (l :: RTextLabel). Typeable l => Typeable (RText l)
forall (l :: RTextLabel). Typeable l => RText l -> DataType
forall (l :: RTextLabel). Typeable l => RText l -> Constr
forall (l :: RTextLabel).
Typeable l =>
(forall b. Data b => b -> b) -> RText l -> RText l
forall (l :: RTextLabel) u.
Typeable l =>
Int -> (forall d. Data d => d -> u) -> RText l -> u
forall (l :: RTextLabel) u.
Typeable l =>
(forall d. Data d => d -> u) -> RText l -> [u]
forall (l :: RTextLabel) r r'.
Typeable l =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RText l -> r
forall (l :: RTextLabel) r r'.
Typeable l =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RText l -> r
forall (l :: RTextLabel) (m :: * -> *).
(Typeable l, Monad m) =>
(forall d. Data d => d -> m d) -> RText l -> m (RText l)
forall (l :: RTextLabel) (m :: * -> *).
(Typeable l, MonadPlus m) =>
(forall d. Data d => d -> m d) -> RText l -> m (RText l)
forall (l :: RTextLabel) (c :: * -> *).
Typeable l =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (RText l)
forall (l :: RTextLabel) (c :: * -> *).
Typeable l =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RText l -> c (RText l)
forall (l :: RTextLabel) (t :: * -> *) (c :: * -> *).
(Typeable l, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (RText l))
forall (l :: RTextLabel) (t :: * -> * -> *) (c :: * -> *).
(Typeable l, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (RText l))
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RText l -> m (RText l)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RText l -> m (RText l)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (RText l)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RText l -> c (RText l)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (RText l))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (RText l))
$cRText :: Constr
$tRText :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> RText l -> m (RText l)
$cgmapMo :: forall (l :: RTextLabel) (m :: * -> *).
(Typeable l, MonadPlus m) =>
(forall d. Data d => d -> m d) -> RText l -> m (RText l)
gmapMp :: (forall d. Data d => d -> m d) -> RText l -> m (RText l)
$cgmapMp :: forall (l :: RTextLabel) (m :: * -> *).
(Typeable l, MonadPlus m) =>
(forall d. Data d => d -> m d) -> RText l -> m (RText l)
gmapM :: (forall d. Data d => d -> m d) -> RText l -> m (RText l)
$cgmapM :: forall (l :: RTextLabel) (m :: * -> *).
(Typeable l, Monad m) =>
(forall d. Data d => d -> m d) -> RText l -> m (RText l)
gmapQi :: Int -> (forall d. Data d => d -> u) -> RText l -> u
$cgmapQi :: forall (l :: RTextLabel) u.
Typeable l =>
Int -> (forall d. Data d => d -> u) -> RText l -> u
gmapQ :: (forall d. Data d => d -> u) -> RText l -> [u]
$cgmapQ :: forall (l :: RTextLabel) u.
Typeable l =>
(forall d. Data d => d -> u) -> RText l -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RText l -> r
$cgmapQr :: forall (l :: RTextLabel) r r'.
Typeable l =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RText l -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RText l -> r
$cgmapQl :: forall (l :: RTextLabel) r r'.
Typeable l =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RText l -> r
gmapT :: (forall b. Data b => b -> b) -> RText l -> RText l
$cgmapT :: forall (l :: RTextLabel).
Typeable l =>
(forall b. Data b => b -> b) -> RText l -> RText l
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (RText l))
$cdataCast2 :: forall (l :: RTextLabel) (t :: * -> * -> *) (c :: * -> *).
(Typeable l, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (RText l))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (RText l))
$cdataCast1 :: forall (l :: RTextLabel) (t :: * -> *) (c :: * -> *).
(Typeable l, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (RText l))
dataTypeOf :: RText l -> DataType
$cdataTypeOf :: forall (l :: RTextLabel). Typeable l => RText l -> DataType
toConstr :: RText l -> Constr
$ctoConstr :: forall (l :: RTextLabel). Typeable l => RText l -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (RText l)
$cgunfold :: forall (l :: RTextLabel) (c :: * -> *).
Typeable l =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (RText l)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RText l -> c (RText l)
$cgfoldl :: forall (l :: RTextLabel) (c :: * -> *).
Typeable l =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RText l -> c (RText l)
$cp1Data :: forall (l :: RTextLabel). Typeable l => Typeable (RText l)
Data, Typeable, (forall x. RText l -> Rep (RText l) x)
-> (forall x. Rep (RText l) x -> RText l) -> Generic (RText l)
forall x. Rep (RText l) x -> RText l
forall x. RText l -> Rep (RText l) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (l :: RTextLabel) x. Rep (RText l) x -> RText l
forall (l :: RTextLabel) x. RText l -> Rep (RText l) x
$cto :: forall (l :: RTextLabel) x. Rep (RText l) x -> RText l
$cfrom :: forall (l :: RTextLabel) x. RText l -> Rep (RText l) x
Generic)

instance Show (RText l) where
  show :: RText l -> String
show (RText Text
txt) = Text -> String
forall a. Show a => a -> String
show Text
txt

instance NFData (RText l)

-- | @since 0.3.1.0
instance Typeable l => TH.Lift (RText l) where
  lift :: RText l -> Q Exp
lift = RText l -> Q Exp
forall a. Data a => a -> Q Exp
liftData

#if MIN_VERSION_template_haskell(2,17,0)
  liftTyped = TH.Code . TH.unsafeTExpCoerce . TH.lift
#elif MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: RText l -> Q (TExp (RText l))
liftTyped = Q Exp -> Q (TExp (RText l))
forall a. Q Exp -> Q (TExp a)
TH.unsafeTExpCoerce (Q Exp -> Q (TExp (RText l)))
-> (RText l -> Q Exp) -> RText l -> Q (TExp (RText l))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RText l -> Q Exp
forall t. Lift t => t -> Q Exp
TH.lift
#endif

-- | Refined text labels.
data RTextLabel
  = -- | See 'mkScheme'
    Scheme
  | -- | See 'mkHost'
    Host
  | -- | See 'mkUsername'
    Username
  | -- | See 'mkPassword'
    Password
  | -- | See 'mkPathPiece'
    PathPiece
  | -- | See 'mkQueryKey'
    QueryKey
  | -- | See 'mkQueryValue'
    QueryValue
  | -- | See 'mkFragment'
    Fragment
  deriving (Int -> RTextLabel -> ShowS
[RTextLabel] -> ShowS
RTextLabel -> String
(Int -> RTextLabel -> ShowS)
-> (RTextLabel -> String)
-> ([RTextLabel] -> ShowS)
-> Show RTextLabel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RTextLabel] -> ShowS
$cshowList :: [RTextLabel] -> ShowS
show :: RTextLabel -> String
$cshow :: RTextLabel -> String
showsPrec :: Int -> RTextLabel -> ShowS
$cshowsPrec :: Int -> RTextLabel -> ShowS
Show, RTextLabel -> RTextLabel -> Bool
(RTextLabel -> RTextLabel -> Bool)
-> (RTextLabel -> RTextLabel -> Bool) -> Eq RTextLabel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RTextLabel -> RTextLabel -> Bool
$c/= :: RTextLabel -> RTextLabel -> Bool
== :: RTextLabel -> RTextLabel -> Bool
$c== :: RTextLabel -> RTextLabel -> Bool
Eq, Eq RTextLabel
Eq RTextLabel
-> (RTextLabel -> RTextLabel -> Ordering)
-> (RTextLabel -> RTextLabel -> Bool)
-> (RTextLabel -> RTextLabel -> Bool)
-> (RTextLabel -> RTextLabel -> Bool)
-> (RTextLabel -> RTextLabel -> Bool)
-> (RTextLabel -> RTextLabel -> RTextLabel)
-> (RTextLabel -> RTextLabel -> RTextLabel)
-> Ord RTextLabel
RTextLabel -> RTextLabel -> Bool
RTextLabel -> RTextLabel -> Ordering
RTextLabel -> RTextLabel -> RTextLabel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RTextLabel -> RTextLabel -> RTextLabel
$cmin :: RTextLabel -> RTextLabel -> RTextLabel
max :: RTextLabel -> RTextLabel -> RTextLabel
$cmax :: RTextLabel -> RTextLabel -> RTextLabel
>= :: RTextLabel -> RTextLabel -> Bool
$c>= :: RTextLabel -> RTextLabel -> Bool
> :: RTextLabel -> RTextLabel -> Bool
$c> :: RTextLabel -> RTextLabel -> Bool
<= :: RTextLabel -> RTextLabel -> Bool
$c<= :: RTextLabel -> RTextLabel -> Bool
< :: RTextLabel -> RTextLabel -> Bool
$c< :: RTextLabel -> RTextLabel -> Bool
compare :: RTextLabel -> RTextLabel -> Ordering
$ccompare :: RTextLabel -> RTextLabel -> Ordering
$cp1Ord :: Eq RTextLabel
Ord, Typeable RTextLabel
DataType
Constr
Typeable RTextLabel
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> RTextLabel -> c RTextLabel)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RTextLabel)
-> (RTextLabel -> Constr)
-> (RTextLabel -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RTextLabel))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RTextLabel))
-> ((forall b. Data b => b -> b) -> RTextLabel -> RTextLabel)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RTextLabel -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RTextLabel -> r)
-> (forall u. (forall d. Data d => d -> u) -> RTextLabel -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RTextLabel -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RTextLabel -> m RTextLabel)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RTextLabel -> m RTextLabel)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RTextLabel -> m RTextLabel)
-> Data RTextLabel
RTextLabel -> DataType
RTextLabel -> Constr
(forall b. Data b => b -> b) -> RTextLabel -> RTextLabel
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RTextLabel -> c RTextLabel
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RTextLabel
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RTextLabel -> u
forall u. (forall d. Data d => d -> u) -> RTextLabel -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RTextLabel -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RTextLabel -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RTextLabel -> m RTextLabel
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RTextLabel -> m RTextLabel
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RTextLabel
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RTextLabel -> c RTextLabel
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RTextLabel)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RTextLabel)
$cFragment :: Constr
$cQueryValue :: Constr
$cQueryKey :: Constr
$cPathPiece :: Constr
$cPassword :: Constr
$cUsername :: Constr
$cHost :: Constr
$cScheme :: Constr
$tRTextLabel :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> RTextLabel -> m RTextLabel
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RTextLabel -> m RTextLabel
gmapMp :: (forall d. Data d => d -> m d) -> RTextLabel -> m RTextLabel
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RTextLabel -> m RTextLabel
gmapM :: (forall d. Data d => d -> m d) -> RTextLabel -> m RTextLabel
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RTextLabel -> m RTextLabel
gmapQi :: Int -> (forall d. Data d => d -> u) -> RTextLabel -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RTextLabel -> u
gmapQ :: (forall d. Data d => d -> u) -> RTextLabel -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RTextLabel -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RTextLabel -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RTextLabel -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RTextLabel -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RTextLabel -> r
gmapT :: (forall b. Data b => b -> b) -> RTextLabel -> RTextLabel
$cgmapT :: (forall b. Data b => b -> b) -> RTextLabel -> RTextLabel
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RTextLabel)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RTextLabel)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RTextLabel)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RTextLabel)
dataTypeOf :: RTextLabel -> DataType
$cdataTypeOf :: RTextLabel -> DataType
toConstr :: RTextLabel -> Constr
$ctoConstr :: RTextLabel -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RTextLabel
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RTextLabel
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RTextLabel -> c RTextLabel
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RTextLabel -> c RTextLabel
$cp1Data :: Typeable RTextLabel
Data, Typeable, (forall x. RTextLabel -> Rep RTextLabel x)
-> (forall x. Rep RTextLabel x -> RTextLabel) -> Generic RTextLabel
forall x. Rep RTextLabel x -> RTextLabel
forall x. RTextLabel -> Rep RTextLabel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RTextLabel x -> RTextLabel
$cfrom :: forall x. RTextLabel -> Rep RTextLabel x
Generic)

-- | This type class associates checking, normalization, and a term level
-- label with a label on the type level.
--
-- We would like to have a closed type class here, and so we achieve almost
-- that by not exporting 'RLabel' and 'mkRText' (only specialized helpers
-- like 'mkScheme').
class RLabel (l :: RTextLabel) where
  rcheck :: Proxy l -> Text -> Bool
  rnormalize :: Proxy l -> Text -> Text
  rlabel :: Proxy l -> RTextLabel

-- | Construct a refined text value.
mkRText :: forall m l. (MonadThrow m, RLabel l) => Text -> m (RText l)
mkRText :: Text -> m (RText l)
mkRText Text
txt =
  if Proxy l -> Text -> Bool
forall (l :: RTextLabel). RLabel l => Proxy l -> Text -> Bool
rcheck Proxy l
lproxy Text
txt
    then RText l -> m (RText l)
forall (m :: * -> *) a. Monad m => a -> m a
return (RText l -> m (RText l))
-> (Text -> RText l) -> Text -> m (RText l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> RText l
forall (l :: RTextLabel). Text -> RText l
RText (Text -> m (RText l)) -> Text -> m (RText l)
forall a b. (a -> b) -> a -> b
$ Proxy l -> Text -> Text
forall (l :: RTextLabel). RLabel l => Proxy l -> Text -> Text
rnormalize Proxy l
lproxy Text
txt
    else RTextException -> m (RText l)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (RTextLabel -> Text -> RTextException
RTextException (Proxy l -> RTextLabel
forall (l :: RTextLabel). RLabel l => Proxy l -> RTextLabel
rlabel Proxy l
lproxy) Text
txt)
  where
    lproxy :: Proxy l
lproxy = Proxy l
forall k (t :: k). Proxy t
Proxy :: Proxy l

-- | Lift a 'Text' value into @'RText' 'Scheme'@.
--
-- Scheme names consist of a sequence of characters beginning with a letter
-- and followed by any combination of letters, digits, plus @\"+\"@, period
-- @\".\"@, or hyphen @\"-\"@.
--
-- This smart constructor performs normalization of valid schemes by
-- converting them to lower case.
--
-- See also: <https://tools.ietf.org/html/rfc3986#section-3.1>
mkScheme :: MonadThrow m => Text -> m (RText 'Scheme)
mkScheme :: Text -> m (RText 'Scheme)
mkScheme = Text -> m (RText 'Scheme)
forall (m :: * -> *) (l :: RTextLabel).
(MonadThrow m, RLabel l) =>
Text -> m (RText l)
mkRText

instance RLabel 'Scheme where
  rcheck :: Proxy 'Scheme -> Text -> Bool
rcheck Proxy 'Scheme
Proxy = Parsec Void Text () -> Text -> Bool
ifMatches (Parsec Void Text () -> Text -> Bool)
-> Parsec Void Text () -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ do
    ParsecT Void Text Identity Char -> Parsec Void Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Char -> Parsec Void Text ())
-> ((Char -> Bool) -> ParsecT Void Text Identity Char)
-> (Char -> Bool)
-> Parsec Void Text ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ParsecT Void Text Identity Char
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy ((Char -> Bool) -> Parsec Void Text ())
-> (Char -> Bool) -> Parsec Void Text ()
forall a b. (a -> b) -> a -> b
$ \Char
x ->
      Char -> Bool
isAscii Char
x Bool -> Bool -> Bool
&& Char -> Bool
isAlpha Char
x
    ParsecT Void Text Identity Char -> Parsec Void Text ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany (ParsecT Void Text Identity Char -> Parsec Void Text ())
-> ((Char -> Bool) -> ParsecT Void Text Identity Char)
-> (Char -> Bool)
-> Parsec Void Text ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ParsecT Void Text Identity Char
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy ((Char -> Bool) -> Parsec Void Text ())
-> (Char -> Bool) -> Parsec Void Text ()
forall a b. (a -> b) -> a -> b
$ \Char
x ->
      Char -> Bool
isAscii Char
x Bool -> Bool -> Bool
&& Char -> Bool
isAlphaNum Char
x Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'
  rnormalize :: Proxy 'Scheme -> Text -> Text
rnormalize Proxy 'Scheme
Proxy = Text -> Text
T.toLower
  rlabel :: Proxy 'Scheme -> RTextLabel
rlabel Proxy 'Scheme
Proxy = RTextLabel
Scheme

instance Arbitrary (RText 'Scheme) where
  arbitrary :: Gen (RText 'Scheme)
arbitrary = Gen (RText 'Scheme)
arbScheme

-- | Lift a 'Text' value into @'RText' 'Host'@.
--
-- The host sub-component of authority is identified by an IP literal
-- encapsulated within square brackets, an IPv4 address in dotted-decimal
-- form, or a registered name.
--
-- This smart constructor performs normalization of valid hosts by
-- converting them to lower case.
--
-- See also: <https://tools.ietf.org/html/rfc3986#section-3.2.2>
mkHost :: MonadThrow m => Text -> m (RText 'Host)
mkHost :: Text -> m (RText 'Host)
mkHost = Text -> m (RText 'Host)
forall (m :: * -> *) (l :: RTextLabel).
(MonadThrow m, RLabel l) =>
Text -> m (RText l)
mkRText

instance RLabel 'Host where
  rcheck :: Proxy 'Host -> Text -> Bool
rcheck Proxy 'Host
Proxy = (Parsec Void Text () -> Text -> Bool
ifMatches (Parsec Void Text () -> Text -> Bool)
-> (Bool -> Parsec Void Text ()) -> Bool -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void Text Identity String -> Parsec Void Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity String -> Parsec Void Text ())
-> (Bool -> ParsecT Void Text Identity String)
-> Bool
-> Parsec Void Text ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ParsecT Void Text Identity String
forall e (m :: * -> *). MonadParsec e Text m => Bool -> m String
pHost) Bool
False
  rnormalize :: Proxy 'Host -> Text -> Text
rnormalize Proxy 'Host
Proxy = Text -> Text
T.toLower
  rlabel :: Proxy 'Host -> RTextLabel
rlabel Proxy 'Host
Proxy = RTextLabel
Host

instance Arbitrary (RText 'Host) where
  arbitrary :: Gen (RText 'Host)
arbitrary = Gen (RText 'Host)
arbHost

-- | Lift a 'Text' value into @'RText' 'Username'@.
--
-- This smart constructor does not perform any sort of normalization.
--
-- See also: <https://tools.ietf.org/html/rfc3986#section-3.2.1>
mkUsername :: MonadThrow m => Text -> m (RText 'Username)
mkUsername :: Text -> m (RText 'Username)
mkUsername = Text -> m (RText 'Username)
forall (m :: * -> *) (l :: RTextLabel).
(MonadThrow m, RLabel l) =>
Text -> m (RText l)
mkRText

instance RLabel 'Username where
  rcheck :: Proxy 'Username -> Text -> Bool
rcheck Proxy 'Username
Proxy = Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null
  rnormalize :: Proxy 'Username -> Text -> Text
rnormalize Proxy 'Username
Proxy = Text -> Text
forall a. a -> a
id
  rlabel :: Proxy 'Username -> RTextLabel
rlabel Proxy 'Username
Proxy = RTextLabel
Username

instance Arbitrary (RText 'Username) where
  arbitrary :: Gen (RText 'Username)
arbitrary = (Text -> Maybe (RText 'Username)) -> Gen (RText 'Username)
forall (l :: RTextLabel).
(Text -> Maybe (RText l)) -> Gen (RText l)
arbText' Text -> Maybe (RText 'Username)
forall (m :: * -> *). MonadThrow m => Text -> m (RText 'Username)
mkUsername

-- | Lift a 'Text' value into @'RText' 'Password'@.
--
-- This smart constructor does not perform any sort of normalization.
--
-- See also: <https://tools.ietf.org/html/rfc3986#section-3.2.1>
mkPassword :: MonadThrow m => Text -> m (RText 'Password)
mkPassword :: Text -> m (RText 'Password)
mkPassword = Text -> m (RText 'Password)
forall (m :: * -> *) (l :: RTextLabel).
(MonadThrow m, RLabel l) =>
Text -> m (RText l)
mkRText

instance RLabel 'Password where
  rcheck :: Proxy 'Password -> Text -> Bool
rcheck Proxy 'Password
Proxy = Bool -> Text -> Bool
forall a b. a -> b -> a
const Bool
True
  rnormalize :: Proxy 'Password -> Text -> Text
rnormalize Proxy 'Password
Proxy = Text -> Text
forall a. a -> a
id
  rlabel :: Proxy 'Password -> RTextLabel
rlabel Proxy 'Password
Proxy = RTextLabel
Password

instance Arbitrary (RText 'Password) where
  arbitrary :: Gen (RText 'Password)
arbitrary = (Text -> Maybe (RText 'Password)) -> Gen (RText 'Password)
forall (l :: RTextLabel).
(Text -> Maybe (RText l)) -> Gen (RText l)
arbText Text -> Maybe (RText 'Password)
forall (m :: * -> *). MonadThrow m => Text -> m (RText 'Password)
mkPassword

-- | Lift a 'Text' value into @'RText' 'PathPiece'@.
--
-- This smart constructor does not perform any sort of normalization.
--
-- See also: <https://tools.ietf.org/html/rfc3986#section-3.3>
mkPathPiece :: MonadThrow m => Text -> m (RText 'PathPiece)
mkPathPiece :: Text -> m (RText 'PathPiece)
mkPathPiece = Text -> m (RText 'PathPiece)
forall (m :: * -> *) (l :: RTextLabel).
(MonadThrow m, RLabel l) =>
Text -> m (RText l)
mkRText

instance RLabel 'PathPiece where
  rcheck :: Proxy 'PathPiece -> Text -> Bool
rcheck Proxy 'PathPiece
Proxy = Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null
  rnormalize :: Proxy 'PathPiece -> Text -> Text
rnormalize Proxy 'PathPiece
Proxy = Text -> Text
forall a. a -> a
id
  rlabel :: Proxy 'PathPiece -> RTextLabel
rlabel Proxy 'PathPiece
Proxy = RTextLabel
PathPiece

instance Arbitrary (RText 'PathPiece) where
  arbitrary :: Gen (RText 'PathPiece)
arbitrary = (Text -> Maybe (RText 'PathPiece)) -> Gen (RText 'PathPiece)
forall (l :: RTextLabel).
(Text -> Maybe (RText l)) -> Gen (RText l)
arbText' Text -> Maybe (RText 'PathPiece)
forall (m :: * -> *). MonadThrow m => Text -> m (RText 'PathPiece)
mkPathPiece

-- | Lift a 'Text' value into @'RText 'QueryKey'@.
--
-- This smart constructor does not perform any sort of normalization.
--
-- See also: <https://tools.ietf.org/html/rfc3986#section-3.4>
mkQueryKey :: MonadThrow m => Text -> m (RText 'QueryKey)
mkQueryKey :: Text -> m (RText 'QueryKey)
mkQueryKey = Text -> m (RText 'QueryKey)
forall (m :: * -> *) (l :: RTextLabel).
(MonadThrow m, RLabel l) =>
Text -> m (RText l)
mkRText

instance RLabel 'QueryKey where
  rcheck :: Proxy 'QueryKey -> Text -> Bool
rcheck Proxy 'QueryKey
Proxy = Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null
  rnormalize :: Proxy 'QueryKey -> Text -> Text
rnormalize Proxy 'QueryKey
Proxy = Text -> Text
forall a. a -> a
id
  rlabel :: Proxy 'QueryKey -> RTextLabel
rlabel Proxy 'QueryKey
Proxy = RTextLabel
QueryKey

instance Arbitrary (RText 'QueryKey) where
  arbitrary :: Gen (RText 'QueryKey)
arbitrary = (Text -> Maybe (RText 'QueryKey)) -> Gen (RText 'QueryKey)
forall (l :: RTextLabel).
(Text -> Maybe (RText l)) -> Gen (RText l)
arbText' Text -> Maybe (RText 'QueryKey)
forall (m :: * -> *). MonadThrow m => Text -> m (RText 'QueryKey)
mkQueryKey

-- | Lift a 'Text' value into @'RText' 'QueryValue'@.
--
-- This smart constructor does not perform any sort of normalization.
--
-- See also: <https://tools.ietf.org/html/rfc3986#section-3.4>
mkQueryValue :: MonadThrow m => Text -> m (RText 'QueryValue)
mkQueryValue :: Text -> m (RText 'QueryValue)
mkQueryValue = Text -> m (RText 'QueryValue)
forall (m :: * -> *) (l :: RTextLabel).
(MonadThrow m, RLabel l) =>
Text -> m (RText l)
mkRText

instance RLabel 'QueryValue where
  rcheck :: Proxy 'QueryValue -> Text -> Bool
rcheck Proxy 'QueryValue
Proxy = Bool -> Text -> Bool
forall a b. a -> b -> a
const Bool
True
  rnormalize :: Proxy 'QueryValue -> Text -> Text
rnormalize Proxy 'QueryValue
Proxy = Text -> Text
forall a. a -> a
id
  rlabel :: Proxy 'QueryValue -> RTextLabel
rlabel Proxy 'QueryValue
Proxy = RTextLabel
QueryValue

instance Arbitrary (RText 'QueryValue) where
  arbitrary :: Gen (RText 'QueryValue)
arbitrary = (Text -> Maybe (RText 'QueryValue)) -> Gen (RText 'QueryValue)
forall (l :: RTextLabel).
(Text -> Maybe (RText l)) -> Gen (RText l)
arbText Text -> Maybe (RText 'QueryValue)
forall (m :: * -> *). MonadThrow m => Text -> m (RText 'QueryValue)
mkQueryValue

-- | Lift a 'Text' value into @'RText' 'Fragment'@.
--
-- This smart constructor does not perform any sort of normalization.
--
-- See also: <https://tools.ietf.org/html/rfc3986#section-3.5>
mkFragment :: MonadThrow m => Text -> m (RText 'Fragment)
mkFragment :: Text -> m (RText 'Fragment)
mkFragment = Text -> m (RText 'Fragment)
forall (m :: * -> *) (l :: RTextLabel).
(MonadThrow m, RLabel l) =>
Text -> m (RText l)
mkRText

instance RLabel 'Fragment where
  rcheck :: Proxy 'Fragment -> Text -> Bool
rcheck Proxy 'Fragment
Proxy = Bool -> Text -> Bool
forall a b. a -> b -> a
const Bool
True
  rnormalize :: Proxy 'Fragment -> Text -> Text
rnormalize Proxy 'Fragment
Proxy = Text -> Text
forall a. a -> a
id
  rlabel :: Proxy 'Fragment -> RTextLabel
rlabel Proxy 'Fragment
Proxy = RTextLabel
Fragment

instance Arbitrary (RText 'Fragment) where
  arbitrary :: Gen (RText 'Fragment)
arbitrary = (Text -> Maybe (RText 'Fragment)) -> Gen (RText 'Fragment)
forall (l :: RTextLabel).
(Text -> Maybe (RText l)) -> Gen (RText l)
arbText Text -> Maybe (RText 'Fragment)
forall (m :: * -> *). MonadThrow m => Text -> m (RText 'Fragment)
mkFragment

-- | Project a plain strict 'Text' value from a refined @'RText' l@ value.
unRText :: RText l -> Text
unRText :: RText l -> Text
unRText (RText Text
txt) = Text
txt

-- | The exception is thrown when a refined @'RText' l@ value cannot be
-- constructed due to the fact that given 'Text' value is not correct.
data RTextException
  = -- | 'RTextLabel' identifying what sort of refined text value could not be
    -- constructed and the input that was supplied, as a 'Text' value
    RTextException RTextLabel Text
  deriving (Int -> RTextException -> ShowS
[RTextException] -> ShowS
RTextException -> String
(Int -> RTextException -> ShowS)
-> (RTextException -> String)
-> ([RTextException] -> ShowS)
-> Show RTextException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RTextException] -> ShowS
$cshowList :: [RTextException] -> ShowS
show :: RTextException -> String
$cshow :: RTextException -> String
showsPrec :: Int -> RTextException -> ShowS
$cshowsPrec :: Int -> RTextException -> ShowS
Show, RTextException -> RTextException -> Bool
(RTextException -> RTextException -> Bool)
-> (RTextException -> RTextException -> Bool) -> Eq RTextException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RTextException -> RTextException -> Bool
$c/= :: RTextException -> RTextException -> Bool
== :: RTextException -> RTextException -> Bool
$c== :: RTextException -> RTextException -> Bool
Eq, Eq RTextException
Eq RTextException
-> (RTextException -> RTextException -> Ordering)
-> (RTextException -> RTextException -> Bool)
-> (RTextException -> RTextException -> Bool)
-> (RTextException -> RTextException -> Bool)
-> (RTextException -> RTextException -> Bool)
-> (RTextException -> RTextException -> RTextException)
-> (RTextException -> RTextException -> RTextException)
-> Ord RTextException
RTextException -> RTextException -> Bool
RTextException -> RTextException -> Ordering
RTextException -> RTextException -> RTextException
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RTextException -> RTextException -> RTextException
$cmin :: RTextException -> RTextException -> RTextException
max :: RTextException -> RTextException -> RTextException
$cmax :: RTextException -> RTextException -> RTextException
>= :: RTextException -> RTextException -> Bool
$c>= :: RTextException -> RTextException -> Bool
> :: RTextException -> RTextException -> Bool
$c> :: RTextException -> RTextException -> Bool
<= :: RTextException -> RTextException -> Bool
$c<= :: RTextException -> RTextException -> Bool
< :: RTextException -> RTextException -> Bool
$c< :: RTextException -> RTextException -> Bool
compare :: RTextException -> RTextException -> Ordering
$ccompare :: RTextException -> RTextException -> Ordering
$cp1Ord :: Eq RTextException
Ord, Typeable RTextException
DataType
Constr
Typeable RTextException
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> RTextException -> c RTextException)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RTextException)
-> (RTextException -> Constr)
-> (RTextException -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RTextException))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RTextException))
-> ((forall b. Data b => b -> b)
    -> RTextException -> RTextException)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RTextException -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RTextException -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> RTextException -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RTextException -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RTextException -> m RTextException)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RTextException -> m RTextException)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RTextException -> m RTextException)
-> Data RTextException
RTextException -> DataType
RTextException -> Constr
(forall b. Data b => b -> b) -> RTextException -> RTextException
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RTextException -> c RTextException
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RTextException
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> RTextException -> u
forall u. (forall d. Data d => d -> u) -> RTextException -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RTextException -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RTextException -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RTextException -> m RTextException
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RTextException -> m RTextException
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RTextException
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RTextException -> c RTextException
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RTextException)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RTextException)
$cRTextException :: Constr
$tRTextException :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> RTextException -> m RTextException
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RTextException -> m RTextException
gmapMp :: (forall d. Data d => d -> m d)
-> RTextException -> m RTextException
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RTextException -> m RTextException
gmapM :: (forall d. Data d => d -> m d)
-> RTextException -> m RTextException
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RTextException -> m RTextException
gmapQi :: Int -> (forall d. Data d => d -> u) -> RTextException -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RTextException -> u
gmapQ :: (forall d. Data d => d -> u) -> RTextException -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RTextException -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RTextException -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RTextException -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RTextException -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RTextException -> r
gmapT :: (forall b. Data b => b -> b) -> RTextException -> RTextException
$cgmapT :: (forall b. Data b => b -> b) -> RTextException -> RTextException
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RTextException)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RTextException)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RTextException)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RTextException)
dataTypeOf :: RTextException -> DataType
$cdataTypeOf :: RTextException -> DataType
toConstr :: RTextException -> Constr
$ctoConstr :: RTextException -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RTextException
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RTextException
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RTextException -> c RTextException
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RTextException -> c RTextException
$cp1Data :: Typeable RTextException
Data, Typeable, (forall x. RTextException -> Rep RTextException x)
-> (forall x. Rep RTextException x -> RTextException)
-> Generic RTextException
forall x. Rep RTextException x -> RTextException
forall x. RTextException -> Rep RTextException x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RTextException x -> RTextException
$cfrom :: forall x. RTextException -> Rep RTextException x
Generic)

instance Exception RTextException where
  displayException :: RTextException -> String
displayException (RTextException RTextLabel
lbl Text
txt) =
    String
"The value \""
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
txt
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\" could not be lifted into a "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ RTextLabel -> String
forall a. Show a => a -> String
show RTextLabel
lbl

----------------------------------------------------------------------------
-- Parser helpers

-- | Return 'True' if given parser can consume 'Text' in its entirety.
ifMatches :: Parsec Void Text () -> Text -> Bool
ifMatches :: Parsec Void Text () -> Text -> Bool
ifMatches Parsec Void Text ()
p = Maybe () -> Bool
forall a. Maybe a -> Bool
isJust (Maybe () -> Bool) -> (Text -> Maybe ()) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void Text () -> Text -> Maybe ()
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe Parsec Void Text ()
p

----------------------------------------------------------------------------
-- Arbitrary helpers

-- | Generator of 'Arbitrary' schemes.
arbScheme :: Gen (RText 'Scheme)
arbScheme :: Gen (RText 'Scheme)
arbScheme = do
  let g :: Gen Char
g = [Gen Char] -> Gen Char
forall a. [Gen a] -> Gen a
oneof [(Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
choose (Char
'a', Char
'z'), (Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
choose (Char
'A', Char
'Z')]
  Char
x <- Gen Char
g
  String
xs <-
    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
$
      [(Int, Gen Char)] -> Gen Char
forall a. [(Int, Gen a)] -> Gen a
frequency [(Int
3, Gen Char
g), (Int
1, (Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
choose (Char
'0', Char
'9'))]
  RText 'Scheme -> Gen (RText 'Scheme)
forall (m :: * -> *) a. Monad m => a -> m a
return (RText 'Scheme -> Gen (RText 'Scheme))
-> (String -> RText 'Scheme) -> String -> Gen (RText 'Scheme)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (RText 'Scheme) -> RText 'Scheme
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (RText 'Scheme) -> RText 'Scheme)
-> (String -> Maybe (RText 'Scheme)) -> String -> RText 'Scheme
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (RText 'Scheme)
forall (m :: * -> *). MonadThrow m => Text -> m (RText 'Scheme)
mkScheme (Text -> Maybe (RText 'Scheme))
-> (String -> Text) -> String -> Maybe (RText 'Scheme)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Gen (RText 'Scheme)) -> String -> Gen (RText 'Scheme)
forall a b. (a -> b) -> a -> b
$ Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs

-- | Generator of 'Arbitrary' hosts.
arbHost :: Gen (RText 'Host)
arbHost :: Gen (RText 'Host)
arbHost =
  Maybe (RText 'Host) -> RText 'Host
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (RText 'Host) -> RText 'Host)
-> (String -> Maybe (RText 'Host)) -> String -> RText 'Host
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (RText 'Host)
forall (m :: * -> *). MonadThrow m => Text -> m (RText 'Host)
mkHost (Text -> Maybe (RText 'Host))
-> (String -> Text) -> String -> Maybe (RText 'Host)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
    (String -> RText 'Host) -> Gen String -> Gen (RText 'Host)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, Gen String)] -> Gen String
forall a. [(Int, Gen a)] -> Gen a
frequency
      [ (Int
1, Gen String
ipLiteral),
        (Int
2, Gen String
ipv4Address),
        (Int
4, Gen String
regName),
        (Int
1, String -> Gen String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"")
      ]
  where
    ipLiteral :: Gen String
ipLiteral = do
      String
xs <- [Gen String] -> Gen String
forall a. [Gen a] -> Gen a
oneof [Gen String
ipv6Address, Gen String
ipvFuture]
      String -> Gen String
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
xs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]")
    ipv6Address :: Gen String
ipv6Address =
      -- NOTE We do not mess with zeroes here, because it's a hairy stuff.
      -- We test how we handle :: thing manually in the test suite.
      String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
":" ([String] -> String)
-> ([Word16] -> [String]) -> [Word16] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word16 -> String) -> [Word16] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word16 -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
`showHex` String
"")
        ([Word16] -> String) -> Gen [Word16] -> Gen String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word16 -> Gen [Word16]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
8 (Gen Word16
forall a. Arbitrary a => Gen a
arbitrary :: Gen Word16)
    ipv4Address :: Gen String
ipv4Address =
      String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." ([String] -> String) -> ([Word8] -> [String]) -> [Word8] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> String) -> [Word8] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word8 -> ShowS
forall a. Integral a => a -> ShowS
`showInt` String
"")
        ([Word8] -> String) -> Gen [Word8] -> Gen String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
4 (Gen Word8
forall a. Arbitrary a => Gen a
arbitrary :: Gen Word8)
    ipvFuture :: Gen String
ipvFuture = do
      Char
v <- [Gen Char] -> Gen Char
forall a. [Gen a] -> Gen a
oneof [(Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
choose (Char
'0', Char
'9'), (Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
choose (Char
'a', Char
'f')]
      String
xs <-
        Gen Char -> Gen String
forall a. Gen a -> Gen [a]
listOf1 (Gen Char -> Gen String) -> Gen Char -> Gen String
forall a b. (a -> b) -> a -> b
$
          [(Int, Gen Char)] -> Gen Char
forall a. [(Int, Gen a)] -> Gen a
frequency
            [ (Int
3, (Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
choose (Char
'a', Char
'z')),
              (Int
3, (Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
choose (Char
'A', Char
'Z')),
              (Int
2, (Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
choose (Char
'0', Char
'9')),
              (Int
2, String -> Gen Char
forall a. [a] -> Gen a
elements String
"-._~!$&'()*+,;=:")
            ]
      String -> Gen String
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"v" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
v] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
xs)
    domainLabel :: Gen String
domainLabel = do
      let g :: Gen Char
g = Gen Char
forall a. Arbitrary a => Gen a
arbitrary Gen Char -> (Char -> Bool) -> Gen Char
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` Char -> Bool
isAlphaNum
      Char
x <- Gen Char
g
      String
xs <-
        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
$
          [(Int, Gen Char)] -> Gen Char
forall a. [(Int, Gen a)] -> Gen a
frequency [(Int
3, Gen Char
g), (Int
1, Char -> Gen Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'-')]
      Char
x' <- Gen Char
g
      String -> Gen String
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char
x] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
xs String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
x'])
    regName :: Gen String
regName = 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 a. Int -> Gen a -> Gen a
resize Int
5 (Gen String -> Gen [String]
forall a. Gen a -> Gen [a]
listOf1 Gen String
domainLabel)

-- | Make generator for refined text given how to lift a possibly empty
-- arbitrary 'Text' value into a refined type.
arbText :: (Text -> Maybe (RText l)) -> Gen (RText l)
arbText :: (Text -> Maybe (RText l)) -> Gen (RText l)
arbText Text -> Maybe (RText l)
f = Maybe (RText l) -> RText l
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (RText l) -> RText l)
-> (String -> Maybe (RText l)) -> String -> RText l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (RText l)
f (Text -> Maybe (RText l))
-> (String -> Text) -> String -> Maybe (RText l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> RText l) -> Gen String -> Gen (RText l)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Char -> Gen String
forall a. Gen a -> Gen [a]
listOf Gen Char
forall a. Arbitrary a => Gen a
arbitrary

-- | Like 'arbText'', but the lifting function will be given non-empty
-- arbitrary 'Text' value.
arbText' :: (Text -> Maybe (RText l)) -> Gen (RText l)
arbText' :: (Text -> Maybe (RText l)) -> Gen (RText l)
arbText' Text -> Maybe (RText l)
f = Maybe (RText l) -> RText l
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (RText l) -> RText l)
-> (String -> Maybe (RText l)) -> String -> RText l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (RText l)
f (Text -> Maybe (RText l))
-> (String -> Text) -> String -> Maybe (RText l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> RText l) -> Gen String -> Gen (RText l)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Char -> Gen String
forall a. Gen a -> Gen [a]
listOf1 Gen Char
forall a. Arbitrary a => Gen a
arbitrary

----------------------------------------------------------------------------
-- TH lifting helpers

liftData

#if MIN_VERSION_template_haskell(2,17,0)
  :: (Data a, TH.Quote m) => a -> m TH.Exp
#else
  :: Data a => a -> TH.Q TH.Exp
#endif
liftData :: a -> Q Exp
liftData = (forall b. Data b => b -> Maybe (Q Exp)) -> a -> Q Exp
forall a.
Data a =>
(forall b. Data b => b -> Maybe (Q Exp)) -> a -> Q Exp
TH.dataToExpQ ((Text -> Q Exp) -> Maybe Text -> Maybe (Q Exp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Q Exp
liftText (Maybe Text -> Maybe (Q Exp))
-> (b -> Maybe Text) -> b -> Maybe (Q Exp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe Text
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast)

liftText

#if MIN_VERSION_template_haskell(2,17,0)
  :: TH.Quote m => Text -> m TH.Exp
#else
  :: Text -> TH.Q TH.Exp
#endif
liftText :: Text -> Q Exp
liftText Text
t = Exp -> Exp -> Exp
TH.AppE (Name -> Exp
TH.VarE 'T.pack) (Exp -> Exp) -> Q Exp -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Q Exp
forall t. Lift t => t -> Q Exp
TH.lift (Text -> String
T.unpack Text
t)