diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Author name here (c) 2016 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,22 @@ + +emailaddress +============ + +[![Hackage](https://img.shields.io/hackage/v/emailaddress.svg)](https://hackage.haskell.org/package/emailaddress) [![Build Status](https://secure.travis-ci.org/cdepillabout/emailaddress.svg)](http://travis-ci.org/cdepillabout/emailaddress) + +This Haskell module wraps around the +[`email-validate`](https://hackage.haskell.org/package/email-validate) package, +providing a newtype wrapper around the `EmailAddress` type. Our `EmailAddress` +type has additional typeclass instances, including aeson's +[ToJSON](https://hackage.haskell.org/package/aeson/docs/Data-Aeson.html#t:ToJSON) +and +[FromJSON](https://hackage.haskell.org/package/aeson/docs/Data-Aeson.html#t:FromJSON). +This allows us to use the `EmailAddress` type without fear of orphan instances. + +This package exposes the module `Text.Email.Validate`, so it can be used as +a drop-in replacement for +[`email-validate`](https://hackage.haskell.org/package/email-validate). + +If you would like to add new instances for `EmailAddress`, please send a pull +request. Any instace for a typeclass from a package in stackage will be +accepted. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/emailaddress.cabal b/emailaddress.cabal new file mode 100644 --- /dev/null +++ b/emailaddress.cabal @@ -0,0 +1,44 @@ +name: emailaddress +version: 0.1.0.0 +synopsis: Wrapper around email-validate library adding instances for common type classes. +description: Please see README.md +homepage: https://github.com/cdepillabout/emailaddress#readme +license: BSD3 +license-file: LICENSE +author: Dennis Gosnell +maintainer: cdep.illabout@gmail.com +copyright: 2016 Dennis Gosnell +category: Text +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: Text.Email.Validate + other-modules: Text.Email.Validate.Internal + build-depends: base >= 4.6 && < 5 + , aeson >= 0.9 + , bytestring >= 0.9 + , email-validate >= 2 + , opaleye >= 0.4 + , postgresql-simple >= 0.5 + , product-profunctors >= 0.6 + , profunctors >= 0.5 + , text >= 1.2 + default-language: Haskell2010 + ghc-options: -Wall + +test-suite emailaddress-doctest + type: exitcode-stdio-1.0 + main-is: DocTest.hs + hs-source-dirs: test + build-depends: base + , doctest + , Glob + default-language: Haskell2010 + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N + +source-repository head + type: git + location: git@github.com:cdepillabout/emailaddress.git diff --git a/src/Text/Email/Validate.hs b/src/Text/Email/Validate.hs new file mode 100644 --- /dev/null +++ b/src/Text/Email/Validate.hs @@ -0,0 +1,43 @@ +{-| +Module : Text.Email.Validate +Description : Wrapper around email-validate adding additional instances. +Copyright : (c) Dennis Gosnell, 2016 +License : BSD3 + +This module is a wrapper around + +from . + +This module exports 'EmailAddress', a newtype wrapper around +. +Additional instances are defined for our +new 'EmailAddress', including 'Data.Aeson.ToJSON' and 'Data.Aeson.FromJSON'. This is done so that no +orphan instances need to be used. + +If you would like additional instances to be defined, please send a +. Additional +instances will be accepted for any typeclass from any package available on +stackage. +-} + +module Text.Email.Validate + ( -- * Data Type + EmailAddress + -- * Create EmailAddress + , emailAddress + , validate + -- * Check validity + , isValid + -- * Convert back to ByteString + , toByteString + , localPart + , domainPart + -- * Helper functions + , canonicalizeEmail + -- * Unsafe creation + , unsafeEmailAddress + ) where + +import Text.Email.Validate.Internal + ( EmailAddress, canonicalizeEmail, domainPart, emailAddress, isValid + , localPart, toByteString, validate, unsafeEmailAddress ) diff --git a/src/Text/Email/Validate/Internal.hs b/src/Text/Email/Validate/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Text/Email/Validate/Internal.hs @@ -0,0 +1,157 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE PackageImports #-} + +module Text.Email.Validate.Internal + ( EmailAddress(unEmailAddress) + , EmailValidate.isValid + , EmailValidate.canonicalizeEmail + , emailAddress + , validate + , unsafeEmailAddress + , localPart + , domainPart + , toByteString + ) where + +import Data.Aeson (FromJSON(..), ToJSON(..), Value(..), withText) +import Data.Aeson.Types (Parser) +import Data.ByteString (ByteString) +import Data.Data (Data) +import Data.Monoid ((<>)) +import Data.Profunctor (lmap) +import Data.Profunctor.Product.Default (Default(def)) +import Data.Text.Encoding (decodeUtf8With, encodeUtf8) +import Data.Text.Encoding.Error (lenientDecode) +import Database.PostgreSQL.Simple.FromField + ( Conversion, FieldParser, FromField(..), ResultError(..), returnError ) +import Data.Typeable (Typeable) +import GHC.Generics (Generic) +import Opaleye + ( Column, Constant(..), PGText, QueryRunnerColumn + , QueryRunnerColumnDefault(..) , fieldQueryRunnerColumn ) + +import qualified "email-validate" Text.Email.Validate as EmailValidate + +-- | Type to represent an email address. Newtype wrapper around +-- 'EmailValidate.EmailAddress' with additional typeclass instances. +newtype EmailAddress = EmailAddress + { unEmailAddress :: EmailValidate.EmailAddress } + deriving (Data, Eq, Generic, Ord, Typeable) + +instance Show EmailAddress where + show :: EmailAddress -> String + show = show . unEmailAddress + +instance QueryRunnerColumnDefault PGText EmailAddress where + queryRunnerColumnDefault :: QueryRunnerColumn PGText EmailAddress + queryRunnerColumnDefault = fieldQueryRunnerColumn + +instance FromField EmailAddress where + fromField :: FieldParser EmailAddress + -- fromField :: Field -> Maybe ByteString -> Conversion EmailAddress + fromField field Nothing = returnError UnexpectedNull field "" + fromField field (Just email) = maybe err return $ emailAddress email + where + err :: Conversion EmailAddress + err = returnError ConversionFailed field $ + "Could not convert " <> show email <> " to email address" + +instance Default Constant EmailAddress (Column PGText) where + def :: Constant EmailAddress (Column PGText) + def = lmap (decodeUtf8With lenientDecode . toByteString) def + +-- | Parse 'EmailAddress' from JSON. +instance FromJSON EmailAddress where + parseJSON :: Value -> Parser EmailAddress + parseJSON = withText "EmailAddress" $ \t -> + case validate $ encodeUtf8 t of + Left err -> fail $ "Failed to parse email address: " <> err + Right email -> return email + {-# INLINE parseJSON #-} + +-- | Turn 'EmailAddress' into JSON. +instance ToJSON EmailAddress where + toJSON :: EmailAddress -> Value + toJSON = String . decodeUtf8With lenientDecode . toByteString + +-- | Wrapper around 'EmailValidate.validate'. +-- +-- >>> validate "foo@gmail.com" +-- Right "foo@gmail.com" +-- >>> import Data.Either (isLeft) +-- >>> isLeft $ validate "not an email address" +-- True +validate :: ByteString -> Either String EmailAddress +validate = fmap EmailAddress . EmailValidate.validate + +-- | Wrapper around 'EmailValidate.emailAddress'. +-- +-- Similar to 'validate', but returns 'Nothing' if the email address fails to +-- parse. +-- +-- >>> emailAddress "foo@gmail.com" +-- Just "foo@gmail.com" +-- >>> emailAddress "not an email address" +-- Nothing +emailAddress :: ByteString -> Maybe EmailAddress +emailAddress = fmap EmailAddress . EmailValidate.emailAddress + +-- | Wrapper around 'EmailValidate.unsafeEmailAddress'. +-- +-- Unsafely create an 'EmailAddress' from a local part and a domain part. The +-- first argument is the local part, and the second argument is the domain +-- part. +-- +-- For example, in the email address @foo\@gmail.com@, the local part is @foo@ +-- and the domain part is @gmail.com@. +-- +-- >>> unsafeEmailAddress "foo" "gmail.com" +-- "foo@gmail.com" +unsafeEmailAddress + :: ByteString -- ^ Local part + -> ByteString -- ^ Domain part + -> EmailAddress +unsafeEmailAddress = (EmailAddress .) . EmailValidate.unsafeEmailAddress + +-- | Wrapper around 'EmailValidate.localPart'. +-- +-- Extracts the local part from an email address. +-- +-- For example, in the email address @foo\@gmail.com@, the local part is @foo@. +-- +-- >>> let email = unsafeEmailAddress "foo" "gmail.com" +-- >>> email +-- "foo@gmail.com" +-- >>> localPart email +-- "foo" +localPart :: EmailAddress -> ByteString +localPart = EmailValidate.localPart . unEmailAddress + +-- | Wrapper around 'EmailValidate.domainPart'. +-- +-- Extracts the domain part from an email address. +-- +-- For example, in the email address @foo\@gmail.com@, the domain part is +-- @gmail.com@. +-- +-- >>> let email = unsafeEmailAddress "foo" "gmail.com" +-- >>> email +-- "foo@gmail.com" +-- >>> domainPart email +-- "gmail.com" +domainPart :: EmailAddress -> ByteString +domainPart = EmailValidate.domainPart . unEmailAddress + +-- | Wrapper around 'EmailValidate.toByteString'. +-- +-- >>> let email = unsafeEmailAddress "foo" "gmail.com" +-- >>> email +-- "foo@gmail.com" +-- >>> toByteString email +-- "foo@gmail.com" +toByteString :: EmailAddress -> ByteString +toByteString = EmailValidate.toByteString . unEmailAddress diff --git a/test/DocTest.hs b/test/DocTest.hs new file mode 100644 --- /dev/null +++ b/test/DocTest.hs @@ -0,0 +1,40 @@ + +module Main (main) where + +import Prelude + +import Data.Monoid ((<>)) +import System.FilePath.Glob (glob) +import Test.DocTest (doctest) + +main :: IO () +main = glob "src/**/*.hs" >>= doDocTest + +doDocTest :: [String] -> IO () +doDocTest options = doctest $ options <> ghcExtensions + +ghcExtensions :: [String] +ghcExtensions = + [ + -- "-XConstraintKinds" + -- , "-XDataKinds" + "-XDeriveDataTypeable" + , "-XDeriveGeneric" + -- , "-XEmptyDataDecls" + , "-XFlexibleContexts" + -- , "-XFlexibleInstances" + -- , "-XGADTs" + -- , "-XGeneralizedNewtypeDeriving" + -- , "-XInstanceSigs" + -- , "-XMultiParamTypeClasses" + -- , "-XNoImplicitPrelude" + , "-XOverloadedStrings" + -- , "-XPolyKinds" + -- , "-XRankNTypes" + -- , "-XRecordWildCards" + , "-XScopedTypeVariables" + -- , "-XStandaloneDeriving" + -- , "-XTupleSections" + -- , "-XTypeFamilies" + -- , "-XTypeOperators" + ]