module Text.Email.Validate
    ( isValid
    , validate
    , emailAddress
    , canonicalizeEmail

    -- Re-exports:
    , EmailAddress
    , domainPart
    , localPart
    , toByteString
    , unsafeEmailAddress
    )
where

import Data.Attoparsec.ByteString (endOfInput, parseOnly)
import Data.ByteString (ByteString)

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

-- | Smart constructor for an email address
emailAddress :: ByteString -> Maybe EmailAddress
emailAddress :: ByteString -> Maybe EmailAddress
emailAddress = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String EmailAddress
validate

-- | Checks that an email is valid and returns a version of it
--   where comments and whitespace have been removed.
--
-- Example (requires `OverloadedStrings` to be enabled):
--
-- >>> canonicalizeEmail "spaces. are. allowed@example.com"
-- Just "spaces.are.allowed@example.com"
canonicalizeEmail :: ByteString -> Maybe ByteString
canonicalizeEmail :: ByteString -> Maybe ByteString
canonicalizeEmail = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EmailAddress -> ByteString
toByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe EmailAddress
emailAddress

-- | Validates whether a particular string is an email address
--   according to RFC5322.
isValid :: ByteString -> Bool
isValid :: ByteString -> Bool
isValid = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const Bool
False) (forall a b. a -> b -> a
const Bool
True) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String EmailAddress
validate

-- | If you want to find out *why* a particular string is not
--   an email address, use this.
--
-- Examples (both require `OverloadedStrings` to be enabled):
--
-- >>> validate "example@example.com"
-- Right "example@example.com"
--
-- >>> validate "not.good"
-- Left "at sign > @: not enough input"
validate :: ByteString -> Either String EmailAddress
validate :: ByteString -> Either String EmailAddress
validate = forall a. Parser a -> ByteString -> Either String a
parseOnly (Parser ByteString EmailAddress
addrSpec forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \EmailAddress
r -> forall t. Chunk t => Parser t ()
endOfInput forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return EmailAddress
r)