{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 800
{-# LANGUAGE TemplateHaskellQuotes #-}
#else
{-# LANGUAGE TemplateHaskell #-}
#endif

module Text.Email.QuasiQuotation
    ( email
    ) where

import qualified Data.ByteString.Char8 as BS8

import Language.Haskell.TH.Quote (QuasiQuoter(..))

import Text.Email.Validate (validate, localPart, domainPart, unsafeEmailAddress)

-- | A QuasiQuoter for email addresses. 
--
-- Use it like this:
-- 
-- >>> :set -XQuasiQuotes
-- >>> [email|someone@example.com|]
-- "someone@example.com"
email :: QuasiQuoter
email :: QuasiQuoter
email = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
    { quoteExp :: String -> Q Exp
quoteExp = (EmailAddress -> Q Exp) -> String -> Q Exp
forall p. (EmailAddress -> p) -> String -> p
quoteEmail EmailAddress -> Q Exp
emailToExp
    , quotePat :: String -> Q Pat
quotePat = String -> String -> Q Pat
forall a. HasCallStack => String -> a
error String
"email is not supported as a pattern"
    , quoteDec :: String -> Q [Dec]
quoteDec = String -> String -> Q [Dec]
forall a. HasCallStack => String -> a
error String
"email is not supported at top-level"
    , quoteType :: String -> Q Type
quoteType = String -> String -> Q Type
forall a. HasCallStack => String -> a
error String
"email is not supported as a type"
    }
    where

    quoteEmail :: (EmailAddress -> p) -> String -> p
quoteEmail EmailAddress -> p
p String
s = 
        case ByteString -> Either String EmailAddress
validate (String -> ByteString
BS8.pack String
s) of 
            Left String
err -> String -> p
forall a. HasCallStack => String -> a
error (String
"Invalid quasi-quoted email address: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err) 
            Right EmailAddress
e -> EmailAddress -> p
p EmailAddress
e

    emailToExp :: EmailAddress -> Q Exp
emailToExp EmailAddress
e = 
        let lp :: String
lp = ByteString -> String
BS8.unpack (EmailAddress -> ByteString
localPart EmailAddress
e) in
        let dp :: String
dp = ByteString -> String
BS8.unpack (EmailAddress -> ByteString
domainPart EmailAddress
e) in
        [| unsafeEmailAddress (BS8.pack lp) (BS8.pack dp) |]