{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# 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.Hashable (Hashable)
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
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
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
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
Ord, Typeable URI
URI -> DataType
URI -> Constr
(forall b. Data b => b -> b) -> URI -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> URI -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> URI -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> URI -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> URI -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, Typeable, 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)

-- | @since 0.3.5.0
instance Hashable URI

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
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( do
              Maybe (NonEmpty (RText 'PathPiece))
mpieces <- forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
              Bool
trailingSlash <- forall a. Arbitrary a => Gen a
arbitrary
              forall (m :: * -> *) a. Monad m => a -> m a
return ((Bool
trailingSlash,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (NonEmpty (RText 'PathPiece))
mpieces)
          )
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary

instance NFData URI

-- | @since 0.3.1.0
instance TH.Lift URI where
  lift :: forall (m :: * -> *). Quote m => URI -> m Exp
lift = forall a (m :: * -> *). (Data a, Quote m) => a -> m Exp
liftData
  liftTyped :: forall (m :: * -> *). Quote m => URI -> Code m URI
liftTyped = forall (m :: * -> *) a. m (TExp a) -> Code m a
TH.Code forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). Quote m => m Exp -> m (TExp a)
TH.unsafeTExpCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
TH.lift

-- | 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
    { uriScheme :: Maybe (RText 'Scheme)
uriScheme = forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 = forall a b. a -> Either a b -> a
fromLeft Bool
True 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
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
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
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
Ord, Typeable Authority
Authority -> DataType
Authority -> Constr
(forall b. Data b => b -> b) -> Authority -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> Authority -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Authority -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Authority -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Authority -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, Typeable, 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)

-- | @since 0.3.5.0
instance Hashable Authority

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

instance NFData Authority

-- | @since 0.3.1.0
instance TH.Lift Authority where
  lift :: forall (m :: * -> *). Quote m => Authority -> m Exp
lift = forall a (m :: * -> *). (Data a, Quote m) => a -> m Exp
liftData
  liftTyped :: forall (m :: * -> *). Quote m => Authority -> Code m Authority
liftTyped = forall (m :: * -> *) a. m (TExp a) -> Code m a
TH.Code forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). Quote m => m Exp -> m (TExp a)
TH.unsafeTExpCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
TH.lift

-- | 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
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
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
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
Ord, Typeable UserInfo
UserInfo -> DataType
UserInfo -> Constr
(forall b. Data b => b -> b) -> UserInfo -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> UserInfo -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UserInfo -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> UserInfo -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UserInfo -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, Typeable, 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)

-- | @since 0.3.5.0
instance Hashable UserInfo

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

instance NFData UserInfo

-- | @since 0.3.1.0
instance TH.Lift UserInfo where
  lift :: forall (m :: * -> *). Quote m => UserInfo -> m Exp
lift = forall a (m :: * -> *). (Data a, Quote m) => a -> m Exp
liftData
  liftTyped :: forall (m :: * -> *). Quote m => UserInfo -> Code m UserInfo
liftTyped = forall (m :: * -> *) a. m (TExp a) -> Code m a
TH.Code forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). Quote m => m Exp -> m (TExp a)
TH.unsafeTExpCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
TH.lift

-- | 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
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
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
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
Ord, Typeable QueryParam
QueryParam -> DataType
QueryParam -> Constr
(forall b. Data b => b -> b) -> QueryParam -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> QueryParam -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> QueryParam -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> QueryParam -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> QueryParam -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, Typeable, 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)

-- | @since 0.3.5.0
instance Hashable QueryParam

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

instance NFData QueryParam

-- | @since 0.3.1.0
instance TH.Lift QueryParam where
  lift :: forall (m :: * -> *). Quote m => QueryParam -> m Exp
lift = forall a (m :: * -> *). (Data a, Quote m) => a -> m Exp
liftData
  liftTyped :: forall (m :: * -> *). Quote m => QueryParam -> Code m QueryParam
liftTyped = forall (m :: * -> *) a. m (TExp a) -> Code m a
TH.Code forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). Quote m => m Exp -> m (TExp a)
TH.unsafeTExpCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
TH.lift

