{-# 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
(
URI (..),
makeAbsolute,
isPathAbsolute,
Authority (..),
UserInfo (..),
QueryParam (..),
ParseException (..),
ParseExceptionBs (..),
RText,
RTextLabel (..),
mkScheme,
mkHost,
mkUsername,
mkPassword,
mkPathPiece,
mkQueryKey,
mkQueryValue,
mkFragment,
unRText,
RTextException (..),
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 URI = URI
{
URI -> Maybe (RText 'Scheme)
uriScheme :: Maybe (RText 'Scheme),
URI -> Either Bool Authority
uriAuthority :: Either Bool Authority,
URI -> Maybe (Bool, NonEmpty (RText 'PathPiece))
uriPath :: Maybe (Bool, NonEmpty (RText 'PathPiece)),
URI -> [QueryParam]
uriQuery :: [QueryParam],
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)
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
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
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
..
}
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
data Authority = Authority
{
Authority -> Maybe UserInfo
authUserInfo :: Maybe UserInfo,
Authority -> RText 'Host
authHost :: RText 'Host,
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)
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
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
data UserInfo = UserInfo
{
UserInfo -> RText 'Username
uiUsername :: RText 'Username,
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)
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
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
data QueryParam
=
QueryFlag (RText 'QueryKey)
|
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)
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
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
newtype ParseException
=
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
newtype ParseExceptionBs
=
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
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)
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)
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
data RTextLabel
=
Scheme
|
Host
|
Username
|
Password
|
PathPiece
|
QueryKey
|
QueryValue
|
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)
class RLabel (l :: RTextLabel) where
rcheck :: Proxy l -> Text -> Bool
rnormalize :: Proxy l -> Text -> Text
rlabel :: Proxy l -> RTextLabel
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
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
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
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
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
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
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
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
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
unRText :: RText l -> Text
unRText :: forall (l :: RTextLabel). RText l -> Text
unRText (RText Text
txt) = Text
txt
data RTextException
=
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
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
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
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 =
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)
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
'~'
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
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
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)