{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}

-- |
-- Module      :  Text.URI.Parser.ByteString
-- Copyright   :  © 2017–present Mark Karpov
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- URI parser for string 'ByteString', an internal module.
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 Data.Text (Text)
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)

-- | Construct a 'URI' from 'ByteString'. The input you pass to 'mkURIBs'
-- must be a valid URI as per RFC 3986, that is, its components should be
-- percent-encoded where necessary. In case of parse failure
-- 'ParseExceptionBs' is thrown.
--
-- This function uses the 'parserBs' parser under the hood, which you can also
-- use directly in a Megaparsec parser.
--
-- @since 0.3.3.0
mkURIBs :: MonadThrow m => ByteString -> m URI
mkURIBs :: ByteString -> m URI
mkURIBs ByteString
input =
  case Parsec Void ByteString URI
-> String
-> ByteString
-> Either (ParseErrorBundle ByteString Void) URI
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser (Parsec Void ByteString URI
forall e (m :: * -> *). MonadParsec e ByteString m => m URI
parserBs Parsec Void ByteString URI
-> ParsecT Void ByteString Identity ()
-> Parsec Void ByteString URI
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void ByteString Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof :: Parsec Void ByteString URI) String
"" ByteString
input of
    Left ParseErrorBundle ByteString Void
b -> ParseExceptionBs -> m URI
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseErrorBundle ByteString Void -> ParseExceptionBs
ParseExceptionBs ParseErrorBundle ByteString Void
b)
    Right URI
x -> URI -> m URI
forall (m :: * -> *) a. Monad m => a -> m a
return URI
x