-- | 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
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
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
ParseException -> DataType
ParseException -> Constr
(forall b. Data b => b -> b) -> ParseException -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u.
Int -> (forall d. Data d => d -> u) -> ParseException -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ParseException -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ParseException -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ParseException -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, Typeable, 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) = 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
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
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
ParseExceptionBs -> DataType
ParseExceptionBs -> Constr
(forall b. Data b => b -> b)
-> ParseExceptionBs -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u.
Int -> (forall d. Data d => d -> u) -> ParseExceptionBs -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ParseExceptionBs -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ParseExceptionBs -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ParseExceptionBs -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, Typeable, 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) = 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
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, 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
Ord, RText l -> DataType
RText l -> Constr
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 {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 (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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. 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 u. (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 :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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)
Data, Typeable, 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)

-- | @since 0.3.5.0
instance Hashable (RText l)

instance Show (RText l) where
  show :: RText l -> String
show (RText Text
txt) = 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 :: forall (m :: * -> *). Quote m => RText l -> m Exp
lift = forall a (m :: * -> *). (Data a, Quote m) => a -> m Exp
liftData
  liftTyped :: forall (m :: * -> *). Quote m => RText l -> Code m (RText l)
liftTyped = forall (m :: * -> *) a. m (TExp a) -> Code m a
TH.Code forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). Quote m => m Exp -> m (TExp a)
TH.unsafeTExpCoerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
TH.lift

-- | 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
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
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
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
Ord, Typeable RTextLabel
RTextLabel -> DataType
RTextLabel -> Constr
(forall b. Data b => b -> b) -> RTextLabel -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> RTextLabel -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RTextLabel -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> RTextLabel -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RTextLabel -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, Typeable, 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 :: forall (m :: * -> *) (l :: RTextLabel).
(MonadThrow m, RLabel l) =>
Text -> m (RText l)
mkRText Text
txt =
  if forall (l :: RTextLabel). RLabel l => Proxy l -> Text -> Bool
rcheck Proxy l
lproxy Text
txt
    then forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: RTextLabel). Text -> RText l
RText forall a b. (a -> b) -> a -> b
$ forall (l :: RTextLabel). RLabel l => Proxy l -> Text -> Text
rnormalize Proxy l
lproxy Text
txt
    else forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (RTextLabel -> Text -> RTextException
RTextException (forall (l :: RTextLabel). RLabel l => Proxy l -> RTextLabel
rlabel Proxy l
lproxy) Text
txt)
  where
    lproxy :: Proxy l
