packages feed

mailchimp (empty) → 0.1.0

raw patch · 11 files changed

+785/−0 lines, 11 filesdep +aesondep +attoparsecdep +basesetup-changed

Dependencies added: aeson, attoparsec, base, bytestring, http-client, http-client-tls, servant, servant-client, text, transformers

Files

+ LICENSE.md view
@@ -0,0 +1,22 @@+MIT License++Copyright (c) 2016 Juan Pedro Villa Isaza++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,19 @@+# Haskell bindings for the MailChimp API++[![][1]][0]++[0]: https://travis-ci.org/jpvillaisaza/mailchimp-haskell+[1]: https://travis-ci.org/jpvillaisaza/mailchimp-haskell.svg?branch=master++![][2]+![][3]++[2]: https://www.stackage.org/package/mailchimp/badge/lts+[3]: https://www.stackage.org/package/mailchimp/badge/nightly++## License++Licensed under the MIT license. See [LICENSE.md](LICENSE.md).++[mailchimp]: http://mailchimp.com/+[mailchimp-api]: http://developer.mailchimp.com/
+ Setup.hs view
+ mailchimp.cabal view
@@ -0,0 +1,61 @@+name: mailchimp+version: 0.1.0++build-type: Simple+cabal-version: >= 1.21++license: MIT+license-file: LICENSE.md++copyright: 2016 Juan Pedro Villa Isaza+author: Juan Pedro Villa Isaza <jpvillaisaza@gmail.com>+maintainer: Juan Pedro Villa Isaza <jpvillaisaza@gmail.com>++stability: Experimental++homepage: https://github.com/jpvillaisaza/mailchimp-haskell+bug-reports: https://github.com/jpvillaisaza/mailchimp-haskell/issues++synopsis: Bindings for the MailChimp API+description: Haskell bindings for the MailChimp API.++category: Web++tested-with: GHC == 7.10.3++extra-source-files: README.md+++library+  hs-source-dirs:+      src+  exposed-modules:+      Web.MailChimp+      Web.MailChimp.Tutorial+  other-modules:+      Paths_mailchimp+      Web.MailChimp.Common+      Web.MailChimp.Extra+      Web.MailChimp.Key+      Web.MailChimp.List+      Web.MailChimp.List.Member+  build-depends:+      aeson >= 0.11 && < 0.12+    , attoparsec >= 0.13 && < 0.14+    , base >= 4.8 && < 4.10+    , bytestring+    , http-client >= 0.4 && < 0.5+    , http-client-tls >= 0.2 && < 0.3+    , servant >= 0.7 && < 0.8+    , servant-client >= 0.7 && < 0.8+    , text >= 1.2 && < 1.3+    , transformers+  default-language:+      Haskell2010+  ghc-options:+      -Wall+++source-repository head+  type: git+  location: https://github.com/jpvillaisaza/mailchimp-haskell
+ src/Web/MailChimp.hs view
@@ -0,0 +1,226 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeOperators #-}++----------------------------------------------------------------------+-- |+-- Module: Web.MailChimp+-- Description:+--+--+--+----------------------------------------------------------------------++module Web.MailChimp+  ( Key+  , Client(..)+  , makeClient+  , ListClient(..)+  , ListId+  , ListMemberClient(..)+  , makeListMemberClient+  , ListMemberRequest(..)+  , makeListMemberRequest+  , ListMemberResponse(..)+  , ListMemberId+  , ListMemberStatus(..)+  , Id+  , Paths_mailchimp.version+  , makeManager+  )+  where++-- aeson+import Data.Aeson++-- base+import Data.Proxy (Proxy (Proxy))+import Data.Void (Void)++-- bytestring+import Data.ByteString.Char8 (unpack)++-- http-client+import Network.HTTP.Client (Manager)++-- mailchimp+import qualified Paths_mailchimp+import Web.MailChimp.Common+import Web.MailChimp.Extra+import Web.MailChimp.Key+import Web.MailChimp.List+import Web.MailChimp.List.Member++-- servant+import Servant.API++-- servant-client+import Servant.Client hiding (Client)+import qualified Servant.Client as Servant++-- transformers+import Control.Monad.IO.Class+import Control.Monad.Trans.Except (ExceptT, runExceptT)+++-- |+--+-- The MailChimp API, version 3.0.++type Api =+  "3.0"+    :> BasicAuth "" Void+    :> (Get '[JSON] Object :<|> ListApi)+++-- |+--+-- A client for MailChimp.++data Client =+  Client+    { -- |+      --+      --++      getLinks+        :: forall m . MonadIO m+        => m (Either ServantError Object)++      -- |+      --+      -- Create a client for a list.++    , makeListClient+        :: ListId+        -> ListClient++    }+++-- |+--+-- Create a client for MailChimp.++makeClient+  :: Manager -- ^ A manager+  -> Key -- ^ A key+  -> Maybe Client -- ^ The client+makeClient manager key =+  case makeBaseUrl key of+    Nothing ->+      Nothing++    Just baseUrl ->+      let+        makeGetLinks :<|> client' = client (Proxy :: Proxy Api) basicAuthData++        getLinks :: MonadIO m => m (Either ServantError Object)+        getLinks = run (makeGetLinks manager baseUrl)++        makeListClient = makeListClient' manager baseUrl client'++        basicAuthData = BasicAuthData "" key+      in+        Just Client {..}+++-- |+--+--++makeListClient'+  :: Manager+  -> BaseUrl+  -> Servant.Client ListApi+  -> ListId+  -> ListClient+makeListClient' manager baseUrl client' listId =+  let+    listMemberClient =+      makeListMemberClient' manager baseUrl (client' listId)+  in+    ListClient {..}+++-- |+--+--++makeListMemberClient'+  :: Manager+  -> BaseUrl+  -> Servant.Client ListMemberApi+  -> ListMemberClient+makeListMemberClient' manager baseUrl listClient =+  let+    makeAddListMember+      :<|> md+      :<|> md2+      :<|> md3+      :<|> md4+      :<|> makeDeleteListMember = listClient++    addListMember lm = run (makeAddListMember lm manager baseUrl)++    getListMembers :: MonadIO m => m (Either ServantError [ListMemberResponse])+    getListMembers = run (md manager baseUrl)++    getListMember s = run (md2 s manager baseUrl)++    updateListMember s lm = run (md3 s lm manager baseUrl)++    addOrUpdateListMember s lm = run (md4 s lm manager baseUrl)++    deleteListMember s = run (makeDeleteListMember s manager baseUrl)+  in+    ListMemberClient {..}+++-- |+--+--++run+  :: MonadIO m+  => ExceptT e IO a+  -> m (Either e a)+run =+  liftIO . runExceptT+++-- |+--+-- Create a client for a list members.++makeListMemberClient+  :: Manager+  -> Key+  -> ListId+  -> Maybe ListMemberClient+makeListMemberClient manager key listId =+  listMemberClient . (`makeListClient` listId)+    <$> makeClient manager key+++-- |+--+--++makeBaseUrl+  :: Key+  -> Maybe BaseUrl+makeBaseUrl key =+  case fmap unpack (parseDataCenter key) of+    Left _ ->+      Nothing++    Right dataCenter ->+      Just $+        BaseUrl+          Https+          (mappend dataCenter ".api.mailchimp.com")+          443+          ""
+ src/Web/MailChimp/Common.hs view
@@ -0,0 +1,24 @@+----------------------------------------------------------------------+-- |+-- Module: Web.MailChimp.Common+-- Description:+--+--+--+----------------------------------------------------------------------++module Web.MailChimp.Common+  ( Id+  )+  where++-- text+import Data.Text (Text)+++-- |+--+-- An ID.++type Id =+  Text
+ src/Web/MailChimp/Extra.hs view
@@ -0,0 +1,28 @@+----------------------------------------------------------------------+-- |+-- Module: Web.MailChimp.Extra+-- Description:+--+--+--+----------------------------------------------------------------------++module Web.MailChimp.Extra+  ( makeManager+  )+  where++-- http-client+import Network.HTTP.Client (Manager, newManager)++-- http-client-tls+import Network.HTTP.Client.TLS (tlsManagerSettings)+++-- |+--+-- Create a manager.++makeManager :: IO Manager+makeManager =+  newManager tlsManagerSettings
+ src/Web/MailChimp/Key.hs view
@@ -0,0 +1,58 @@+----------------------------------------------------------------------+-- |+-- Module: Web.MailChimp.Key+-- Description:+--+--+--+----------------------------------------------------------------------++module Web.MailChimp.Key+  ( DataCenter+  , Key+  , parseDataCenter+  )+  where++-- attoparsec+import Data.Attoparsec.ByteString+import Data.Attoparsec.ByteString.Char8 (anyChar, char)++-- bytestring+import Data.ByteString.Char8+++-- |+--+-- A MailChimp data center.++type DataCenter =+  ByteString+++-- |+--+-- A MailChimp API key.++type Key =+  ByteString+++-- |+--+--++parseDataCenter+  :: Key+  -> Either String DataCenter+parseDataCenter =+  parseOnly dataCenterParser+++-- |+--+--++dataCenterParser :: Parser DataCenter+dataCenterParser =+  manyTill anyChar (char '-') *> fmap pack (many1 anyChar)
+ src/Web/MailChimp/List.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}++----------------------------------------------------------------------+-- |+-- Module: Web.MailChimp.List+-- Description:+--+--+--+----------------------------------------------------------------------++module Web.MailChimp.List+  ( ListApi+  , ListClient(..)+  , ListId+  )+  where++-- mailchimp+import Web.MailChimp.Common+import Web.MailChimp.List.Member++-- servant+import Servant.API+++-- |+--+-- A list ID.++type ListId =+  Id+++-- |+--+--++type ListApi =+  "lists"+    :> Capture "list_id" ListId+    :> "members"+    :> ListMemberApi+++-- |+--+-- A client for a list.++data ListClient =+  ListClient+    { -- |+      --+      --++      listMemberClient :: ListMemberClient++    }
+ src/Web/MailChimp/List/Member.hs view
@@ -0,0 +1,232 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeOperators #-}++----------------------------------------------------------------------+-- |+-- Module: Web.MailChimp.List.Member+-- Description:+--+--+--+----------------------------------------------------------------------++module Web.MailChimp.List.Member+  ( ListMemberApi+  , ListMemberClient(..)+  , ListMemberRequest(..)+  , makeListMemberRequest+  , ListMemberResponse(..)+  , ListMemberId+  , ListMemberStatus(..)+  )+  where++-- aeson+import Data.Aeson+import qualified Data.Aeson as Aeson++-- mailchimp+import Web.MailChimp.Common++-- servant+import Servant.API++-- servant-client+import Servant.Client++-- text+import Data.Text (Text)++-- transformers+import Control.Monad.IO.Class (MonadIO)+++type ListMemberId =+  Id++-- |+--+--++type ListMemberApi =+       ReqBody '[JSON] ListMemberRequest+         :> Post '[JSON] ListMemberResponse++  :<|> Get '[JSON] [ListMemberResponse]++  :<|> Capture "subscriber_hash" ListMemberId+         :> Get '[JSON] ListMemberResponse++  :<|> Capture "subscriber_hash" ListMemberId+         :> ReqBody '[JSON] ListMemberRequest+         :> Patch '[JSON] ListMemberResponse++  :<|> Capture "subscriber_hash" ListMemberId+         :> ReqBody '[JSON] ListMemberRequest+         :> Put '[JSON] ListMemberResponse+++  :<|> Capture "subscriber_hash" ListMemberId+         :> Delete '[JSON] String+++-- |+--+--++data ListMemberClient =+  ListMemberClient+    { -- |+      --+      -- Add a new list member.++      addListMember+        :: forall m . MonadIO m+        => ListMemberRequest+        -> m (Either ServantError ListMemberResponse)++      -- |+      --+      -- Get information about members in a list.++    , getListMembers+        :: forall m . MonadIO m+        => m (Either ServantError [ListMemberResponse])++      -- |+      --+      -- Get information about a specific list member.++    , getListMember+        :: forall m . MonadIO m+        => ListMemberId+        -> m (Either ServantError ListMemberResponse)++      -- |+      --+      -- Update a list member.++    , updateListMember+        :: forall m . MonadIO m+        => ListMemberId+        -> ListMemberRequest+        -> m (Either ServantError ListMemberResponse)++      -- |+      --+      -- Add or update a list member.++    , addOrUpdateListMember+        :: forall m . MonadIO m+        => ListMemberId+        -> ListMemberRequest+        -> m (Either ServantError ListMemberResponse)++      -- |+      --+      -- Remove a list member.++    , deleteListMember+        :: forall m . MonadIO m+        => ListMemberId+        -> m (Either ServantError String)++    }+++-- |+--+--++data ListMemberRequest =+  ListMemberRequest+    { listMemberEmailAddress :: Text+    , listMemberMergeFields :: [(Text, Text)]+    , listMemberStatus :: ListMemberStatus+    , listMemberExtra :: [(Text, Aeson.Value)]+    }+  deriving (Show)+++-- |+--+-- Create a list member request.++makeListMemberRequest+  :: Text -- ^ Email+  -> ListMemberStatus+  -> ListMemberRequest+makeListMemberRequest emailAddress status =+  ListMemberRequest+    { listMemberEmailAddress = emailAddress+    , listMemberMergeFields = mempty+    , listMemberStatus = status+    , listMemberExtra = mempty+    }+++-- |+--+--++instance ToJSON ListMemberRequest where+  toJSON ListMemberRequest {..} =+    Aeson.object $+      "email_address" .= listMemberEmailAddress+        : mergeFields+        : "status" .= listMemberStatus+        : listMemberExtra+    where+      mergeFields =+        ( "merge_fields"+        , Aeson.object (fmap (fmap toJSON) listMemberMergeFields)+        )+++-- |+--+--++data ListMemberResponse =+  ListMemberResponse+    { listMemberId :: ListMemberId+    }+  deriving (Show)+++-- |+--+--++instance FromJSON ListMemberResponse where+  parseJSON =+    Aeson.withObject "" $+      \o ->+        ListMemberResponse+          <$> o .: "id"+++-- |+--+--++data ListMemberStatus+  = Cleaned+  | Pending+  | Subscribed+  | Unsubscribed+  deriving (Show)+++-- |+--+--++instance ToJSON ListMemberStatus where+  toJSON Cleaned = "cleaned"+  toJSON Pending = "pending"+  toJSON Subscribed = "subscribed"+  toJSON Unsubscribed = "unsubscribed"
+ src/Web/MailChimp/Tutorial.hs view
@@ -0,0 +1,56 @@+----------------------------------------------------------------------+-- |+-- Module: Web.MailChimp.Tutorial+-- Description:+--+--+--+----------------------------------------------------------------------++module Web.MailChimp.Tutorial+  (+  )+  where++-- |+--+-- {-# LANGUAGE OverloadedStrings #-}+-- {-# LANGUAGE RecordWildCards #-}+-- +-- -- base+-- import System.Environment (getEnv)+--+-- -- bytestring+-- import Data.ByteString.Char8 (pack)+--+-- -- mailchimp+-- import Web.MailChimp+--+-- -- text+-- import qualified Data.Text as Text+--+--+-- example :: IO ()+-- example = do+--   manager <- makeManager+--   key <- fmap pack (getEnv "MAILCHIMP_API_KEY")+--   listId <- fmap Text.pack (getEnv "MAILCHIMP_LIST_ID")+--+--   let+--     Just ListMemberClient {..} =+--       makeListMemberClient manager key listId+--+--   let+--     member =+--       (makeListMemberRequest "sd@sd.com" Pending)+--         { listMemberMergeFields = [("FNAME", "Juan")]+--         }+--+--   eitherAdd <- addListMember member+--+--   case eitherAdd of+--     Left err ->+--       putStrLn $ "Error: " ++ show err+--+--     Right msg ->+--       print msg