{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}

module Text.Email.Parser
    ( addrSpec
    , localPart
    , domainPart
    , EmailAddress
    , unsafeEmailAddress
    , toByteString
    )
where

import           Control.Applicative
import           Control.Monad (guard, void, when)
import           Data.Attoparsec.ByteString.Char8
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS
import           Data.Data (Data, Typeable)
import           GHC.Generics (Generic)
import qualified Text.Read as Read

-- | Represents an email address.

data EmailAddress = EmailAddress ByteString ByteString
    deriving (EmailAddress -> EmailAddress -> Bool
(EmailAddress -> EmailAddress -> Bool)
-> (EmailAddress -> EmailAddress -> Bool) -> Eq EmailAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmailAddress -> EmailAddress -> Bool
$c/= :: EmailAddress -> EmailAddress -> Bool
== :: EmailAddress -> EmailAddress -> Bool
$c== :: EmailAddress -> EmailAddress -> Bool
Eq, Eq EmailAddress
Eq EmailAddress
-> (EmailAddress -> EmailAddress -> Ordering)
-> (EmailAddress -> EmailAddress -> Bool)
-> (EmailAddress -> EmailAddress -> Bool)
-> (EmailAddress -> EmailAddress -> Bool)
-> (EmailAddress -> EmailAddress -> Bool)
-> (EmailAddress -> EmailAddress -> EmailAddress)
-> (EmailAddress -> EmailAddress -> EmailAddress)
-> Ord EmailAddress
EmailAddress -> EmailAddress -> Bool
EmailAddress -> EmailAddress -> Ordering
EmailAddress -> EmailAddress -> EmailAddress
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EmailAddress -> EmailAddress -> EmailAddress
$cmin :: EmailAddress -> EmailAddress -> EmailAddress
max :: EmailAddress -> EmailAddress -> EmailAddress
$cmax :: EmailAddress -> EmailAddress -> EmailAddress
>= :: EmailAddress -> EmailAddress -> Bool
$c>= :: EmailAddress -> EmailAddress -> Bool
> :: EmailAddress -> EmailAddress -> Bool
$c> :: EmailAddress -> EmailAddress -> Bool
<= :: EmailAddress -> EmailAddress -> Bool
$c<= :: EmailAddress -> EmailAddress -> Bool
< :: EmailAddress -> EmailAddress -> Bool
$c< :: EmailAddress -> EmailAddress -> Bool
compare :: EmailAddress -> EmailAddress -> Ordering
$ccompare :: EmailAddress -> EmailAddress -> Ordering
$cp1Ord :: Eq EmailAddress
Ord, Typeable EmailAddress
DataType
Constr
Typeable EmailAddress
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> EmailAddress -> c EmailAddress)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c EmailAddress)
-> (EmailAddress -> Constr)
-> (EmailAddress -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c EmailAddress))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c EmailAddress))
-> ((forall b. Data b => b -> b) -> EmailAddress -> EmailAddress)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> EmailAddress -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> EmailAddress -> r)
-> (forall u. (forall d. Data d => d -> u) -> EmailAddress -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> EmailAddress -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> EmailAddress -> m EmailAddress)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> EmailAddress -> m EmailAddress)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> EmailAddress -> m EmailAddress)
-> Data EmailAddress
EmailAddress -> DataType
EmailAddress -> Constr
(forall b. Data b => b -> b) -> EmailAddress -> EmailAddress
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EmailAddress -> c EmailAddress
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EmailAddress
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> EmailAddress -> u
forall u. (forall d. Data d => d -> u) -> EmailAddress -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EmailAddress -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EmailAddress -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EmailAddress -> m EmailAddress
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EmailAddress -> m EmailAddress
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EmailAddress
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EmailAddress -> c EmailAddress
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EmailAddress)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EmailAddress)
$cEmailAddress :: Constr
$tEmailAddress :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> EmailAddress -> m EmailAddress
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EmailAddress -> m EmailAddress
gmapMp :: (forall d. Data d => d -> m d) -> EmailAddress -> m EmailAddress
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EmailAddress -> m EmailAddress
gmapM :: (forall d. Data d => d -> m d) -> EmailAddress -> m EmailAddress
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EmailAddress -> m EmailAddress
gmapQi :: Int -> (forall d. Data d => d -> u) -> EmailAddress -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> EmailAddress -> u
gmapQ :: (forall d. Data d => d -> u) -> EmailAddress -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> EmailAddress -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EmailAddress -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EmailAddress -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EmailAddress -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EmailAddress -> r
gmapT :: (forall b. Data b => b -> b) -> EmailAddress -> EmailAddress
$cgmapT :: (forall b. Data b => b -> b) -> EmailAddress -> EmailAddress
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EmailAddress)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EmailAddress)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c EmailAddress)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EmailAddress)
dataTypeOf :: EmailAddress -> DataType
$cdataTypeOf :: EmailAddress -> DataType
toConstr :: EmailAddress -> Constr
$ctoConstr :: EmailAddress -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EmailAddress
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EmailAddress
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EmailAddress -> c EmailAddress
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EmailAddress -> c EmailAddress
$cp1Data :: Typeable EmailAddress
Data, Typeable, (forall x. EmailAddress -> Rep EmailAddress x)
-> (forall x. Rep EmailAddress x -> EmailAddress)
-> Generic EmailAddress
forall x. Rep EmailAddress x -> EmailAddress
forall x. EmailAddress -> Rep EmailAddress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EmailAddress x -> EmailAddress
$cfrom :: forall x. EmailAddress -> Rep EmailAddress x
Generic)

