{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
module Text.URI.Parser.ByteString
( mkURIBs,
parserBs,
)
where
import Control.Monad
import Control.Monad.Catch (MonadThrow (..))
import Control.Monad.State.Strict
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.Char
import Data.List (intercalate)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Maybe (catMaybes, isJust, maybeToList)
import qualified Data.Set as E
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Void
import Data.Word (Word8)
import Text.Megaparsec
import Text.Megaparsec.Byte
import qualified Text.Megaparsec.Byte.Lexer as L
import Text.URI.Types hiding (pHost)
mkURIBs :: (MonadThrow m) => ByteString -> m URI
mkURIBs :: forall (m :: * -> *). MonadThrow m => ByteString -> m URI
mkURIBs ByteString
input =
case forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser (forall e (m :: * -> *). MonadParsec e ByteString m => m URI
parserBs forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
eof :: Parsec Void ByteString URI) String
"" ByteString
input of
Left ParseErrorBundle ByteString Void
b -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseErrorBundle ByteString Void -> ParseExceptionBs
ParseExceptionBs ParseErrorBundle ByteString Void
b)
Right URI
x -> forall (m :: * -> *) a. Monad m => a -> m a
return URI
x
parserBs :: (MonadParsec e ByteString m) => m URI
parserBs :: forall e (m :: * -> *). MonadParsec e ByteString m => m URI
parserBs = do
Maybe (RText 'Scheme)
uriScheme <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall e (m :: * -> *).
MonadParsec e ByteString m =>
m (RText 'Scheme)
pScheme)
Maybe Authority
mauth <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall e (m :: * -> *). MonadParsec e ByteString m => m Authority
pAuthority
(Bool
absPath, Maybe (Bool, NonEmpty (RText 'PathPiece))
uriPath) <- forall e (m :: * -> *).
MonadParsec e ByteString m =>
Bool -> m (Bool, Maybe (Bool, NonEmpty (RText 'PathPiece)))
pPath (forall a. Maybe a -> Bool
isJust Maybe Authority
mauth)
[QueryParam]
uriQuery <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option [] forall e (m :: * -> *).
MonadParsec e ByteString m =>
m [QueryParam]
pQuery
Maybe (RText 'Fragment)
uriFragment <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall e (m :: * -> *).
MonadParsec e ByteString m =>
m (RText 'Fragment)
pFragment
let uriAuthority :: Either Bool Authority
uriAuthority = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left Bool
absPath) forall a b. b -> Either a b
Right Maybe Authority
mauth
forall (m :: * -> *) a. Monad m => a -> m a
return 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)
uriAuthority :: Either Bool Authority
uriFragment :: Maybe (RText 'Fragment)
uriQuery :: [QueryParam]
uriPath :: Maybe (Bool, NonEmpty (RText 'PathPiece))
uriScheme :: Maybe (RText 'Scheme)
..}
{-# INLINEABLE parserBs #-}
{-# SPECIALIZE parserBs :: Parsec Void ByteString URI #-}
pScheme :: (MonadParsec e ByteString m) => m (RText 'Scheme)
pScheme :: forall e (m :: * -> *).
MonadParsec e ByteString m =>
m (RText 'Scheme)
pScheme = do
RText 'Scheme
r <- forall e (m :: * -> *) r.
MonadParsec e ByteString m =>
String -> (Text -> Maybe r) -> m [Word8] -> m r
liftR String
"scheme" forall (m :: * -> *). MonadThrow m => Text -> m (RText 'Scheme)
mkScheme forall a b. (a -> b) -> a -> b
$ do
Word8
x <- forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
asciiAlphaChar
[Word8]
xs <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
asciiAlphaNumChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
43 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
45 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
46)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8
x forall a. a -> [a] -> [a]
: [Word8]
xs)
forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
58)
forall (m :: * -> *) a. Monad m => a -> m a
return RText 'Scheme
r
{-# INLINE pScheme #-}
pAuthority :: (MonadParsec e ByteString m) => m Authority
pAuthority :: forall e (m :: * -> *). MonadParsec e ByteString m => m Authority
pAuthority = do
forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens ByteString
"//")
Maybe UserInfo
authUserInfo <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall e (m :: * -> *). MonadParsec e ByteString m => m UserInfo
pUserInfo
RText 'Host
authHost <- forall e (m :: * -> *) r.
MonadParsec e ByteString m =>
String -> (Text -> Maybe r) -> m [Word8] -> m r
liftR String
"host" forall (m :: * -> *). MonadThrow m => Text -> m (RText 'Host)
mkHost forall e (m :: * -> *). MonadParsec e ByteString m => m [Word8]
pHost
Maybe Word
authPort <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
58 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m a
L.decimal)
forall (m :: * -> *) a. Monad m => a -> m a
return Authority {Maybe Word
Maybe UserInfo
RText 'Host
authPort :: Maybe Word
authHost :: RText 'Host
authUserInfo :: Maybe UserInfo
authPort :: Maybe Word
authHost :: RText 'Host
authUserInfo :: Maybe UserInfo
..}
{-# INLINE pAuthority #-}
pHost :: (MonadParsec e ByteString m) => m [Word8]
pHost :: forall e (m :: * -> *). MonadParsec e ByteString m => m [Word8]
pHost =
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall e (m :: * -> *) a.
MonadParsec e ByteString m =>
m a -> m [Word8]
asConsumed m ()
ipLiteral),
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall e (m :: * -> *) a.
MonadParsec e ByteString m =>
m a -> m [Word8]
asConsumed m ()
ipv4Address),
m [Word8]
regName
]
where
asConsumed :: (MonadParsec e ByteString m) => m a -> m [Word8]
asConsumed :: forall e (m :: * -> *) a.
MonadParsec e ByteString m =>
m a -> m [Word8]
asConsumed m a
p = ByteString -> [Word8]
B.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
match m a
p
ipLiteral :: m ()
ipLiteral =
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
91) (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
93) forall a b. (a -> b) -> a -> b
$
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try m ()
ipv6Address forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ()
ipvFuture
octet :: m ()
octet = do
Int
o <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
(ByteString
toks, Integer
x) <- forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
match forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m a
L.decimal
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
x forall a. Ord a => a -> a -> Bool
>= (Integer
256 :: Integer)) forall a b. (a -> b) -> a -> b
$ do
forall e s (m :: * -> *). MonadParsec e s m => Int -> m ()
setOffset Int
o
forall e s (m :: * -> *) a.
MonadParsec e s m =>
Maybe (ErrorItem (Token s)) -> Set (ErrorItem (Token s)) -> m a
failure
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall t. NonEmpty t -> ErrorItem t
Tokens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
B.unpack forall a b. (a -> b) -> a -> b
$ ByteString
toks)
(forall a. a -> Set a
E.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. NonEmpty Char -> ErrorItem t
Label forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> NonEmpty a
NE.fromList forall a b. (a -> b) -> a -> b
$ String
"decimal number from 0 to 255")
ipv4Address :: m ()
ipv4Address =
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
3 (m ()
octet forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
46) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
octet
ipv6Address :: m ()
ipv6Address = do
Int
o <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
(ByteString
toks, [[Token ByteString]]
xs) <- forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
match forall a b. (a -> b) -> a -> b
$ do
[[Token ByteString]]
xs' <- forall a. Maybe a -> [a]
maybeToList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ([] forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens ByteString
"::")
[[Token ByteString]]
xs <- forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy1 (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
58) forall a b. (a -> b) -> a -> b
$ do
(Bool
skip, Bool
hasMore) <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden forall a b. (a -> b) -> a -> b
$ do
Bool
skip <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
False (Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
58)
Bool
hasMore <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
False (Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
hexDigitChar)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
skip, Bool
hasMore)
case (Bool
skip, Bool
hasMore) of
(Bool
True, Bool
True) -> forall (m :: * -> *) a. Monad m => a -> m a
return []
(Bool
True, Bool
False) -> [] forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
58
(Bool
False, Bool
_) -> forall (m :: * -> *) a. MonadPlus m => Int -> Int -> m a -> m [a]
count' Int
1 Int
4 forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
hexDigitChar
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Token ByteString]]
xs' forall a. [a] -> [a] -> [a]
++ [[Token ByteString]]
xs)
let nskips :: Int
nskips = forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. (a -> Bool) -> [a] -> [a]
filter forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Token ByteString]]
xs)
npieces :: Int
npieces = forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Token ByteString]]
xs
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
nskips forall a. Ord a => a -> a -> Bool
< Int
2 Bool -> Bool -> Bool
&& (Int
npieces forall a. Eq a => a -> a -> Bool
== Int
8 Bool -> Bool -> Bool
|| (Int
nskips forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& Int
npieces forall a. Ord a => a -> a -> Bool
< Int
8))) forall a b. (a -> b) -> a -> b
$ do
forall e s (m :: * -> *). MonadParsec e s m => Int -> m ()
setOffset Int
o
forall e s (m :: * -> *) a.
MonadParsec e s m =>
Maybe (ErrorItem (Token s)) -> Set (ErrorItem (Token s)) -> m a
failure
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall t. NonEmpty t -> ErrorItem t
Tokens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
B.unpack forall a b. (a -> b) -> a -> b
$ ByteString
toks)
(forall a. a -> Set a
E.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. NonEmpty Char -> ErrorItem t
Label forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> NonEmpty a
NE.fromList forall a b. (a -> b) -> a -> b
$ String
"valid IPv6 address")
ipvFuture :: m ()
ipvFuture = do
forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
118)
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
hexDigitChar
forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
46)
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipSome (forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
unreservedChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
subDelimChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
58)
regName :: m [Word8]
regName = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. [a] -> [[a]] -> [a]
intercalate [Word8
46]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy1 (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
46) forall a b. (a -> b) -> a -> b
$ do
let ch :: m Word8
ch = forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
percentEncChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
unreservedChar
Maybe Word8
mx <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m Word8
ch
case Maybe Word8
mx of
Maybe Word8
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return []
Just Word8
x -> do
let r :: m Word8
r =
m Word8
ch
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try
(forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
45 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try) (m Word8
ch forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
45))
[Word8]
xs <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many m Word8
r
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8
x forall a. a -> [a] -> [a]
: [Word8]
xs)
pUserInfo :: (MonadParsec e ByteString m) => m UserInfo
pUserInfo :: forall e (m :: * -> *). MonadParsec e ByteString m => m UserInfo
pUserInfo = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
RText 'Username
uiUsername <-
forall e (m :: * -> *) r.
MonadParsec e ByteString m =>
String -> (Text -> Maybe r) -> m [Word8] -> m r
liftR
String
"username"
forall (m :: * -> *). MonadThrow m => Text -> m (RText 'Username)
mkUsername
( forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"username" forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
unreservedChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
percentEncChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
subDelimChar)
)
Maybe (RText 'Password)
uiPassword <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
58)
forall e (m :: * -> *) r.
MonadParsec e ByteString m =>
String -> (Text -> Maybe r) -> m [Word8] -> m r
liftR
String
"password"
forall (m :: * -> *). MonadThrow m => Text -> m (RText 'Password)
mkPassword
(forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
unreservedChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
percentEncChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
subDelimChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
58))
forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
64)
forall (m :: * -> *) a. Monad m => a -> m a
return UserInfo {Maybe (RText 'Password)
RText 'Username
uiPassword :: Maybe (RText 'Password)
uiUsername :: RText 'Username
uiPassword :: Maybe (RText 'Password)
uiUsername :: RText 'Username
..}
{-# INLINE pUserInfo #-}
pPath ::
(MonadParsec e ByteString m) =>
Bool ->
m (Bool, Maybe (Bool, NonEmpty (RText 'PathPiece)))
pPath :: forall e (m :: * -> *).
MonadParsec e ByteString m =>
Bool -> m (Bool, Maybe (Bool, NonEmpty (RText 'PathPiece)))
pPath Bool
hasAuth = do
Bool
doubleSlash <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
False (Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens ByteString
"//"))
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
doubleSlash Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
hasAuth) forall a b. (a -> b) -> a -> b
$
(forall e s (m :: * -> *) a.
MonadParsec e s m =>
ErrorItem (Token s) -> m a
unexpected forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. NonEmpty t -> ErrorItem t
Tokens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> NonEmpty a
NE.fromList) [Token ByteString
47, Token ByteString
47]
Bool
absPath <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
False (Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
47)
let mkPathPiece' :: Text -> Maybe (Maybe (RText 'PathPiece))
mkPathPiece' Text
x =
if Text -> Bool
T.null Text
x
then forall a. a -> Maybe a
Just forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadThrow m => Text -> m (RText 'PathPiece)
mkPathPiece Text
x
([Maybe (RText 'PathPiece)]
maybePieces, Bool
trailingSlash) <- forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT Bool
False forall a b. (a -> b) -> a -> b
$
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
47) forall a b. (a -> b) -> a -> b
$
forall e (m :: * -> *) r.
MonadParsec e ByteString m =>
String -> (Text -> Maybe r) -> m [Word8] -> m r
liftR String
"path piece" Text -> Maybe (Maybe (RText 'PathPiece))
mkPathPiece' forall a b. (a -> b) -> a -> b
$
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"path piece" forall a b. (a -> b) -> a -> b
$ do
[Word8]
x <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
pchar
forall s (m :: * -> *). MonadState s m => s -> m ()
put (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Word8]
x)
forall (m :: * -> *) a. Monad m => a -> m a
return [Word8]
x
let pieces :: [RText 'PathPiece]
pieces = forall a. [Maybe a] -> [a]
catMaybes [Maybe (RText 'PathPiece)]
maybePieces
forall (m :: * -> *) a. Monad m => a -> m a
return
( Bool
absPath,
case forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [RText 'PathPiece]
pieces of
Maybe (NonEmpty (RText 'PathPiece))
Nothing -> forall a. Maybe a
Nothing
Just NonEmpty (RText 'PathPiece)
ps -> forall a. a -> Maybe a
Just (Bool
trailingSlash, NonEmpty (RText 'PathPiece)
ps)
)
{-# INLINE pPath #-}
pQuery :: (MonadParsec e ByteString m) => m [QueryParam]
pQuery :: forall e (m :: * -> *).
MonadParsec e ByteString m =>
m [QueryParam]
pQuery = do
forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
63)
forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
38))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
38) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"query parameter" forall a b. (a -> b) -> a -> b
$ do
let p :: m [Word8]
p = forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
pchar' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
47 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
63)
RText 'QueryKey
k <- forall e (m :: * -> *) r.
MonadParsec e ByteString m =>
String -> (Text -> Maybe r) -> m [Word8] -> m r
liftR String
"query key" forall (m :: * -> *). MonadThrow m => Text -> m (RText 'QueryKey)
mkQueryKey m [Word8]
p
Maybe (RText 'QueryValue)
mv <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
61 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e (m :: * -> *) r.
MonadParsec e ByteString m =>
String -> (Text -> Maybe r) -> m [Word8] -> m r
liftR String
"query value" forall (m :: * -> *). MonadThrow m => Text -> m (RText 'QueryValue)
mkQueryValue m [Word8]
p)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
if Text -> Bool
T.null (forall (l :: RTextLabel). RText l -> Text
unRText RText 'QueryKey
k)
then forall a. Maybe a
Nothing
else
forall a. a -> Maybe a
Just
( case Maybe (RText 'QueryValue)
mv of
Maybe (RText 'QueryValue)
Nothing -> RText 'QueryKey -> QueryParam
QueryFlag RText 'QueryKey
k
Just RText 'QueryValue
v -> RText 'QueryKey -> RText 'QueryValue -> QueryParam
QueryParam RText 'QueryKey
k RText 'QueryValue
v
)
{-# INLINE pQuery #-}
pFragment :: (MonadParsec e ByteString m) => m (RText 'Fragment)
pFragment :: forall e (m :: * -> *).
MonadParsec e ByteString m =>
m (RText 'Fragment)
pFragment = do
forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
35)
forall e (m :: * -> *) r.
MonadParsec e ByteString m =>
String -> (Text -> Maybe r) -> m [Word8] -> m r
liftR
String
"fragment"
forall (m :: * -> *). MonadThrow m => Text -> m (RText 'Fragment)
mkFragment
( forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"fragment character" forall a b. (a -> b) -> a -> b
$
forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
pchar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
47 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
63
)
{-# INLINE pFragment #-}
liftR ::
(MonadParsec e ByteString m) =>
String ->
(Text -> Maybe r) ->
m [Word8] ->
m r
liftR :: forall e (m :: * -> *) r.
MonadParsec e ByteString m =>
String -> (Text -> Maybe r) -> m [Word8] -> m r
liftR String
lbl Text -> Maybe r
f m [Word8]
p = do
Int
o <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
(ByteString
toks, [Word8]
s) <- forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
match m [Word8]
p
case ByteString -> Either UnicodeException Text
TE.decodeUtf8' ([Word8] -> ByteString
B.pack [Word8]
s) of
Left UnicodeException
_ -> do
let unexp :: NonEmpty Word8
unexp = forall a. [a] -> NonEmpty a
NE.fromList (ByteString -> [Word8]
B.unpack ByteString
toks)
expecting :: NonEmpty Char
expecting = forall a. [a] -> NonEmpty a
NE.fromList (String
lbl forall a. [a] -> [a] -> [a]
++ String
" that can be decoded as UTF-8")
forall e s (m :: * -> *) a.
MonadParsec e s m =>
ParseError s e -> m a
parseError
( forall s e.
Int
-> Maybe (ErrorItem (Token s))
-> Set (ErrorItem (Token s))
-> ParseError s e
TrivialError
Int
o
(forall a. a -> Maybe a
Just (forall t. NonEmpty t -> ErrorItem t
Tokens NonEmpty Word8
unexp))
(forall a. a -> Set a
S.singleton (forall t. NonEmpty Char -> ErrorItem t
Label NonEmpty Char
expecting))
)
Right Text
text -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (f :: * -> *) a. Alternative f => f a
empty forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Maybe r
f Text
text)
{-# INLINE liftR #-}
asciiAlphaChar :: (MonadParsec e ByteString m) => m Word8
asciiAlphaChar :: forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
asciiAlphaChar = forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Word8 -> Bool
isAsciiAlpha forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"ASCII alpha character"
{-# INLINE asciiAlphaChar #-}
asciiAlphaNumChar :: (MonadParsec e ByteString m) => m Word8
asciiAlphaNumChar :: forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
asciiAlphaNumChar = forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Word8 -> Bool
isAsciiAlphaNum forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"ASCII alpha-numeric character"
{-# INLINE asciiAlphaNumChar #-}
unreservedChar :: (MonadParsec e ByteString m) => m Word8
unreservedChar :: forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
unreservedChar = forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"unreserved character" 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
$ \Word8
x ->
Word8 -> Bool
isAsciiAlphaNum Word8
x Bool -> Bool -> Bool
|| Word8
x forall a. Eq a => a -> a -> Bool
== Word8
45 Bool -> Bool -> Bool
|| Word8
x forall a. Eq a => a -> a -> Bool
== Word8
46 Bool -> Bool -> Bool
|| Word8
x forall a. Eq a => a -> a -> Bool
== Word8
95 Bool -> Bool -> Bool
|| Word8
x forall a. Eq a => a -> a -> Bool
== Word8
126
{-# INLINE unreservedChar #-}
percentEncChar :: (MonadParsec e ByteString m) => m Word8
percentEncChar :: forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
percentEncChar = do
forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
37)
Word8
h <- Word8 -> Word8
restoreDigit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
hexDigitChar
Word8
l <- Word8 -> Word8
restoreDigit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
hexDigitChar
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8
h forall a. Num a => a -> a -> a
* Word8
16 forall a. Num a => a -> a -> a
+ Word8
l)
{-# INLINE percentEncChar #-}
subDelimChar :: (MonadParsec e ByteString m) => m Word8
subDelimChar :: forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
subDelimChar = forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf Set (Token ByteString)
s forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"sub-delimiter"
where
s :: Set (Token ByteString)
s = forall a. Ord a => [a] -> Set a
E.fromList (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
"!$&'()*+,;=")
{-# INLINE subDelimChar #-}
pchar :: (MonadParsec e ByteString m) => m Word8
pchar :: forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
pchar =
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
unreservedChar,
forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
percentEncChar,
forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
subDelimChar,
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
58,
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
64
]
{-# INLINE pchar #-}
pchar' :: (MonadParsec e ByteString m) => m Word8
pchar' :: forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
pchar' =
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
unreservedChar,
forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
percentEncChar,
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
43 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure Word8
32,
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf Set (Token ByteString)
s forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"sub-delimiter",
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
58,
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
64
]
where
s :: Set (Token ByteString)
s = forall a. Ord a => [a] -> Set a
E.fromList (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
"!$'()*,;")
{-# INLINE pchar' #-}
isAsciiAlpha :: Word8 -> Bool
isAsciiAlpha :: Word8 -> Bool
isAsciiAlpha Word8
x
| Word8
65 forall a. Ord a => a -> a -> Bool
<= Word8
x Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Word8
90 = Bool
True
| Word8
97 forall a. Ord a => a -> a -> Bool
<= Word8
x Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Word8
122 = Bool
True
| Bool
otherwise = Bool
False
isAsciiAlphaNum :: Word8 -> Bool
isAsciiAlphaNum :: Word8 -> Bool
isAsciiAlphaNum Word8
x
| Word8 -> Bool
isAsciiAlpha Word8
x = Bool
True
| Word8
48 forall a. Ord a => a -> a -> Bool
<= Word8
x Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Word8
57 = Bool
True
| Bool
otherwise = Bool
False
restoreDigit :: Word8 -> Word8
restoreDigit :: Word8 -> Word8
restoreDigit Word8
x
| Word8
48 forall a. Ord a => a -> a -> Bool
<= Word8
x Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Word8
57 = Word8
x forall a. Num a => a -> a -> a
- Word8
48
| Word8
65 forall a. Ord a => a -> a -> Bool
<= Word8
x Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Word8
70 = Word8
x forall a. Num a => a -> a -> a
- Word8
55
| Word8
97 forall a. Ord a => a -> a -> Bool
<= Word8
x Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Word8
102 = Word8
x forall a. Num a => a -> a -> a
- Word8
87
| Bool
otherwise = forall a. HasCallStack => String -> a
error String
"Text.URI.Parser.restoreDigit: bad input"