From 6b3d6d232fcddb4f398f7118251a951e26f7b81b Mon Sep 17 00:00:00 2001
From: Andrew Cady <d@jerkface.net>
Date: Sun, 24 Jan 2016 12:44:17 -0500
Subject: [PATCH] add domain name validation module

---
 email-validate.cabal        |  1 +
 src/Text/Domain/Validate.hs | 53 +++++++++++++++++++++++++++++++++++++
 src/Text/Email/Parser.hs    |  1 +
 3 files changed, 55 insertions(+)
 create mode 100644 src/Text/Domain/Validate.hs

diff --git a/email-validate.cabal b/email-validate.cabal
index 09064ab..579ab7a 100644
--- a/email-validate.cabal
+++ b/email-validate.cabal
@@ -32,6 +32,7 @@ library
     hs-source-dirs: src
     exposed-modules:
         Text.Email.Validate,
+        Text.Domain.Validate,
         Text.Email.Parser
 
 Test-Suite Main
diff --git a/src/Text/Domain/Validate.hs b/src/Text/Domain/Validate.hs
new file mode 100644
index 0000000..6b88f14
--- /dev/null
+++ b/src/Text/Domain/Validate.hs
@@ -0,0 +1,53 @@
+module Text.Domain.Validate
+        ( isValid
+        , validate
+        , domainName
+        , DomainName
+        , toByteString
+        )
+where
+
+import           Control.Applicative        ((<*))
+
+import           Data.Attoparsec.ByteString (endOfInput, parseOnly)
+import           Data.ByteString            (ByteString)
+
+import           Data.Data                  (Data, Typeable)
+import           GHC.Generics               (Generic)
+import           Text.Email.Parser          (dottedAtoms)
+import qualified Text.Read                  as Read
+
+
+-- | Represents a domain name.
+data DomainName = DomainName ByteString
+    deriving (Eq, Ord, Data, Typeable, Generic)
+
+-- | Smart constructor for a domain name
+domainName :: ByteString -> Maybe DomainName
+domainName = either (const Nothing) Just . validate
+
+-- | Validates whether a particular string is a domain name
+--   according to RFC5322.
+isValid :: ByteString -> Bool
+isValid = either (const False) (const True) . validate
+
+-- | If you want to find out *why* a particular string is not
+--   a domain name, use this.
+
+validate :: ByteString -> Either String DomainName
+validate = fmap DomainName . parseOnly (dottedAtoms <* endOfInput)
+
+instance Show DomainName where
+    show = show . toByteString
+
+instance Read DomainName where
+    readListPrec = Read.readListPrecDefault
+    readPrec = Read.parens (do
+        bs <- Read.readPrec
+        case parseOnly (dottedAtoms <* endOfInput) bs of
+            Left  _ -> Read.pfail
+            Right a -> return $ DomainName a)
+
+-- | Converts an email address back to a ByteString
+toByteString :: DomainName -> ByteString
+toByteString (DomainName d) = d
diff --git a/src/Text/Email/Parser.hs b/src/Text/Email/Parser.hs
index 84deaf8..b8f7d0c 100644
--- a/src/Text/Email/Parser.hs
+++ b/src/Text/Email/Parser.hs
@@ -7,6 +7,7 @@ module Text.Email.Parser
     , EmailAddress
     , unsafeEmailAddress
     , toByteString
+    , dottedAtoms
     )
 where