{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-}

module OpenSuse.Types.EMailAddress
  ( EMailAddress, mkEMailAddress, unEMailAddress
  )
  where

import OpenSuse.Prelude
import OpenSuse.Prelude.PrettyPrinting as Pretty
import Text.Parsec.Rfc2822 ( addr_spec )

-- |
--
-- >>> mkEMailAddress " accept . full (rfc822) . syntax @ example . org "
-- Just (EMailAddress "accept.full.syntax@example.org")
--
-- >>> mkEMailAddress "@this@is@not@good@"
-- Nothing
--
-- >>> prettyShow (fromString "joe @ example.net" :: EMailAddress)
-- "joe@example.net"
newtype EMailAddress = EMailAddress String
  deriving (Int -> EMailAddress -> ShowS
[EMailAddress] -> ShowS
EMailAddress -> String
(Int -> EMailAddress -> ShowS)
-> (EMailAddress -> String)
-> ([EMailAddress] -> ShowS)
-> Show EMailAddress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EMailAddress] -> ShowS
$cshowList :: [EMailAddress] -> ShowS
show :: EMailAddress -> String
$cshow :: EMailAddress -> String
showsPrec :: Int -> EMailAddress -> ShowS
$cshowsPrec :: Int -> EMailAddress -> ShowS
Show, 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, (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, Eq EMailAddress
Eq EMailAddress
-> (Int -> EMailAddress -> Int)
-> (EMailAddress -> Int)
-> Hashable EMailAddress
Int -> EMailAddress -> Int
EMailAddress -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: EMailAddress -> Int
$chash :: EMailAddress -> Int
hashWithSalt :: Int -> EMailAddress -> Int
$chashWithSalt :: Int -> EMailAddress -> Int
$cp1Hashable :: Eq EMailAddress
Hashable, Get EMailAddress
[EMailAddress] -> Put
EMailAddress -> Put
(EMailAddress -> Put)
-> Get EMailAddress
-> ([EMailAddress] -> Put)
-> Binary EMailAddress
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [EMailAddress] -> Put
$cputList :: [EMailAddress] -> Put
get :: Get EMailAddress
$cget :: Get EMailAddress
put :: EMailAddress -> Put
$cput :: EMailAddress -> Put
Binary, EMailAddress -> ()
(EMailAddress -> ()) -> NFData EMailAddress
forall a. (a -> ()) -> NFData a
rnf :: EMailAddress -> ()
$crnf :: EMailAddress -> ()
NFData)

-- | Constructor function for e-mail addresses. Returns 'Nothing' if the input
-- is syntactically invalid.
mkEMailAddress :: String -> Maybe EMailAddress
mkEMailAddress :: String -> Maybe EMailAddress
mkEMailAddress = String -> String -> Maybe EMailAddress
forall (m :: * -> *) input a.
(MonadFail m, Stream input m Char, HasParser a) =>
String -> input -> m a
parseM String
"e-mail address"

-- | Accessor function for the underlying path of strings.
unEMailAddress :: EMailAddress -> String
unEMailAddress :: EMailAddress -> String
unEMailAddress (EMailAddress String
str) = String
str

instance HasParser EMailAddress where
  parser :: ParsecT st input m EMailAddress
parser = String -> EMailAddress
EMailAddress (String -> EMailAddress)
-> ParsecT st input m String -> ParsecT st input m EMailAddress
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT st input m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
addr_spec

instance IsString EMailAddress where
  fromString :: String -> EMailAddress
fromString = String -> String -> EMailAddress
forall input a.
(Stream input Identity Char, HasParser a) =>
String -> input -> a
parse String
"e-mail address"

instance Pretty EMailAddress where
  pPrint :: EMailAddress -> Doc
pPrint = String -> Doc
Pretty.text (String -> Doc) -> (EMailAddress -> String) -> EMailAddress -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EMailAddress -> String
unEMailAddress