{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.URI.Parser.Text.Utils
( pHost
, asciiAlphaChar
, asciiAlphaNumChar
, unreservedChar
, percentEncChar
, subDelimChar
, pchar
, pchar' )
where
import Control.Monad
import Data.Char
import Data.List (intercalate)
import Data.Maybe (maybeToList)
import Data.Text (Text)
import Text.Megaparsec
import Text.Megaparsec.Char
import qualified Data.List.NonEmpty as NE
import qualified Data.Set as E
import qualified Data.Text as T
import qualified Text.Megaparsec.Char.Lexer as L
pHost :: MonadParsec e Text m
=> Bool
-> m String
pHost :: Bool -> m String
pHost pe :: Bool
pe = [m String] -> m String
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ m String -> m String
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m () -> m String
forall e (m :: * -> *) a. MonadParsec e Text m => m a -> m String
asConsumed m ()
ipLiteral)
, m String -> m String
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m () -> m String
forall e (m :: * -> *) a. MonadParsec e Text m => m a -> m String
asConsumed m ()
ipv4Address)
, m String
regName ]
where
asConsumed :: MonadParsec e Text m => m a -> m String
asConsumed :: m a -> m String
asConsumed p :: m a
p = Text -> String
T.unpack (Text -> String) -> ((Text, a) -> Text) -> (Text, a) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, a) -> Text
forall a b. (a, b) -> a
fst ((Text, a) -> String) -> m (Text, a) -> m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a -> m (Tokens Text, a)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
match m a
p
ipLiteral :: m ()
ipLiteral = m Char -> m Char -> m () -> m ()
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
'[') (Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
']') (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 :: Text
toks, x :: Integer
x) <- m Integer -> m (Tokens Text, 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 ~ Char, 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 Text))
-> Set (ErrorItem (Token Text)) -> m ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
Maybe (ErrorItem (Token s)) -> Set (ErrorItem (Token s)) -> m a
failure
((NonEmpty Char -> ErrorItem Char)
-> Maybe (NonEmpty Char) -> Maybe (ErrorItem Char)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty Char -> ErrorItem Char
forall t. NonEmpty t -> ErrorItem t
Tokens (Maybe (NonEmpty Char) -> Maybe (ErrorItem Char))
-> (Text -> Maybe (NonEmpty Char))
-> Text
-> Maybe (ErrorItem Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe (NonEmpty Char)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty (String -> Maybe (NonEmpty Char))
-> (Text -> String) -> Text -> Maybe (NonEmpty Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Maybe (ErrorItem (Token Text)))
-> Text -> Maybe (ErrorItem (Token Text))
forall a b. (a -> b) -> a -> b
$ Text
toks)
(ErrorItem Char -> Set (ErrorItem Char)
forall a. a -> Set a
E.singleton (ErrorItem Char -> Set (ErrorItem Char))
-> (String -> ErrorItem Char) -> String -> Set (ErrorItem Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Char -> ErrorItem Char
forall t. NonEmpty Char -> ErrorItem t
Label (NonEmpty Char -> ErrorItem Char)
-> (String -> NonEmpty Char) -> String -> ErrorItem Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> NonEmpty Char
forall a. [a] -> NonEmpty a
NE.fromList (String -> Set (ErrorItem (Token Text)))
-> String -> Set (ErrorItem (Token Text))
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 Char -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
'.') m [()] -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
octet
ipv6Address :: m ()
ipv6Address = do
Int
pos <- m Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
(toks :: Text
toks, xs :: [String]
xs) <- m [String] -> m (Text, [String])
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
match (m [String] -> m (Text, [String]))
-> m [String] -> m (Text, [String])
forall a b. (a -> b) -> a -> b
$ do
[String]
xs' <- Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList (Maybe String -> [String]) -> m (Maybe String) -> m [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m String -> m (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ([] String -> m Text -> m String
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string "::")
[String]
xs <- (m String -> m Char -> m [String])
-> m Char -> m String -> m [String]
forall a b c. (a -> b -> c) -> b -> a -> c
flip m String -> m Char -> m [String]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy1 (Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
':') (m String -> m [String]) -> m String -> m [String]
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 Char -> m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
':')
Bool
hasMore <- Bool -> m Bool -> m Bool
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
False (Bool
True Bool -> m Char -> m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
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) -> String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return []
(True, False) -> [] String -> m Char -> m String
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
':'
(False, _) -> Int -> Int -> m Char -> m String
forall (m :: * -> *) a. MonadPlus m => Int -> Int -> m a -> m [a]
count' 1 4 m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
hexDigitChar
[String] -> m [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String]
xs' [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
xs)
let nskips :: Int
nskips = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
xs)
npieces :: Int
npieces = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
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
pos
Maybe (ErrorItem (Token Text))
-> Set (ErrorItem (Token Text)) -> m ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
Maybe (ErrorItem (Token s)) -> Set (ErrorItem (Token s)) -> m a
failure
((NonEmpty Char -> ErrorItem Char)
-> Maybe (NonEmpty Char) -> Maybe (ErrorItem Char)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty Char -> ErrorItem Char
forall t. NonEmpty t -> ErrorItem t
Tokens (Maybe (NonEmpty Char) -> Maybe (ErrorItem Char))
-> (Text -> Maybe (NonEmpty Char))
-> Text
-> Maybe (ErrorItem Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe (NonEmpty Char)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty (String -> Maybe (NonEmpty Char))
-> (Text -> String) -> Text -> Maybe (NonEmpty Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Maybe (ErrorItem (Token Text)))
-> Text -> Maybe (ErrorItem (Token Text))
forall a b. (a -> b) -> a -> b
$ Text
toks)
(ErrorItem Char -> Set (ErrorItem Char)
forall a. a -> Set a
E.singleton (ErrorItem Char -> Set (ErrorItem Char))
-> (String -> ErrorItem Char) -> String -> Set (ErrorItem Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Char -> ErrorItem Char
forall t. NonEmpty Char -> ErrorItem t
Label (NonEmpty Char -> ErrorItem Char)
-> (String -> NonEmpty Char) -> String -> ErrorItem Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> NonEmpty Char
forall a. [a] -> NonEmpty a
NE.fromList (String -> Set (ErrorItem (Token Text)))
-> String -> Set (ErrorItem (Token Text))
forall a b. (a -> b) -> a -> b
$ "valid IPv6 address")
ipvFuture :: m ()
ipvFuture = do
m Char -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
'v')
m Char -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
hexDigitChar
m Char -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
'.')
m Char -> m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipSome (m Char
forall e (m :: * -> *). MonadParsec e Text m => m Char
unreservedChar m Char -> m Char -> m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Char
forall e (m :: * -> *). MonadParsec e Text m => m Char
subDelimChar m Char -> m Char -> m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
':')
regName :: m String
regName = ([String] -> String) -> m [String] -> m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate ".") (m [String] -> m String)
-> (m String -> m [String]) -> m String -> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m String -> m Char -> m [String])
-> m Char -> m String -> m [String]
forall a b c. (a -> b -> c) -> b -> a -> c
flip m String -> m Char -> m [String]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy1 (Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
'.') (m String -> m String) -> m String -> m String
forall a b. (a -> b) -> a -> b
$ do
let ch :: m Char
ch =
if Bool
pe
then m Char
forall e (m :: * -> *). MonadParsec e Text m => m Char
percentEncChar m Char -> m Char -> m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Char
forall e (m :: * -> *). MonadParsec e Text m => m Char
asciiAlphaNumChar
else m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar
Maybe Char
mx <- m Char -> m (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m Char
ch
case Maybe Char
mx of
Nothing -> String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return ""
Just x :: Char
x -> do
let r :: m Char
r = m Char
ch m Char -> m Char -> m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Char -> m Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try
(Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
'-' m Char -> m Char -> m Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (m Char -> m Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (m Char -> m Char) -> (m Char -> m Char) -> m Char -> m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m Char -> m Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try) (m Char
ch m Char -> m Char -> m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
'-'))
String
xs <- m Char -> m String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many m Char
r
String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
xs)
{-# INLINEABLE pHost #-}
asciiAlphaChar :: MonadParsec e Text m => m Char
asciiAlphaChar :: m Char
asciiAlphaChar = (Token Text -> Bool) -> m (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isAsciiAlpha m Char -> String -> m Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "ASCII alpha character"
{-# INLINE asciiAlphaChar #-}
asciiAlphaNumChar :: MonadParsec e Text m => m Char
asciiAlphaNumChar :: m Char
asciiAlphaNumChar = (Token Text -> Bool) -> m (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isAsciiAlphaNum m Char -> String -> m Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "ASCII alpha-numeric character"
{-# INLINE asciiAlphaNumChar #-}
unreservedChar :: MonadParsec e Text m => m Char
unreservedChar :: m Char
unreservedChar = String -> m Char -> m Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label "unreserved character" (m Char -> m Char)
-> ((Char -> Bool) -> m Char) -> (Char -> Bool) -> m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> m Char
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy ((Char -> Bool) -> m Char) -> (Char -> Bool) -> m Char
forall a b. (a -> b) -> a -> b
$ \x :: Char
x ->
Char -> Bool
isAsciiAlphaNum Char
x Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '-' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '.' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '_' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '~'
{-# INLINE unreservedChar #-}
percentEncChar :: MonadParsec e Text m => m Char
percentEncChar :: m Char
percentEncChar = do
m Char -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
'%')
Int
h <- Char -> Int
digitToInt (Char -> Int) -> m Char -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
hexDigitChar
Int
l <- Char -> Int
digitToInt (Char -> Int) -> m Char -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
hexDigitChar
Char -> m Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> m Char) -> (Int -> Char) -> Int -> m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
chr (Int -> m Char) -> Int -> m Char
forall a b. (a -> b) -> a -> b
$ Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
* 16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l
{-# INLINE percentEncChar #-}
subDelimChar :: MonadParsec e Text m => m Char
subDelimChar :: m Char
subDelimChar = Set (Token Text) -> m (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf Set Char
Set (Token Text)
s m Char -> String -> m Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "sub-delimiter"
where
s :: Set Char
s = String -> Set Char
forall a. Ord a => [a] -> Set a
E.fromList "!$&'()*+,;="
{-# INLINE subDelimChar #-}
pchar :: MonadParsec e Text m => m Char
pchar :: m Char
pchar = [m Char] -> m Char
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ m Char
forall e (m :: * -> *). MonadParsec e Text m => m Char
unreservedChar
, m Char
forall e (m :: * -> *). MonadParsec e Text m => m Char
percentEncChar
, m Char
forall e (m :: * -> *). MonadParsec e Text m => m Char
subDelimChar
, Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
':'
, Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
'@' ]
{-# INLINE pchar #-}
pchar' :: MonadParsec e Text m => m Char
pchar' :: m Char
pchar' = [m Char] -> m Char
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ m Char
forall e (m :: * -> *). MonadParsec e Text m => m Char
unreservedChar
, m Char
forall e (m :: * -> *). MonadParsec e Text m => m Char
percentEncChar
, Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
'+' m Char -> m Char -> m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> m Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure ' '
, Set (Token Text) -> m (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf Set Char
Set (Token Text)
s m Char -> String -> m Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> "sub-delimiter"
, Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
':'
, Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Token Text
'@' ]
where
s :: Set Char
s = String -> Set Char
forall a. Ord a => [a] -> Set a
E.fromList "!$'()*,;"
{-# INLINE pchar' #-}
isAsciiAlpha :: Char -> Bool
isAsciiAlpha :: Char -> Bool
isAsciiAlpha x :: Char
x = Char -> Bool
isAscii Char
x Bool -> Bool -> Bool
&& Char -> Bool
isAlpha Char
x
isAsciiAlphaNum :: Char -> Bool
isAsciiAlphaNum :: Char -> Bool
isAsciiAlphaNum x :: Char
x = Char -> Bool
isAscii Char
x Bool -> Bool -> Bool
&& Char -> Bool
isAlphaNum Char
x