-- | Creates an email address without validating it.

--   You should only use this when reading data from

--   somewhere it has already been validated (e.g. a

--   database).

unsafeEmailAddress :: ByteString -> ByteString -> EmailAddress
unsafeEmailAddress :: ByteString -> ByteString -> EmailAddress
unsafeEmailAddress = ByteString -> ByteString -> EmailAddress
EmailAddress

instance Show EmailAddress where
    show :: EmailAddress -> String
show = ByteString -> String
forall a. Show a => a -> String
show (ByteString -> String)
-> (EmailAddress -> ByteString) -> EmailAddress -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EmailAddress -> ByteString
toByteString

instance Read EmailAddress where
    readListPrec :: ReadPrec [EmailAddress]
readListPrec = ReadPrec [EmailAddress]
forall a. Read a => ReadPrec [a]
Read.readListPrecDefault
    readPrec :: ReadPrec EmailAddress
readPrec = ReadPrec EmailAddress -> ReadPrec EmailAddress
forall a. ReadPrec a -> ReadPrec a
Read.parens (do
        ByteString
bs <- ReadPrec ByteString
forall a. Read a => ReadPrec a
Read.readPrec
        case Parser EmailAddress -> ByteString -> Either String EmailAddress
forall a. Parser a -> ByteString -> Either String a
parseOnly (Parser EmailAddress
addrSpec Parser EmailAddress -> Parser ByteString () -> Parser EmailAddress
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
endOfInput) ByteString
bs of
            Left  String
_ -> ReadPrec EmailAddress
forall a. ReadPrec a
Read.pfail
            Right EmailAddress
a -> EmailAddress -> ReadPrec EmailAddress
forall (m :: * -> *) a. Monad m => a -> m a
return EmailAddress
a)

-- | Converts an email address back to a ByteString

toByteString :: EmailAddress -> ByteString
toByteString :: EmailAddress -> ByteString
toByteString (EmailAddress ByteString
l ByteString
d) = [ByteString] -> ByteString
BS.concat [ByteString
l, Char -> ByteString
BS.singleton Char
'@', ByteString
d]

-- | Extracts the local part of an email address.

localPart :: EmailAddress -> ByteString
localPart :: EmailAddress -> ByteString
localPart (EmailAddress ByteString
l ByteString
_) = ByteString
l

-- | Extracts the domain part of an email address.

domainPart :: EmailAddress -> ByteString
domainPart :: EmailAddress -> ByteString
domainPart (EmailAddress ByteString
_ ByteString
d) = ByteString
d

-- | A parser for email addresses.

addrSpec :: Parser EmailAddress
addrSpec :: Parser EmailAddress
addrSpec = do
    ByteString
l <- Parser ByteString
local

    -- Maximum length of local-part is 64, per RFC3696

    Bool -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int
BS.length ByteString
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
64) (String -> Parser ByteString ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"local-part of email is too long (more than 64 octets)")

    Char
_ <- Char -> Parser Char
char Char
'@' Parser Char -> String -> Parser Char
forall i a. Parser i a -> String -> Parser i a
<?> String
"at sign"
    ByteString
