add domain name validation module

Author: Andrew Cady

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

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

src/Text/Email/Parser.hs

@@ -7,6 +7,7 @@ module Text.Email.Parser
     , EmailAddress
     , unsafeEmailAddress
     , toByteString
+    , dottedAtoms
     )
 where