-- | This parser can be used to parse 'URI' from strict 'ByteString'.
-- Remember to use a concrete non-polymorphic parser type for efficiency.
--
-- @since 0.0.2.0
parserBs :: MonadParsec e ByteString m => m URI
parserBs :: m URI
parserBs = do
  Maybe (RText 'Scheme)
uriScheme <- m (RText 'Scheme) -> m (Maybe (RText 'Scheme))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (m (RText 'Scheme) -> m (RText 'Scheme)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try m (RText 'Scheme)
forall e (m :: * -> *).
MonadParsec e ByteString m =>
m (RText 'Scheme)
pScheme)
  Maybe Authority
mauth <- m Authority -> m (Maybe Authority)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m Authority
forall e (m :: * -> *). MonadParsec e ByteString m => m Authority
pAuthority
  (Bool
absPath, Maybe (Bool, NonEmpty (RText 'PathPiece))
uriPath) <- Bool -> m (Bool, Maybe (Bool, NonEmpty (RText 'PathPiece)))
forall e (m :: * -> *).
MonadParsec e ByteString m =>
Bool -> m (Bool, Maybe (Bool, NonEmpty (RText 'PathPiece)))
pPath (Maybe Authority -> Bool
forall a. Maybe a -> Bool
isJust Maybe Authority
mauth)
  [QueryParam]
uriQuery <- [QueryParam] -> m [QueryParam] -> m [QueryParam]
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option [] m [QueryParam]
forall e (m :: * -> *).
MonadParsec e ByteString m =>
m [QueryParam]
pQuery
  Maybe (RText 'Fragment)
uriFragment <- m (RText 'Fragment) -> m (Maybe (RText 'Fragment))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m (RText 'Fragment)
forall e (m :: * -> *).
MonadParsec e ByteString m =>
m (RText 'Fragment)
pFragment
  let uriAuthority :: Either Bool Authority
uriAuthority = Either Bool Authority
-> (Authority -> Either Bool Authority)
-> Maybe Authority
-> Either Bool Authority
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> Either Bool Authority
forall a b. a -> Either a b
Left Bool
absPath) Authority -> Either Bool Authority
forall a b. b -> Either a b
Right Maybe Authority
mauth
  URI -> m URI
forall (m :: * -> *) a. Monad m => a -> m a
return URI :: Maybe (RText 'Scheme)
-> Either Bool Authority
-> Maybe (Bool, NonEmpty (RText 'PathPiece))
-> [QueryParam]
-> Maybe (RText 'Fragment)
-> URI
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 :: m (RText 'Scheme)
pScheme = do
  Word8
x <- m Word8
forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
asciiAlphaChar
  [Word8]
xs <- m Word8 -> m [Word8]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (m Word8
forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
asciiAlphaNumChar m Word8 -> m Word8 -> m Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
43 m Word8 -> m Word8 -> m Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
45 m Word8 -> m Word8 -> m Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
46)
  m Word8 -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
58)
  (forall (n :: * -> *). MonadThrow n => Text -> n (RText 'Scheme))
-> [Word8] -> m (RText 'Scheme)
forall e s (m :: * -> *) r.
MonadParsec e s m =>
(forall (n :: * -> *). MonadThrow n => Text -> n r)
-> [Word8] -> m r
liftR forall (n :: * -> *). MonadThrow n => Text -> n (RText 'Scheme)
mkScheme (Word8
x Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: [Word8]
xs)
{-# INLINE pScheme #-}

pAuthority :: MonadParsec e ByteString m => m Authority
pAuthority :: m Authority
pAuthority = do
  m ByteString -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tokens ByteString -> m (Tokens ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens ByteString
"//")
  Maybe UserInfo
authUserInfo <- m UserInfo -> m (Maybe UserInfo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m UserInfo
forall e (m :: * -> *). MonadParsec e ByteString m => m UserInfo
pUserInfo
  RText 'Host
authHost <- m [Word8]
forall e (m :: * -> *). MonadParsec e ByteString m => m [Word8]
pHost m [Word8] -> ([Word8] -> m (RText 'Host)) -> m (RText 'Host)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (n :: * -> *). MonadThrow n => Text -> n (RText 'Host))
-> [Word8] -> m (RText 'Host)
forall e s (m :: * -> *) r.
MonadParsec e s m =>
(forall (n :: * -> *). MonadThrow n => Text -> n r)
-> [Word8] -> m r
liftR forall (n :: * -> *). MonadThrow n => Text -> n (RText 'Host)
mkHost
  Maybe Word
authPort <- m Word -> m (Maybe Word)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
58 m Word8 -> m Word -> m Word
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m Word
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m a
L.decimal)
  Authority -> m Authority
forall (m :: * -> *) a. Monad m => a -> m a
return Authority :: Maybe UserInfo -> RText 'Host -> Maybe Word -> Authority
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 #-}

-- | Parser that can parse host names.
pHost :: MonadParsec e ByteString m => m [Word8]
pHost :: m [Word8]
pHost =
  [m [Word8]] -> m [Word8]
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ m [Word8] -> m [Word8]
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m () -> m [Word8]
forall e (m :: * -> *) a.
MonadParsec e ByteString m =>
m a -> m [Word8]
asConsumed m ()
ipLiteral),
      m [Word8] -> m [Word8]
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m () -> m [Word8]
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 :: m a -> m [Word8]
asConsumed m a
p = ByteString -> [Word8]
B.unpack (ByteString -> [Word8])
-> ((ByteString, a) -> ByteString) -> (ByteString, a) -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, a) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, a) -> [Word8]) -> m (ByteString, a) -> m [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a -> m (Tokens ByteString, a)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
match m a
p
    ipLiteral :: m ()
ipLiteral =
      m Word8 -> m Word8 -> m () -> m ()
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
91) (Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
93) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        m () -> m ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try m ()
ipv6Address m () -> m () -> m ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ()
ipvFuture
    octet :: m ()
octet = do
      Int
o <- m Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
      (ByteString
toks, Integer
x) <- m Integer -> m (Tokens ByteString, Integer)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
match m Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m a
L.decimal
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= (Integer
256 :: Integer)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        Int -> m ()
forall e s (m :: * -> *). MonadParsec e s m => Int -> m ()
setOffset Int
o
        Maybe (ErrorItem (Token ByteString))
-> Set (ErrorItem (Token ByteString)) -> m ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
Maybe (ErrorItem (Token s)) -> Set (ErrorItem (Token s)) -> m a
failure
          ((NonEmpty Word8 -> ErrorItem Word8)
-> Maybe (NonEmpty Word8) -> Maybe (ErrorItem Word8)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty Word8 -> ErrorItem Word8
forall t. NonEmpty t -> ErrorItem t
Tokens (Maybe (NonEmpty Word8) -> Maybe (ErrorItem Word8))
-> (ByteString -> Maybe (NonEmpty Word8))
-> ByteString
-> Maybe (ErrorItem Word8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> Maybe (NonEmpty Word8)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty ([Word8] -> Maybe (NonEmpty Word8))
-> (ByteString -> [Word8]) -> ByteString -> Maybe (NonEmpty Word8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
B.unpack (ByteString -> Maybe (ErrorItem Word8))
-> ByteString -> Maybe (ErrorItem Word8)
forall a b. (a -> b) -> a -> b
$ ByteString
toks)
          (ErrorItem Word8 -> Set (ErrorItem Word8)
forall a. a -> Set a
E.singleton (ErrorItem Word8 -> Set (ErrorItem Word8))
-> (String -> ErrorItem Word8) -> String -> Set (ErrorItem Word8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Char -> ErrorItem Word8
forall t. NonEmpty Char -> ErrorItem t
Label (NonEmpty Char -> ErrorItem Word8)
-> (String -> NonEmpty Char) -> String -> ErrorItem Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> NonEmpty Char
forall a. [a] -> NonEmpty a
NE.fromList (String -> Set (ErrorItem Word8))
-> String -> Set (ErrorItem Word8)
forall a b. (a -> b) -> a -> b
$ String
"decimal number from 0 to 255")
    ipv4Address :: m ()
ipv4Address =
      Int -> m () -> m [()]
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
3 (m ()
octet m () -> m Word8 -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
46) m [()] -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
octet
    ipv6Address :: m ()
ipv6Address = do
      Int
o <- m Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
      (ByteString
toks, [[Word8]]
xs) <- m [[Word8]] -> m (Tokens ByteString, [[Word8]])
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
match (m [[Word8]] -> m (Tokens ByteString, [[Word8]]))
-> m [[Word8]] -> m (Tokens ByteString, [[Word8]])
forall a b. (a -> b) -> a -> b
$ do
        [[Word8]]
xs' <- Maybe [Word8] -> [[Word8]]
forall a. Maybe a -> [a]
maybeToList (Maybe [Word8] -> [[Word8]]) -> m (Maybe [Word8]) -> m [[Word8]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [Word8] -> m (Maybe [Word8])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ([] [Word8] -> m ByteString -> m [Word8]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens ByteString -> m (Tokens ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens ByteString
"::")
        [[Word8]]
xs <- (m [Word8] -> m Word8 -> m [[Word8]])
-> m Word8 -> m [Word8] -> m [[Word8]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip m [Word8] -> m Word8 -> m [[Word8]]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy1 (Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
58) (m [Word8] -> m [[Word8]]) -> m [Word8] -> m [[Word8]]
forall a b. (a -> b) -> a -> b
$ do
          (Bool
skip, Bool
hasMore) <- m (Bool, Bool) -> m (Bool, Bool)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (m (Bool, Bool) -> m (Bool, Bool))
-> (m (Bool, Bool) -> m (Bool, Bool))
-> m (Bool, Bool)
-> m (Bool, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Bool, Bool) -> m (Bool, Bool)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
hidden (m (Bool, Bool) -> m (Bool, Bool))
-> m (Bool, Bool) -> m (Bool, Bool)
forall a b. (a -> b) -> a -> b
$ do
            Bool
skip <- Bool -> m Bool -> m Bool
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
False (Bool
True Bool -> m Word8 -> m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
58)
            Bool
hasMore <- Bool -> m Bool -> m Bool
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
False (Bool
True Bool -> m Word8 -> m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m Word8
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
hexDigitChar)
            (Bool, Bool) -> m (Bool, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
skip, Bool
hasMore)
          case (Bool
skip, Bool
hasMore) of
            (Bool
True, Bool
True) -> [Word8] -> m [Word8]
forall (m :: * -> *) a. Monad m => a -> m a
return []
            (Bool
True, Bool
False) -> [] [Word8] -> m Word8 -> m [Word8]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
58
            (Bool
False, Bool
_) -> Int -> Int -> m Word8 -> m [Word8]
forall (m :: * -> *) a. MonadPlus m => Int -> Int -> m a -> m [a]
count' Int
1 Int
4 m Word8
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
hexDigitChar
        [[Word8]] -> m [[Word8]]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Word8]]
xs' [[Word8]] -> [[Word8]] -> [[Word8]]
forall a. [a] -> [a] -> [a]
++ [[Word8]]
xs)
      let nskips :: Int
nskips = [[Word8]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (([Word8] -> Bool) -> [[Word8]] -> [[Word8]]
forall a. (a -> Bool) -> [a] -> [a]
filter [Word8] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Word8]]
xs)
          npieces :: Int
npieces = [[Word8]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Word8]]
xs
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
nskips Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 Bool -> Bool -> Bool
&& (Int
npieces Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
8 Bool -> Bool -> Bool
|| (Int
nskips Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& Int
npieces Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
8))) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        Int -> m ()
forall e s (m :: * -> *). MonadParsec e s m => Int -> m ()
setOffset Int
o
        Maybe (ErrorItem (Token ByteString))
-> Set (ErrorItem (Token ByteString)) -> m ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
Maybe (ErrorItem (Token s)) -> Set (ErrorItem (Token s)) -> m a
failure
          ((NonEmpty Word8 -> ErrorItem Word8)
-> Maybe (NonEmpty Word8) -> Maybe (ErrorItem Word8)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty Word8 -> ErrorItem Word8
forall t. NonEmpty t -> ErrorItem t
Tokens (Maybe (NonEmpty Word8) -> Maybe (ErrorItem Word8))
-> (ByteString -> Maybe (NonEmpty Word8))
-> ByteString
-> Maybe (ErrorItem Word8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> Maybe (NonEmpty Word8)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty ([Word8] -> Maybe (NonEmpty Word8))
-> (ByteString -> [Word8]) -> ByteString -> Maybe (NonEmpty Word8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
B.unpack (ByteString -> Maybe (ErrorItem Word8))
-> ByteString -> Maybe (ErrorItem Word8)
forall a b. (a -> b) -> a -> b
$ ByteString
toks)
          (ErrorItem Word8 -> Set (ErrorItem Word8)
forall a. a -> Set a
E.singleton (ErrorItem Word8 -> Set (ErrorItem Word8))
-> (String -> ErrorItem Word8) -> String -> Set (ErrorItem Word8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Char -> ErrorItem Word8
forall t. NonEmpty Char -> ErrorItem t
Label (NonEmpty Char -> ErrorItem Word8)
-> (String -> NonEmpty Char) -> String -> ErrorItem Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> NonEmpty Char
forall a. [a] -> NonEmpty a
NE.fromList (String -> Set (ErrorItem Word8))
-> String -> Set (ErrorItem Word8)
forall a b. (a -> b) -> a -> b
$ String
"valid IPv6 address")
    ipvFuture :: m ()
ipvFuture = do
      m Word8 -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
118)
      m Word8 -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void m Word8
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
hexDigitChar
      m Word8 -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
46)
      m Word8 -> m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipSome (m Word8
forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
unreservedChar m Word8 -> m Word8 -> m Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Word8
forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
subDelimChar m Word8 -> m Word8 -> m Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
58)
    regName :: m [Word8]
regName = ([[Word8]] -> [Word8]) -> m [[Word8]] -> m [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Word8] -> [[Word8]] -> [Word8]
forall a. [a] -> [[a]] -> [a]
intercalate [Word8
46]) (m [[Word8]] -> m [Word8])
-> (m [Word8] -> m [[Word8]]) -> m [Word8] -> m [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m [Word8] -> m Word8 -> m [[Word8]])
-> m Word8 -> m [Word8] -> m [[Word8]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip m [Word8] -> m Word8 -> m [[Word8]]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy1 (Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
46) (m [Word8] -> m [Word8]) -> m [Word8] -> m [Word8]
forall a b. (a -> b) -> a -> b
$ do
      let ch :: m Word8
ch = m Word8
forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
percentEncChar m Word8 -> m Word8 -> m Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Word8
forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
asciiAlphaNumChar
      Maybe Word8
mx <- m Word8 -> m (Maybe Word8)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m Word8
ch
      case Maybe Word8
mx of
        Maybe Word8
Nothing -> [Word8] -> m [Word8]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        Just Word8
x -> do
          let r :: m Word8
r =
                m Word8
ch
                  m Word8 -> m Word8 -> m Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Word8 -> m Word8
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try
                    (Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
45 m Word8 -> m Word8 -> m Word8
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (m Word8 -> m Word8
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (m Word8 -> m Word8) -> (m Word8 -> m Word8) -> m Word8 -> m Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m Word8 -> m Word8
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try) (m Word8
ch m Word8 -> m Word8 -> m Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
45))
          [Word8]
xs <- m Word8 -> m [Word8]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many m Word8
r
          [Word8] -> m [Word8]
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8
x Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: [Word8]
xs)

pUserInfo :: MonadParsec e ByteString m => m UserInfo
pUserInfo :: m UserInfo
pUserInfo = m UserInfo -> m UserInfo
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m UserInfo -> m UserInfo) -> m UserInfo -> m UserInfo
forall a b. (a -> b) -> a -> b
$ do
  RText 'Username
uiUsername <-
    String -> m (RText 'Username) -> m (RText 'Username)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"username" (m (RText 'Username) -> m (RText 'Username))
-> m (RText 'Username) -> m (RText 'Username)
forall a b. (a -> b) -> a -> b
$
      m Word8 -> m [Word8]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (m Word8
forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
unreservedChar m Word8 -> m Word8 -> m Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Word8
forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
percentEncChar m Word8 -> m Word8 -> m Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Word8
forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
subDelimChar)
        m [Word8]
-> ([Word8] -> m (RText 'Username)) -> m (RText 'Username)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (n :: * -> *). MonadThrow n => Text -> n (RText 'Username))
-> [Word8] -> m (RText 'Username)
forall e s (m :: * -> *) r.
MonadParsec e s m =>
(forall (n :: * -> *). MonadThrow n => Text -> n r)
-> [Word8] -> m r
liftR forall (n :: * -> *). MonadThrow n => Text -> n (RText 'Username)
mkUsername
  Maybe (RText 'Password)
uiPassword <- m (RText 'Password) -> m (Maybe (RText 'Password))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (m (RText 'Password) -> m (Maybe (RText 'Password)))
-> m (RText 'Password) -> m (Maybe (RText 'Password))
forall a b. (a -> b) -> a -> b
$ do
    m Word8 -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
58)
    m Word8 -> m [Word8]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (m Word8
forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
unreservedChar m Word8 -> m Word8 -> m Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Word8
forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
percentEncChar m Word8 -> m Word8 -> m Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Word8
forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
subDelimChar m Word8 -> m Word8 -> m Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
58)
      m [Word8]
-> ([Word8] -> m (RText 'Password)) -> m (RText 'Password)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (n :: * -> *). MonadThrow n => Text -> n (RText 'Password))
-> [Word8] -> m (RText 'Password)
forall e s (m :: * -> *) r.
MonadParsec e s m =>
(forall (n :: * -> *). MonadThrow n => Text -> n r)
-> [Word8] -> m r
liftR forall (n :: * -> *). MonadThrow n => Text -> n (RText 'Password)
mkPassword
  m Word8 -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
64)
  UserInfo -> m UserInfo
forall (m :: * -> *) a. Monad m => a -> m a
return UserInfo :: RText 'Username -> Maybe (RText 'Password) -> UserInfo
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 :: Bool -> m (Bool, Maybe (Bool, NonEmpty (RText 'PathPiece)))
pPath Bool
hasAuth = do
  Bool
doubleSlash <- m Bool -> m Bool
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (Bool -> m Bool -> m Bool
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
False (Bool
True Bool -> m ByteString -> m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens ByteString -> m (Tokens ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens ByteString
"//"))
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
doubleSlash Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
hasAuth) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    (ErrorItem Word8 -> m ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
ErrorItem (Token s) -> m a
unexpected (ErrorItem Word8 -> m ())
-> ([Word8] -> ErrorItem Word8) -> [Word8] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Word8 -> ErrorItem Word8
forall t. NonEmpty t -> ErrorItem t
Tokens (NonEmpty Word8 -> ErrorItem Word8)
-> ([Word8] -> NonEmpty Word8) -> [Word8] -> ErrorItem Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> NonEmpty Word8
forall a. [a] -> NonEmpty a
NE.fromList) [Word8
47, Word8
47]
  Bool
absPath <- Bool -> m Bool -> m Bool
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
False (Bool
True Bool -> m Word8 -> m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
47)
  ([[Word8]]
rawPieces, Bool
trailingSlash) <- (StateT Bool m [[Word8]] -> Bool -> m ([[Word8]], Bool))
-> Bool -> StateT Bool m [[Word8]] -> m ([[Word8]], Bool)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT Bool m [[Word8]] -> Bool -> m ([[Word8]], Bool)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT Bool
False (StateT Bool m [[Word8]] -> m ([[Word8]], Bool))
-> StateT Bool m [[Word8]] -> m ([[Word8]], Bool)
forall a b. (a -> b) -> a -> b
$
    (StateT Bool m [Word8]
 -> StateT Bool m Word8 -> StateT Bool m [[Word8]])
-> StateT Bool m Word8
-> StateT Bool m [Word8]
-> StateT Bool m [[Word8]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT Bool m [Word8]
-> StateT Bool m Word8 -> StateT Bool m [[Word8]]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy (Token ByteString -> StateT Bool m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
47) (StateT Bool m [Word8] -> StateT Bool m [[Word8]])
-> (StateT Bool m [Word8] -> StateT Bool m [Word8])
-> StateT Bool m [Word8]
-> StateT Bool m [[Word8]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StateT Bool m [Word8] -> StateT Bool m [Word8]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"path piece" (StateT Bool m [Word8] -> StateT Bool m [[Word8]])
-> StateT Bool m [Word8] -> StateT Bool m [[Word8]]
forall a b. (a -> b) -> a -> b
$ do
      [Word8]
x <- StateT Bool m Word8 -> StateT Bool m [Word8]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many StateT Bool m Word8
forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
pchar
      Bool -> StateT Bool m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ([Word8] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Word8]
x)
      [Word8] -> StateT Bool m [Word8]
forall (m :: * -> *) a. Monad m => a -> m a
return [Word8]
x
  [RText 'PathPiece]
pieces <- ([Word8] -> m (RText 'PathPiece))
-> [[Word8]] -> m [RText 'PathPiece]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((forall (n :: * -> *).
 MonadThrow n =>
 Text -> n (RText 'PathPiece))
-> [Word8] -> m (RText 'PathPiece)
forall e s (m :: * -> *) r.
MonadParsec e s m =>
(forall (n :: * -> *). MonadThrow n => Text -> n r)
-> [Word8] -> m r
liftR forall (n :: * -> *). MonadThrow n => Text -> n (RText 'PathPiece)
mkPathPiece) (([Word8] -> Bool) -> [[Word8]] -> [[Word8]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Word8] -> Bool) -> [Word8] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [[Word8]]
rawPieces)
  (Bool, Maybe (Bool, NonEmpty (RText 'PathPiece)))
-> m (Bool, Maybe (Bool, NonEmpty (RText 'PathPiece)))
forall (m :: * -> *) a. Monad m => a -> m a
return
    ( Bool
absPath,
      case [RText 'PathPiece] -> Maybe (NonEmpty (RText 'PathPiece))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [RText 'PathPiece]
pieces of
        Maybe (NonEmpty (RText 'PathPiece))
Nothing -> Maybe (Bool, NonEmpty (RText 'PathPiece))
forall a. Maybe a
Nothing
        Just NonEmpty (RText 'PathPiece)
ps -> (Bool, NonEmpty (RText 'PathPiece))
-> Maybe (Bool, NonEmpty (RText 'PathPiece))
forall a. a -> Maybe a
Just (Bool
trailingSlash, NonEmpty (RText 'PathPiece)
ps)
    )
{-# INLINE pPath #-}

pQuery :: MonadParsec e ByteString m => m [QueryParam]
pQuery :: m [QueryParam]
pQuery = do
  m Word8 -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
63)
  m (Maybe Word8) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Word8 -> m (Maybe Word8)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
38))
  ([Maybe QueryParam] -> [QueryParam])
-> m [Maybe QueryParam] -> m [QueryParam]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe QueryParam] -> [QueryParam]
forall a. [Maybe a] -> [a]
catMaybes (m [Maybe QueryParam] -> m [QueryParam])
-> (m (Maybe QueryParam) -> m [Maybe QueryParam])
-> m (Maybe QueryParam)
-> m [QueryParam]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m (Maybe QueryParam) -> m Word8 -> m [Maybe QueryParam])
-> m Word8 -> m (Maybe QueryParam) -> m [Maybe QueryParam]
forall a b c. (a -> b -> c) -> b -> a -> c
flip m (Maybe QueryParam) -> m Word8 -> m [Maybe QueryParam]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy (Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
38) (m (Maybe QueryParam) -> m [Maybe QueryParam])
-> (m (Maybe QueryParam) -> m (Maybe QueryParam))
-> m (Maybe QueryParam)
-> m [Maybe QueryParam]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m (Maybe QueryParam) -> m (Maybe QueryParam)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"query parameter" (m (Maybe QueryParam) -> m [QueryParam])
-> m (Maybe QueryParam) -> m [QueryParam]
forall a b. (a -> b) -> a -> b
$ do
    let p :: m [Word8]
p = m Word8 -> m [Word8]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (m Word8
forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
pchar' m Word8 -> m Word8 -> m Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
47 m Word8 -> m Word8 -> m Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
63)
    [Word8]
k' <- m [Word8]
p
    Maybe [Word8]
mv <- m [Word8] -> m (Maybe [Word8])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
61 m Word8 -> m [Word8] -> m [Word8]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m [Word8]
p)
    RText 'QueryKey
k <- (forall (n :: * -> *). MonadThrow n => Text -> n (RText 'QueryKey))
-> [Word8] -> m (RText 'QueryKey)
forall e s (m :: * -> *) r.
MonadParsec e s m =>
(forall (n :: * -> *). MonadThrow n => Text -> n r)
-> [Word8] -> m r
liftR forall (n :: * -> *). MonadThrow n => Text -> n (RText 'QueryKey)
mkQueryKey [Word8]
k'
    if [Word8] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Word8]
k'
      then Maybe QueryParam -> m (Maybe QueryParam)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe QueryParam
forall a. Maybe a
Nothing
      else
        QueryParam -> Maybe QueryParam
forall a. a -> Maybe a
Just (QueryParam -> Maybe QueryParam)
-> m QueryParam -> m (Maybe QueryParam)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Maybe [Word8]
mv of
          Maybe [Word8]
Nothing -> QueryParam -> m QueryParam
forall (m :: * -> *) a. Monad m => a -> m a
return (RText 'QueryKey -> QueryParam
QueryFlag RText 'QueryKey
k)
          Just [Word8]
v -> RText 'QueryKey -> RText 'QueryValue -> QueryParam
QueryParam RText 'QueryKey
k (RText 'QueryValue -> QueryParam)
-> m (RText 'QueryValue) -> m QueryParam
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (n :: * -> *).
 MonadThrow n =>
 Text -> n (RText 'QueryValue))
-> [Word8] -> m (RText 'QueryValue)
forall e s (m :: * -> *) r.
MonadParsec e s m =>
(forall (n :: * -> *). MonadThrow n => Text -> n r)
-> [Word8] -> m r
liftR forall (n :: * -> *). MonadThrow n => Text -> n (RText 'QueryValue)
mkQueryValue [Word8]
v
{-# INLINE pQuery #-}

pFragment :: MonadParsec e ByteString m => m (RText 'Fragment)
pFragment :: m (RText 'Fragment)
pFragment = do
  m Word8 -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
35)
  [Word8]
xs <-
    m Word8 -> m [Word8]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (m Word8 -> m [Word8])
-> (m Word8 -> m Word8) -> m Word8 -> m [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m Word8 -> m Word8
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"fragment character" (m Word8 -> m [Word8]) -> m Word8 -> m [Word8]
forall a b. (a -> b) -> a -> b
$
      m Word8
forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
pchar m Word8 -> m Word8 -> m Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
47 m Word8 -> m Word8 -> m Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
63
  (forall (n :: * -> *). MonadThrow n => Text -> n (RText 'Fragment))
-> [Word8] -> m (RText 'Fragment)
forall e s (m :: * -> *) r.
MonadParsec e s m =>
(forall (n :: * -> *). MonadThrow n => Text -> n r)
-> [Word8] -> m r
liftR forall (n :: * -> *). MonadThrow n => Text -> n (RText 'Fragment)
mkFragment [Word8]
xs
{-# INLINE pFragment #-}

----------------------------------------------------------------------------
-- Helpers

liftR ::
  MonadParsec e s m =>
  (forall n. MonadThrow n => Text -> n r) ->
  [Word8] ->
  m r
liftR :: (forall (n :: * -> *). MonadThrow n => Text -> n r)
-> [Word8] -> m r
liftR forall (n :: * -> *). MonadThrow n => Text -> n r
f = m r -> (r -> m r) -> Maybe r -> m r
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m r
forall (f :: * -> *) a. Alternative f => f a
empty r -> m r
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe r -> m r) -> ([Word8] -> Maybe r) -> [Word8] -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe r
forall (n :: * -> *). MonadThrow n => Text -> n r
f (Text -> Maybe r) -> ([Word8] -> Text) -> [Word8] -> Maybe r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> ([Word8] -> ByteString) -> [Word8] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
B.pack
{-# INLINE liftR #-}

asciiAlphaChar :: MonadParsec e ByteString m => m Word8
asciiAlphaChar :: m Word8
asciiAlphaChar = (Token ByteString -> Bool) -> m (Token ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Word8 -> Bool
Token ByteString -> Bool
isAsciiAlpha m Word8 -> String -> m Word8
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 :: m Word8
asciiAlphaNumChar = (Token ByteString -> Bool) -> m (Token ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Word8 -> Bool
Token ByteString -> Bool
isAsciiAlphaNum m Word8 -> String -> m Word8
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 :: m Word8
unreservedChar = String -> m Word8 -> m Word8
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"unreserved character" (m Word8 -> m Word8)
-> ((Word8 -> Bool) -> m Word8) -> (Word8 -> Bool) -> m Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> m Word8
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy ((Word8 -> Bool) -> m Word8) -> (Word8 -> Bool) -> m Word8
forall a b. (a -> b) -> a -> b
$ \Word8
x ->
  Word8 -> Bool
isAsciiAlphaNum Word8
x Bool -> Bool -> Bool
|| Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
45 Bool -> Bool -> Bool
|| Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
46 Bool -> Bool -> Bool
|| Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
95 Bool -> Bool -> Bool
|| Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
126
{-# INLINE unreservedChar #-}

percentEncChar :: MonadParsec e ByteString m => m Word8
percentEncChar :: m Word8
percentEncChar = do
  m Word8 -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token ByteString -> m (Token ByteString)
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 (Word8 -> Word8) -> m Word8 -> m Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word8
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
hexDigitChar
  Word8
l <- Word8 -> Word8
restoreDigit (Word8 -> Word8) -> m Word8 -> m Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word8
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
hexDigitChar
  Word8 -> m Word8
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8
h Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
* Word8
16 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
l)
{-# INLINE percentEncChar #-}

subDelimChar :: MonadParsec e ByteString m => m Word8
subDelimChar :: m Word8
subDelimChar = Set (Token ByteString) -> m (Token ByteString)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf Set Word8
Set (Token ByteString)
s m Word8 -> String -> m Word8
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"sub-delimiter"
  where
    s :: Set Word8
s = [Word8] -> Set Word8
forall a. Ord a => [a] -> Set a
E.fromList (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord (Char -> Word8) -> String -> [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
"!$&'()*+,;=")
{-# INLINE subDelimChar #-}

pchar :: MonadParsec e ByteString m => m Word8
pchar :: m Word8
pchar =
  [m Word8] -> m Word8
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ m Word8
forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
unreservedChar,
      m Word8
forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
percentEncChar,
      m Word8
forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
subDelimChar,
      Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
58,
      Token ByteString -> m (Token ByteString)
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' :: m Word8
pchar' =
  [m Word8] -> m Word8
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
    [ m Word8
forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
unreservedChar,
      m Word8
forall e (m :: * -> *). MonadParsec e ByteString m => m Word8
percentEncChar,
      Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
43 m Word8 -> m Word8 -> m Word8
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> m Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word8
32,
      Set (Token ByteString) -> m (Token ByteString)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf Set Word8
Set (Token ByteString)
s m Word8 -> String -> m Word8
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"sub-delimiter",
      Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
58,
      Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
64
    ]
  where
    s :: Set Word8
s = [Word8] -> Set Word8
forall a. Ord a => [a] -> Set a
E.fromList (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord (Char -> Word8) -> String -> [Word8]
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 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
x Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
90 = Bool
True
  | Word8
97 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
x Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
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 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
x Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
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 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
x Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
57 = Word8
x Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
48
  | Word8
65 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
x Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
70 = Word8
x Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
55
  | Word8
97 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
x Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
102 = Word8
x Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
87
  | Bool
otherwise = String -> Word8
forall a. HasCallStack => String -> a
error String
"Text.URI.Parser.restoreDigit: bad input"