lproxy = 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 :: forall (m :: * -> *). MonadThrow m => Text -> m (RText 'Scheme)
mkScheme = 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 forall a b. (a -> b) -> a -> b
$ do
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy forall a b. (a -> b) -> a -> b
$ \Char
x ->
      Char -> Bool
isAscii Char
x Bool -> Bool -> Bool
&& Char -> Bool
isAlpha Char
x
    forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy 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 forall a. Eq a => a -> a -> Bool
== Char
'+' Bool -> Bool -> Bool
|| Char
x forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
x 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 :: forall (m :: * -> *). MonadThrow m => Text -> m (RText 'Host)
mkHost = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (m :: * -> *). MonadThrow m => Text -> m (RText 'Username)
mkUsername = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null
  rnormalize :: Proxy 'Username -> Text -> Text
rnormalize Proxy 'Username
Proxy = 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 = forall (l :: RTextLabel).
(Text -> Maybe (RText l)) -> Gen (RText l)
arbText' 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 :: forall (m :: * -> *). MonadThrow m => Text -> m (RText 'Password)
mkPassword = 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 = forall a b. a -> b -> a
const Bool
True
  rnormalize :: Proxy 'Password -> Text -> Text
rnormalize Proxy 'Password
Proxy = 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 = forall (l :: RTextLabel).
(Text -> Maybe (RText l)) -> Gen (RText l)
arbText 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 :: forall (m :: * -> *). MonadThrow m => Text -> m (RText 'PathPiece)
mkPathPiece = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null
  rnormalize :: Proxy 'PathPiece -> Text -> Text
rnormalize Proxy 'PathPiece
Proxy = 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 = forall (l :: RTextLabel).
(Text -> Maybe (RText l)) -> Gen (RText l)
arbText' 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 :: forall (m :: * -> *). MonadThrow m => Text -> m (RText 'QueryKey)
mkQueryKey = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null
  rnormalize :: Proxy 'QueryKey -> Text -> Text
rnormalize Proxy 'QueryKey
Proxy = 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 = forall (l :: RTextLabel).
(Text -> Maybe (RText l)) -> Gen (RText l)
arbText' 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 :: forall (m :: * -> *). MonadThrow m => Text -> m (RText 'QueryValue)
mkQueryValue = 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 = forall a b. a -> b -> a
const Bool
True
  rnormalize :: Proxy 'QueryValue -> Text -> Text
rnormalize Proxy 'QueryValue
Proxy = 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 = forall (l :: RTextLabel).
(Text -> Maybe (RText l)) -> Gen (RText l)
arbText 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 :: forall (m :: * -> *). MonadThrow m => Text -> m (RText 'Fragment)
mkFragment = 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 = forall a b. a -> b -> a
const Bool
True
  rnormalize :: Proxy 'Fragment -> Text -> Text
rnormalize Proxy 'Fragment
Proxy = 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 = forall (l :: RTextLabel).
(Text -> Maybe (RText l)) -> Gen (RText l)
arbText 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 :: forall (l :: RTextLabel). 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
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
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
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
Ord, Typeable RTextException
RTextException -> DataType
RTextException -> Constr
(forall b. Data b => b -> b) -> RTextException -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u.
Int -> (forall d. Data d => d -> u) -> RTextException -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RTextException -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> RTextException -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RTextException -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, Typeable, 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 \""
      forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
txt
      forall a. [a] -> [a] -> [a]
++ String
"\" could not be lifted into a "
      forall a. [a] -> [a] -> [a]
++ 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 = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. [Gen a] -> Gen a
oneof [forall a. Random a => (a, a) -> Gen a
choose (Char
'a', Char
'z'), forall a. Random a => (a, a) -> Gen a
choose (Char
'A', Char
'Z')]
  Char
x <- Gen Char
g
  String
xs <-
    forall a. Gen a -> Gen [a]
listOf forall a b. (a -> b) -> a -> b
$
      forall a. [(Int, Gen a)] -> Gen a
frequency [(Int
3, Gen Char
g), (Int
1, forall a. Random a => (a, a) -> Gen a
choose (Char
'0', Char
'9'))]
  forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadThrow m => Text -> m (RText 'Scheme)
mkScheme forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ Char
x forall a. a -> [a] -> [a]
: String
xs

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

-- | Return 'True' if the given character is unreserved.
isUnreservedChar :: Char -> Bool
isUnreservedChar :: Char -> Bool
isUnreservedChar Char
x =
  Char -> Bool
isAlphaNum Char
x Bool -> Bool -> Bool
|| Char
x forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
x forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
x forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
x forall a. Eq a => a -> a -> Bool
== Char
'~'

-- | 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 :: forall (l :: RTextLabel).
(Text -> Maybe (RText l)) -> Gen (RText l)
arbText Text -> Maybe (RText l)
f = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (RText l)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Gen a -> Gen [a]
listOf 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' :: forall (l :: RTextLabel).
(Text -> Maybe (RText l)) -> Gen (RText l)
arbText' Text -> Maybe (RText l)
f = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (RText l)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Gen a -> Gen [a]
listOf1 forall a. Arbitrary a => Gen a
arbitrary

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

liftData :: (Data a, TH.Quote m) => a -> m TH.Exp
liftData :: forall a (m :: * -> *). (Data a, Quote m) => a -> m Exp
liftData = forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Exp)) -> a -> m Exp
TH.dataToExpQ (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *). Quote m => Text -> m Exp
liftText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast)

liftText :: (TH.Quote m) => Text -> m TH.Exp
liftText :: forall (m :: * -> *). Quote m => Text -> m Exp
liftText Text
t = Exp -> Exp -> Exp
TH.AppE (Name -> Exp
TH.VarE 'T.pack) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
TH.lift (Text -> String
T.unpack Text
t)