d <- Parser ByteString
domain

    -- Maximum length is 254, per Erratum 1690 on RFC3696

    Bool -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int
BS.length ByteString
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
BS.length ByteString
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
254) (String -> Parser ByteString ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"email address is too long (more than 254 octets)")

    EmailAddress -> Parser EmailAddress
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ByteString -> EmailAddress
unsafeEmailAddress ByteString
l ByteString
d)

local :: Parser ByteString
local :: Parser ByteString
local = Parser ByteString
dottedAtoms

domain :: Parser ByteString
domain :: Parser ByteString
domain = Parser ByteString
domainName Parser ByteString -> Parser ByteString -> Parser ByteString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString
domainLiteral

domainName :: Parser ByteString
domainName :: Parser ByteString
domainName = do
    ByteString
parsedDomain <- ByteString -> [ByteString] -> ByteString
BS.intercalate (Char -> ByteString
BS.singleton Char
'.') ([ByteString] -> ByteString)
-> Parser ByteString [ByteString] -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Parser ByteString
domainLabel Parser ByteString -> Parser Char -> Parser ByteString [ByteString]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy1` Char -> Parser Char
char Char
'.' Parser ByteString
-> Parser ByteString (Maybe Char) -> Parser ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char -> Parser ByteString (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser Char
char Char
'.')

    -- Domain name must be no greater than 253 chars, per RFC1035

    Bool -> Parser ByteString ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteString -> Int
BS.length ByteString
parsedDomain Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
253)
    ByteString -> Parser ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
parsedDomain

domainLabel :: Parser ByteString
domainLabel :: Parser ByteString
domainLabel = do
    ByteString
content <- Parser ByteString (Maybe ())
-> Parser ByteString -> Parser ByteString
forall (f :: * -> *) lr a. Applicative f => f lr -> f a -> f a
between1 (Parser ByteString () -> Parser ByteString (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString ()
cfws) ((ByteString, ()) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, ()) -> ByteString)
-> Parser ByteString (ByteString, ()) -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString () -> Parser ByteString (ByteString, ())
forall a. Parser a -> Parser (ByteString, a)
match (Parser Char
alphaNum Parser Char -> Parser ByteString () -> Parser ByteString ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Char -> Bool) -> Parser ByteString ()
skipWhile Char -> Bool
isAlphaNumHyphen))

    -- Per RFC1035:

    -- label must be no greater than 63 chars and cannot end with '-'

    -- (we already enforced that it does not start with '-')

    Bool -> Parser ByteString ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteString -> Int
BS.length ByteString
content Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
63 Bool -> Bool -> Bool
&& ByteString -> Char
BS.last ByteString
content Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-')
    ByteString -> Parser ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
content

alphaNum :: Parser Char
alphaNum :: Parser Char
alphaNum = (Char -> Bool) -> Parser Char
satisfy Char -> Bool
isAlphaNum

isAlphaNumHyphen :: Char -> Bool
isAlphaNumHyphen :: Char -> Bool
isAlphaNumHyphen Char
x = Char -> Bool
isDigit Char
x Bool -> Bool -> Bool
|| Char -> Bool
isAlpha_ascii Char
x Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'

dottedAtoms :: Parser ByteString
dottedAtoms :: Parser ByteString
dottedAtoms = ByteString -> [ByteString] -> ByteString
BS.intercalate (Char -> ByteString
BS.singleton Char
'.') ([ByteString] -> ByteString)
-> Parser ByteString [ByteString] -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Parser ByteString (Maybe ())
-> Parser ByteString -> Parser ByteString
forall (f :: * -> *) lr a. Applicative f => f lr -> f a -> f a
between1 (Parser ByteString () -> Parser ByteString (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString ()
cfws)
            (Parser ByteString
atom Parser ByteString -> Parser ByteString -> Parser ByteString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString
quotedString) Parser ByteString -> Parser Char -> Parser ByteString [ByteString]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy1` Char -> Parser Char
char Char
'.'

atom :: Parser ByteString
atom :: Parser ByteString
atom = (Char -> Bool) -> Parser ByteString
takeWhile1 Char -> Bool
isAtomText

isAtomText :: Char -> Bool
isAtomText :: Char -> Bool
isAtomText Char
x = Char -> Bool
isAlphaNum Char
x Bool -> Bool -> Bool
|| String -> Char -> Bool
inClass String
"!#$%&'*+/=?^_`{|}~-" Char
x

