@@ -0,0 +1,65 @@
1+{-# OPTIONS_GHC -fno-warn-orphans #-}
10+import Control.Lens hiding (elements)
12+import Data.Aeson as JSON
13+import Data.ByteString
14+import Data.ByteString.Lens
17+import Data.Text.Encoding (decodeUtf8)
19+import Test.QuickCheck.Arbitrary
20+import Test.QuickCheck.Gen (elements)
21+import Text.Email.Parser
22+import Text.Email.Validate (EmailAddress, emailAddress)
27+ } deriving (Eq, Show, FromJSON, ToJSON, IsString)
31+-- | "Orphaned" prism.
32+_EmailAddress :: Prism' ByteString EmailAddress
33+_EmailAddress = prism' toByteString emailAddress
35+-- | Can be used like this:
37+-- >>> _EmailEmailAddress # (fromJust $ emailAddress "foo@bar.com")
38+-- Email {unEmail = "foo@bar.com"}
40+-- >>> Email "foo@bar.com" ^? _EmailEmailAddress
43+_EmailEmailAddress :: Prism' Email EmailAddress
44+_EmailEmailAddress = prism'
46+ (^? _Email . unpacked . packedChars . _EmailAddress)
48+instance Arbitrary Email where
50+ user <- elements ["user", "foo", "bar" :: Text]
51+ host <- elements ["example.com", "gmail.com" :: Text]
52+ return $ Email $ user <> host
54+instance ToJSON EmailAddress where
55+ toJSON = toJSON . view (re _EmailEmailAddress . _Email)
57+instance FromJSON EmailAddress where
58+ parseJSON = withText "EmailAddress" $ \s -> do
59+ let ea = s ^? re _Email . _EmailEmailAddress
64+toEmail :: EmailAddress -> Email
65+toEmail = Email . decodeUtf8 . toByteString