-- |
-- 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.

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

module Text.URI.Parser.ByteString
  ( parserBs )
where

import Control.Monad
import Control.Monad.Catch (MonadThrow (..))
import Control.Monad.State.Strict
import Data.ByteString (ByteString)
import Data.Char
import Data.List (intercalate)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe (isJust, catMaybes, maybeToList)
import Data.Text (Text)
import Data.Void
import Data.Word (Word8)
import Text.Megaparsec
import Text.Megaparsec.Byte
import Text.URI.Types hiding (pHost)
import qualified Data.ByteString            as B
import qualified Data.List.NonEmpty         as NE
import qualified Data.Set                   as E
import qualified Data.Text.Encoding         as TE
import qualified Text.Megaparsec.Byte.Lexer as L

-- | 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
  (absPath :: Bool
absPath, uriPath :: 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 {..}
{-# 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 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 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 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 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
xWord8 -> [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 "//")
  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 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 {..}
{-# 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 p :: 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 91) (Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char 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
      (toks :: ByteString
toks, x :: 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
>= (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 (Token ByteString)))
-> ByteString -> Maybe (ErrorItem (Token ByteString))
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))
-> ([Char] -> ErrorItem Word8) -> [Char] -> 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)
-> ([Char] -> NonEmpty Char) -> [Char] -> ErrorItem Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> NonEmpty Char
forall a. [a] -> NonEmpty a
NE.fromList ([Char] -> Set (ErrorItem (Token ByteString)))
-> [Char] -> Set (ErrorItem (Token ByteString))
forall a b. (a -> b) -> a -> b
$ "decimal number from 0 to 255")
    ipv4Address :: m ()
ipv4Address =
      Int -> m () -> m [()]
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count 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 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
      (toks :: ByteString
toks, xs :: [[Word8]]
xs) <- m [[Word8]] -> m (ByteString, [[Word8]])
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
match (m [[Word8]] -> m (ByteString, [[Word8]]))
-> m [[Word8]] -> m (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 "::")
        [[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 58) (m [Word8] -> m [[Word8]]) -> m [Word8] -> m [[Word8]]
forall a b. (a -> b) -> a -> b
$ do
          (skip :: Bool
skip, hasMore :: 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 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
            (True,  True)  -> [Word8] -> m [Word8]
forall (m :: * -> *) a. Monad m => a -> m a
return []
            (True,  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 58
            (False, _)     -> Int -> Int -> m Word8 -> m [Word8]
forall (m :: * -> *) a. MonadPlus m => Int -> Int -> m a -> m [a]
count' 1 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
< 2 Bool -> Bool -> Bool
&& (Int
npieces Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 8 Bool -> Bool -> Bool
|| (Int
nskips Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 Bool -> Bool -> Bool
&& Int
npieces Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 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 (Token ByteString)))
-> ByteString -> Maybe (ErrorItem (Token ByteString))
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))
-> ([Char] -> ErrorItem Word8) -> [Char] -> 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)
-> ([Char] -> NonEmpty Char) -> [Char] -> ErrorItem Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> NonEmpty Char
forall a. [a] -> NonEmpty a
NE.fromList ([Char] -> Set (ErrorItem (Token ByteString)))
-> [Char] -> Set (ErrorItem (Token ByteString))
forall a b. (a -> b) -> a -> b
$ "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 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 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 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 [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 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
        Nothing -> [Word8] -> m [Word8]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        Just x :: 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 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 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
xWord8 -> [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 <- [Char] -> m (RText 'Username) -> m (RText 'Username)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label "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 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 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 64)
  UserInfo -> m UserInfo
forall (m :: * -> *) a. Monad m => a -> m a
return UserInfo :: RText 'Username -> Maybe (RText 'Password) -> UserInfo
UserInfo {..}
{-# 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 hasAuth :: 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 "//"))
  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) [47,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 47)
  (rawPieces :: [[Word8]]
rawPieces, trailingSlash :: 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 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
. [Char] -> StateT Bool m [Word8] -> StateT Bool m [Word8]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label "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
        Nothing -> Maybe (Bool, NonEmpty (RText 'PathPiece))
forall a. Maybe a
Nothing
        Just ps :: 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 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 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 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
. [Char] -> m (Maybe QueryParam) -> m (Maybe QueryParam)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label "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 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 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 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
             Nothing -> QueryParam -> m QueryParam
forall (m :: * -> *) a. Monad m => a -> m a
return (RText 'QueryKey -> QueryParam
QueryFlag RText 'QueryKey
k)
             Just v :: [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 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
. [Char] -> m Word8 -> m Word8
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label "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 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 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 f :: 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 -> [Char] -> m Word8
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> "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 -> [Char] -> m Word8
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> "ASCII alpha-numeric character"
{-# INLINE asciiAlphaNumChar #-}

unreservedChar :: MonadParsec e ByteString m => m Word8
unreservedChar :: m Word8
unreservedChar = [Char] -> m Word8 -> m Word8
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
label "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
$ \x :: Word8
x ->
  Word8 -> Bool
isAsciiAlphaNum Word8
x Bool -> Bool -> Bool
|| Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 45 Bool -> Bool -> Bool
|| Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 46 Bool -> Bool -> Bool
|| Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 95 Bool -> Bool -> Bool
|| Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 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 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
* 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 -> [Char] -> m Word8
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> "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) -> [Char] -> [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> "!$&'()*+,;=")
{-# 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 58
  , Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char 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 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 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 -> [Char] -> m Word8
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> [Char] -> m a
<?> "sub-delimiter"
  , Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char 58
  , Token ByteString -> m (Token ByteString)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char 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) -> [Char] -> [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> "!$'()*,;")
{-# INLINE pchar' #-}

isAsciiAlpha :: Word8 -> Bool
isAsciiAlpha :: Word8 -> Bool
isAsciiAlpha x :: Word8
x
  | 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
<= 90  = Bool
True
  | 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
<= 122 = Bool
True
  | Bool
otherwise           = Bool
False

isAsciiAlphaNum :: Word8 -> Bool
isAsciiAlphaNum :: Word8 -> Bool
isAsciiAlphaNum x :: Word8
x
  | Word8 -> Bool
isAsciiAlpha Word8
x     = Bool
True
  | 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
<= 57 = Bool
True
  | Bool
otherwise          = Bool
False

restoreDigit :: Word8 -> Word8
restoreDigit :: Word8 -> Word8
restoreDigit x :: Word8
x
  | 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
<= 57  = Word8
x Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- 48
  | 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
<= 70  = Word8
x Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- 55
  | 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
<= 102 = Word8
x Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- 87
  | Bool
otherwise           = [Char] -> Word8
forall a. HasCallStack => [Char] -> a
error "Text.URI.Parser.restoreDigit: bad input"