domainLiteral :: Parser ByteString
domainLiteral :: Parser ByteString
domainLiteral =
    (Char -> ByteString -> ByteString
BS.cons Char
'[' (ByteString -> ByteString)
-> ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Char -> ByteString)
-> Char -> ByteString -> ByteString
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> Char -> ByteString
BS.snoc Char
']' (ByteString -> ByteString)
-> ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
BS.concat) ([ByteString] -> ByteString)
-> Parser ByteString [ByteString] -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Parser Char
-> Parser Char
-> Parser ByteString [ByteString]
-> Parser ByteString [ByteString]
forall (f :: * -> *) l r a.
Applicative f =>
f l -> f r -> f a -> f a
between (Parser ByteString () -> Parser ByteString (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString ()
cfws Parser ByteString (Maybe ()) -> Parser Char -> Parser Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Char
char Char
'[') (Char -> Parser Char
char Char
']' Parser Char -> Parser ByteString (Maybe ()) -> Parser Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString () -> Parser ByteString (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString ()
cfws)
            (Parser ByteString -> Parser ByteString [ByteString]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser ByteString () -> Parser ByteString (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString ()
fws Parser ByteString (Maybe ())
-> Parser ByteString -> Parser ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Char -> Bool) -> Parser ByteString
takeWhile1 Char -> Bool
isDomainText) Parser ByteString [ByteString]
-> Parser ByteString (Maybe ()) -> Parser ByteString [ByteString]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString () -> Parser ByteString (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString ()
fws)

isDomainText :: Char -> Bool
isDomainText :: Char -> Bool
isDomainText Char
x = String -> Char -> Bool
inClass String
"\33-\90\94-\126" Char
x Bool -> Bool -> Bool
|| Char -> Bool
isObsNoWsCtl Char
x

quotedString :: Parser ByteString
quotedString :: Parser ByteString
quotedString =
    (Char -> ByteString -> ByteString
BS.cons Char
'"' (ByteString -> ByteString)
-> ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Char -> ByteString)
-> Char -> ByteString -> ByteString
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> Char -> ByteString
BS.snoc Char
'"' (ByteString -> ByteString)
-> ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
BS.concat) ([ByteString] -> ByteString)
-> Parser ByteString [ByteString] -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Parser Char
-> Parser ByteString [ByteString] -> Parser ByteString [ByteString]
forall (f :: * -> *) lr a. Applicative f => f lr -> f a -> f a
between1 (Char -> Parser Char
char Char
'"')
            (Parser ByteString -> Parser ByteString [ByteString]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser ByteString () -> Parser ByteString (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString ()
fws Parser ByteString (Maybe ())
-> Parser ByteString -> Parser ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString
quotedContent) Parser ByteString [ByteString]
-> Parser ByteString (Maybe ()) -> Parser ByteString [ByteString]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString () -> Parser ByteString (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString ()
fws)

quotedContent :: Parser ByteString
quotedContent :: Parser ByteString
quotedContent = (Char -> Bool) -> Parser ByteString
takeWhile1 Char -> Bool
isQuotedText Parser ByteString -> Parser ByteString -> Parser ByteString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString
quotedPair

isQuotedText :: Char -> Bool
isQuotedText :: Char -> Bool
isQuotedText Char
x = String -> Char -> Bool
inClass String
"\33\35-\91\93-\126" Char
x Bool -> Bool -> Bool
|| Char -> Bool
isObsNoWsCtl Char
x

quotedPair :: Parser ByteString
quotedPair :: Parser ByteString
quotedPair = (Char -> ByteString -> ByteString
BS.cons Char
'\\' (ByteString -> ByteString)
-> (Char -> ByteString) -> Char -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString
BS.singleton) (Char -> ByteString) -> Parser Char -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Char
char Char
'\\' Parser Char -> Parser Char -> Parser Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser Char
vchar Parser Char -> Parser Char -> Parser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Char
wsp Parser Char -> Parser Char -> Parser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Char
lf Parser Char -> Parser Char -> Parser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Char
cr Parser Char -> Parser Char -> Parser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Char
obsNoWsCtl Parser Char -> Parser Char -> Parser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Char
nullChar))

