git.iko.soy/typeable/mandrill
on master help sign in
Introduce the `MandrillEmail` to prevent orphans.

This commit introduces a newtype wrapper called `MandrillEmail` to wrap the internal `EmailAddress` and thus avoid the need for a ToJSON/FromJSON orphan instances. Despite the newtype introduction the API should not break for the end user, provided he created the `MandrillRecipient` via the smart constructor, and he's not poking around with the `MandrillMessage`. We should probably avoid exporting the entire Types.hs module, but only types & smart constructors (and lenses!) but that is out of the scope of this PR. As low hanging fruit, I have ported the project to stack. @gregwebs Are you cool with me merging? I will release the new Mandrill upstream on Hackage soon afterwards.

commit444f7e2d72e8829012e76680ecbed01007f026ac authorAlfredo Di Napoli <alfredo.dinapoli@gmail.com> dateSun 9 Aug 2015, 15:36 (11 years ago) parent4096201
7 files changed+34−26
compare with master
unifiedsplit
.gitignore+1 .travis.yml+1 mandrill.cabal+8−2 src/Network/API/Mandrill.hs+1−1 src/Network/API/Mandrill/Orphans.hs−17 src/Network/API/Mandrill/Types.hs+18−6 stack.yaml+5
.gitignore+1
@@ -2,3 +2,4 @@ dist
22.cabal-sandbox
33cabal.sandbox.config
44shell.nix
5+.stack-work
.travis.yml+1
@@ -10,6 +10,7 @@ env:
1010 - GHCVER=7.8.2 CABALVER=1.18
1111 - GHCVER=7.8.3 CABALVER=1.18
1212 - GHCVER=7.10.1 CABALVER=1.22
13+ - GHCVER=7.10.2 CABALVER=1.22
1314 - GHCVER=head CABALVER=1.20
1415
1516matrix:
mandrill.cabal+8−2
@@ -1,5 +1,5 @@
11name: mandrill
2−version: 0.2.2.1
2+version: 0.3.0.0
33synopsis: Library for interfacing with the Mandrill JSON API
44description: Pure Haskell client for the Mandrill JSON API
55license: MIT
@@ -15,6 +15,9 @@ source-repository head
1515 type: git
1616 location: https://github.com/adinapoli/mandrill
1717
18+flag debug-th
19+ default: False
20+
1821library
1922 exposed-modules:
2023 Network.API.Mandrill
@@ -28,7 +31,6 @@ library
2831 other-modules:
2932 Network.API.Mandrill.Utils
3033 Network.API.Mandrill.HTTP
31− Network.API.Mandrill.Orphans
3234 -- other-extensions:
3335 build-depends:
3436 base >=4.6 && < 5
@@ -51,6 +53,10 @@ library
5153 src
5254 default-language:
5355 Haskell2010
56+
57+ if flag(debug-th)
58+ ghc-options: -ddump-splices -dth-dec-file
59+
5460 ghc-options:
5561 -funbox-strict-fields
5662
src/Network/API/Mandrill.hs+1−1
@@ -62,7 +62,7 @@ emptyMessage f t = MandrillMessage {
6262 _mmsg_html = mempty
6363 , _mmsg_text = Nothing
6464 , _mmsg_subject = T.empty
65− , _mmsg_from_email = f
65+ , _mmsg_from_email = (MandrillEmail f)
6666 , _mmsg_from_name = Nothing
6767 , _mmsg_to = map newRecipient t
6868 , _mmsg_headers = JSON.Null
src/Network/API/Mandrill/Orphans.hsdeleted−17
@@ -1,17 +0,0 @@
1−
2−module Network.API.Mandrill.Orphans where
3−
4−import Data.Aeson
5−import Data.Aeson.Types
6−import Text.Email.Validate
7−import qualified Data.Text.Encoding as TE
8−
9−
10−instance ToJSON EmailAddress where
11− toJSON = String . TE.decodeUtf8 . toByteString
12−
13−instance FromJSON EmailAddress where
14− parseJSON (String s) = case validate (TE.encodeUtf8 s) of
15− Left err -> fail err
16− Right v -> return v
17− parseJSON o = typeMismatch "Expecting a String for EmailAddress." o
src/Network/API/Mandrill/Types.hs+18−6
@@ -6,7 +6,6 @@
66module Network.API.Mandrill.Types where
77
88import Network.API.Mandrill.Utils
9−import Network.API.Mandrill.Orphans()
109import Test.QuickCheck
1110import Text.Email.Validate
1211import Data.Char
@@ -101,10 +100,23 @@ data MandrillRecipientTag = To | Cc | Bcc deriving Show
101100deriveJSON defaultOptions { constructorTagModifier = map toLower } ''MandrillRecipientTag
102101
103102
103+--------------------------------------------------------------------------------
104+newtype MandrillEmail = MandrillEmail EmailAddress deriving Show
105+
106+instance ToJSON MandrillEmail where
107+ toJSON (MandrillEmail e) = String . TL.decodeUtf8 . toByteString $ e
108+
109+instance FromJSON MandrillEmail where
110+ parseJSON (String s) = case validate (TL.encodeUtf8 s) of
111+ Left err -> fail err
112+ Right v -> return . MandrillEmail $ v
113+ parseJSON o = typeMismatch "Expecting a String for MandrillEmail." o
114+
115+
104116--------------------------------------------------------------------------------
105117-- | An array of recipient information.
106118data MandrillRecipient = MandrillRecipient {
107− _mrec_email :: EmailAddress
119+ _mrec_email :: MandrillEmail
108120 -- ^ The email address of the recipient
109121 , _mrec_name :: Maybe T.Text
110122 -- ^ The optional display name to use for the recipient
@@ -117,11 +129,11 @@ makeLenses ''MandrillRecipient
117129deriveJSON defaultOptions { fieldLabelModifier = drop 6 } ''MandrillRecipient
118130
119131newRecipient :: EmailAddress -> MandrillRecipient
120−newRecipient email = MandrillRecipient email Nothing Nothing
132+newRecipient email = MandrillRecipient (MandrillEmail email) Nothing Nothing
121133
122134instance Arbitrary MandrillRecipient where
123135 arbitrary = pure MandrillRecipient {
124− _mrec_email = fromJust (emailAddress "test@example.com")
136+ _mrec_email = MandrillEmail $ fromJust (emailAddress "test@example.com")
125137 , _mrec_name = Nothing
126138 , _mrec_type = Nothing
127139 }
@@ -218,7 +230,7 @@ data MandrillMessage = MandrillMessage {
218230 -- ^ Optional full text content to be sent
219231 , _mmsg_subject :: !T.Text
220232 -- ^ The message subject
221− , _mmsg_from_email :: EmailAddress
233+ , _mmsg_from_email :: MandrillEmail
222234 -- ^ The sender email address
223235 , _mmsg_from_name :: Maybe T.Text
224236 -- ^ Optional from name to be used
@@ -301,7 +313,7 @@ instance Arbitrary MandrillMessage where
301313 arbitrary = MandrillMessage <$> arbitrary
302314 <*> pure Nothing
303315 <*> pure "Test Subject"
304− <*> pure (fromJust $ emailAddress "sender@example.com")
316+ <*> pure (MandrillEmail . fromJust $ emailAddress "sender@example.com")
305317 <*> pure Nothing
306318 <*> resize 2 arbitrary
307319 <*> pure emptyObject
stack.yamlnew file+5
@@ -0,0 +1,5 @@
1+flags: {}
2+packages:
3+- '.'
4+extra-deps: []
5+resolver: lts-2.19