cfws :: Parser ()
cfws :: Parser ByteString ()
cfws = Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany (Parser ByteString ()
comment Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ()
fws)

fws :: Parser ()
fws :: Parser ByteString ()
fws = Parser ByteString (Maybe ()) -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString ()
wsp1 Parser ByteString ()
-> Parser ByteString (Maybe ()) -> Parser ByteString (Maybe ())
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString () -> Parser ByteString (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString ()
crlf Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString ()
wsp1)) Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany1 (Parser ByteString ()
crlf Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString ()
wsp1))

between :: Applicative f => f l -> f r -> f a -> f a
between :: f l -> f r -> f a -> f a
between f l
l f r
r f a
x = f l
l f l -> f a -> f a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f a
x f a -> f r -> f a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* f r
r

between1 :: Applicative f => f lr -> f a -> f a
between1 :: f lr -> f a -> f a
between1 f lr
lr f a
x = f lr
lr f lr -> f a -> f a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f a
x f a -> f lr -> f a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* f lr
lr

comment :: Parser ()
comment :: Parser ByteString ()
comment = Parser Char
-> Parser Char -> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) l r a.
Applicative f =>
f l -> f r -> f a -> f a
between (Char -> Parser Char
char Char
'(') (Char -> Parser Char
char Char
')') (Parser ByteString () -> Parser ByteString ())
-> Parser ByteString () -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a. Alternative f => f a -> f ()
skipMany (Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser ByteString ()
commentContent Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ()
fws)

commentContent :: Parser ()
commentContent :: Parser ByteString ()
commentContent = (Char -> Bool) -> Parser ByteString ()
skipWhile1 Char -> Bool
isCommentText Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser ByteString
quotedPair Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ()
comment

isCommentText :: Char -> Bool
isCommentText :: Char -> Bool
isCommentText Char
x = String -> Char -> Bool
inClass String
"\33-\39\42-\91\93-\126" Char
x Bool -> Bool -> Bool
|| Char -> Bool
isObsNoWsCtl Char
x

nullChar :: Parser Char
nullChar :: Parser Char
nullChar = Char -> Parser Char
char Char
'\0'

skipWhile1 :: (Char -> Bool) -> Parser()
skipWhile1 :: (Char -> Bool) -> Parser ByteString ()
skipWhile1 Char -> Bool
x = (Char -> Bool) -> Parser Char
satisfy Char -> Bool
x Parser Char -> Parser ByteString () -> Parser ByteString ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Char -> Bool) -> Parser ByteString ()
skipWhile Char -> Bool
x

wsp1 :: Parser ()
wsp1 :: Parser ByteString ()
wsp1 = (Char -> Bool) -> Parser ByteString ()
skipWhile1 Char -> Bool
isWsp

wsp :: Parser Char
wsp :: Parser Char
wsp = (Char -> Bool) -> Parser Char
satisfy Char -> Bool
isWsp

isWsp :: Char -> Bool
isWsp :: Char -> Bool
isWsp Char
x = Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t'

isAlphaNum :: Char -> Bool
isAlphaNum :: Char -> Bool
isAlphaNum Char
x = Char -> Bool
isDigit Char
x Bool -> Bool -> Bool
|| Char -> Bool
isAlpha_ascii Char
x

cr :: Parser Char
cr :: Parser Char
cr = Char -> Parser Char
char Char
'\r'

lf :: Parser Char
lf :: Parser Char
lf = Char -> Parser Char
char Char
'\n'

crlf :: Parser ()
crlf :: Parser ByteString ()
crlf = Parser Char -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Char -> Parser ByteString ())
-> Parser Char -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ Parser Char
cr Parser Char -> Parser Char -> Parser Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Char
lf

isVchar :: Char -> Bool
isVchar :: Char -> Bool
isVchar = String -> Char -> Bool
inClass String
"\x21-\x7e"

vchar :: Parser Char
vchar :: Parser Char
vchar = (Char -> Bool) -> Parser Char
satisfy Char -> Bool
isVchar

isObsNoWsCtl :: Char -> Bool
isObsNoWsCtl :: Char -> Bool
isObsNoWsCtl = String -> Char -> Bool
inClass String
"\1-\8\11-\12\14-\31\127"

obsNoWsCtl :: Parser Char
obsNoWsCtl :: Parser Char
obsNoWsCtl = (Char -> Bool) -> Parser Char
satisfy Char -> Bool
isObsNoWsCtl