MailchimpSimple (empty) → 0.1.0.0
raw patch · 7 files changed
+776/−0 lines, 7 filesdep +aesondep +aeson-lensdep +basesetup-changed
Dependencies added: aeson, aeson-lens, base, bytestring, directory, filepath, http-conduit, http-types, lens, text, time, transformers, vector
Files
- LICENSE +30/−0
- MailchimpSimple.cabal +82/−0
- MailchimpSimple.hs +246/−0
- MailchimpSimple/Logger.hs +41/−0
- MailchimpSimple/Types.hs +352/−0
- README.md +23/−0
- Setup.hs +2/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, Dananji Liyanage + +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 Dananji Liyanage 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.
+ MailchimpSimple.cabal view
@@ -0,0 +1,82 @@+-- Initial MailchimpSimple.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +-- The name of the package. +name: MailchimpSimple + +-- The package version. See the Haskell package versioning policy (PVP) +-- for standards guiding when and how versions should be incremented. +-- http://www.haskell.org/haskellwiki/Package_versioning_policy +-- PVP summary: +-+------- breaking API changes +-- | | +----- non-breaking API additions +-- | | | +--- code changes with no API change +version: 0.1.0.0 + +-- A short (one-line) description of the package. +synopsis: A Haskell library to handle mailing lists in MailchimpSimple using its JSON API. + +-- A longer description of the package. +description: Library to handle mailing lists in MailchimpSimple using its JSON API + +-- URL for the project homepage or repository. +homepage: https://github.com/Dananji/MailchimpSimple + +-- The license under which the package is released. +license: BSD3 + +-- The file containing the license text. +license-file: LICENSE + +-- The package author(s). +author: Dananji Liyanage + +-- An email address to which users can send suggestions, bug reports, and +-- patches. +maintainer: dan9131@gmail.com + +-- A copyright notice. +-- copyright: + +category: Web + +build-type: Simple + +-- Extra files to be distributed with the package, such as examples or a +-- README. +extra-source-files: README.md + +-- Constraint on the version of Cabal needed to build this package. +cabal-version: >=1.10 + + +library + -- Modules exported by the library. + exposed-modules: MailchimpSimple, MailchimpSimple.Types, MailchimpSimple.Logger + + -- Modules included in this library but not exported. + -- other-modules: + + -- LANGUAGE extensions used by modules in this package. + other-extensions: OverloadedStrings, DeriveGeneric + + -- Other library packages from which modules are imported. + build-depends: base >=4.7 && <4.8 + , http-conduit >=2.1 && <2.2 + , http-types >=0.8 && <0.9 + , transformers >=0.3 && <0.4 + , aeson >=0.7 && <0.8 + , filepath >=1.3 && <1.4 + , bytestring >=0.10 && <0.11 + , aeson-lens >=0.5 && <0.6 + , lens >=4.11 && <4.12 + , text >=1.1 && <1.2 + , vector >=0.10 && <0.11 + , time >=1.4 && <1.5 + , directory >=1.2 && <1.3 + + -- Directories containing source files. + -- hs-source-dirs: + + -- Base language which the package is written in. + default-language: Haskell2010 +
+ MailchimpSimple.hs view
@@ -0,0 +1,246 @@+{-# LANGUAGE OverloadedStrings #-} + +module MailchimpSimple + ( + -- * Handling Mailing lists in Mailchimp + addSubscriber + , batchSubscribe + , listMailingLists + , listSubscribers + -- * Sending & Creating campaigns + , getTemplates + , createCampaign + , sendEmail + ) where + +import Network.HTTP.Conduit ( parseUrl, RequestBody (RequestBodyLBS), requestBody, method, withManager, httpLbs, Response (..) + , HttpException (..), Cookie(..)) +import Network.HTTP.Types ( methodPost, Status(..), http11 ) +import Control.Monad.IO.Class ( liftIO ) +import Control.Exception ( catch, IOException, Exception ) +import Data.Aeson ( encode, decode, eitherDecode, Value, Array ) +import Data.List ( transpose, intercalate ) +import System.Exit ( exitWith, ExitCode(..) ) +import System.FilePath.Posix ( pathSeparator ) +import qualified Data.ByteString.Lazy as BL ( ByteString, empty ) + +import Data.Aeson.Lens ( key ) +import Data.Maybe ( Maybe(..), fromJust ) +import Control.Lens.Getter ( (^.)) +import qualified Data.Text as T ( pack ) +import qualified Data.Vector as V ( head, tail, empty ) + +-- App modules +import MailchimpSimple.Types + + +-- | List mailing lists in a particular account with the given API key +listMailingLists + :: String -- ^ API key + -> IO [MailListResponse] -- ^ Array of 'MailListResponse' response +listMailingLists apiKey = do + url <- endPointUrl apiKey + let mList = MailList { l_apikey = apiKey + , l_filters = Filters { list_id = "" + , list_name = "" } + , l_start = 0 + , l_limit = 25 + , l_sort_field = "web" + , l_sort_dir = "DESC" } + let lUrl = url ++ "/lists/list.json" + response <- processResponse lUrl mList apiKey + let resBody = decode (responseBody response) :: Maybe Value + let vArray = resBody ^. key "data" :: Maybe Array + let listResponse = getValues vArray + return listResponse + where getValues ls + | ls /= (Just V.empty) = constructMLRes (fmap V.head ls) : getValues (fmap V.tail ls) + | otherwise = [] + constructMLRes elem = do let lName = elem ^. key "name" :: Maybe String + let lID = elem ^. key "id" :: Maybe String + MailListResponse { l_name = lName, l_id = lID} + + +-- | List subscribers in a mailing list with the given list ID +listSubscribers + :: String -- ^ API key + -> String -- ^ List ID + -> IO [ListSubscribersResponse] -- ^ Array of 'ListSubscribersResponse' response +listSubscribers apiKey listID = do + url <- endPointUrl apiKey + let sList = Subscribers { su_apikey = apiKey + , su_id = listID + , su_status = "subscribed" } + let lUrl = url ++ "/lists/members.json" + response <- processResponse lUrl sList apiKey + let resBody = decode (responseBody response) :: Maybe Value + let vArray = resBody ^. key "data" :: Maybe Array + let listSubResponse = getValues vArray + return listSubResponse + where getValues ls + | ls /= (Just V.empty) = constructMLRes (fmap V.head ls) : getValues (fmap V.tail ls) + | otherwise = [] + constructMLRes elem = (ListSubscribersResponse { s_name = sName + , s_euid = sEuid + , s_list_name = sListName + , s_emailType = sEmailType }) + where sName = elem ^. key "email" :: Maybe String + sEuid = elem ^. key "euid" :: Maybe String + sListName = elem ^. key "list_name" :: Maybe String + sEmailType = elem ^. key "email_type" :: Maybe String + +-- | Get the templates saved in hte Mailchimp account +getTemplates + :: String -- ^ API key + -> IO [TemplateResponse] -- ^ Array of 'TemplateResponse' response +getTemplates apiKey = do + url <- endPointUrl apiKey + let templates = Template { t_apikey = apiKey + , t_types = TemplateTypes { user = True + , gallery = True + , base = True } } + let tUrl = url ++ "/templates/list.json" + response <- processResponse tUrl templates apiKey + let resBody = decode (responseBody response) :: Maybe Value + let galleryT = resBody ^. key "gallery" :: Maybe Array + let userT = resBody ^. key "user" :: Maybe Array + let allTemplates = (getValues galleryT) ++ (getValues userT) + return allTemplates + where getValues ls + | ls /= (Just V.empty) = constructTRes (fmap V.head ls) : getValues (fmap V.tail ls) + | otherwise = [] + constructTRes elem = do let tName = elem ^. key "name" :: Maybe String + let tID = elem ^. key "id" :: Maybe Int + TemplateResponse { t_name = tName, t_id = tID } + +-- | Create a new campaign and save it in the Campaigns list +createCampaign + :: String -- ^ API key + -> String -- ^ List ID + -> String -- ^ Sender's name + -> String -- ^ Sender's email + -> String -- ^ Campaign type, choose from "regular", "plaintext", "absplit", "rss", "auto" + -> String -- ^ Subject of the campaign + -> String -- ^ Receipient's name + -> Int -- ^ Template ID + -> String -- ^ Content of the campaign. Example: HTML "<h1>Title</h1>" + -> IO (Maybe String) -- ^ Campaign ID +createCampaign apiKey + listID + fromName + fromEmail + cType + subject + toName + templateID + content = do + url <- endPointUrl apiKey + let campaign = Campaign { c_apikey = apiKey + , c_type = cType + , c_options = Options { o_list_id = listID + , o_subject = subject + , o_from_email = fromEmail + , o_from_name = fromName + , o_to_name = toName + , o_template_id = templateID } + , c_content = (HTML content) } + let eUrl = url ++ "/campaigns/create.json" + response <- processResponse eUrl campaign apiKey + let resBody = decode (responseBody response) :: Maybe Value + let cid = resBody ^. key "id" :: Maybe String + return cid + +-- | Send a saved email campaign +sendEmail + :: String -- ^ API key + -> String -- ^ Campaign ID + -> IO (Either String SendMailResponse) -- ^ 'SendMailResponse' JSON response +sendEmail apiKey cid = do + url <- endPointUrl apiKey + let mail = SendMail { m_apikey = apiKey + , m_cid = cid } + let sUrl = url ++ "/campaigns/send.json" + response <- processResponse sUrl mail apiKey + let sendRes = eitherDecode (responseBody response) :: Either String SendMailResponse + return sendRes + +-- | Add a new subscriber +addSubscriber + :: String -- ^ API key + -> String -- ^ List ID + -> String -- ^ Email address to be added + -> String -- ^ Email type, choose from "html", "text" + -> IO (Either String SubscriptionResponse) -- ^ 'SubscriptionResponse' response +addSubscriber apiKey listID email emailType = do + url <- endPointUrl apiKey + let subscription = Subscription { s_apikey = apiKey + , s_id = listID + , s_email = (Email email) + , s_email_type = emailType + , s_dou_opt = True + , s_up_ex = True + , s_rep_int = True + , s_send = True } + let sUrl = url ++ "/lists/subscribe.json" + response <- processResponse sUrl subscription apiKey + let resBody = eitherDecode (responseBody response) :: Either String SubscriptionResponse + return resBody + +-- | Add a batch of subscribers +batchSubscribe + :: String -- ^ API key + -> String -- ^ List ID + -> [String] -- ^ List of email addresses to be added + -> IO BatchSubscriptionResponse -- ^ 'BatchSubscriptionResponse' response +batchSubscribe apiKey listID emails = do + url <- endPointUrl apiKey + let emailArry = [ Batch { b_email = (Email x), b_email_type = "html"} | x <- emails] + let batchSubscription = BatchSubscription { b_apikey = apiKey + , b_id = listID + , b_batch = emailArry + , b_dou_opt = True + , b_up_ex = True + , b_rep_int = True } + let bUrl = url ++ "/lists/batch-subscribe.json" + response <- processResponse bUrl batchSubscription apiKey + let resBody = decode (responseBody response) :: Maybe Value + let batchResponse = BatchSubscriptionResponse { add_count = resBody ^. key "add_count" :: Maybe Int + , adds = getValues (resBody ^. key "adds" :: Maybe Array) } + return batchResponse + where getValues ls + | ls /= (Just V.empty) = constructBSRes (fmap V.head ls) : getValues (fmap V.tail ls) + | otherwise = [] + constructBSRes elem = decode (encode elem) :: Maybe SubscriptionResponse + + +-- | Build the response from URL and JSON data +processResponse url jsonData apiKey = do + initReq <- liftIO $ parseUrl url + let req = initReq { requestBody = RequestBodyLBS $ encode jsonData + , method = methodPost } + catch (withManager $ httpLbs req) + (\(StatusCodeException s h c) -> do let ex = (show s ++ "," ++ show h ++ "," ++ show c) + getResponse s h c apiKey + exitWith (ExitFailure 0)) + +-- | Construct the erroneous HTTP responses when an exception occurs +getResponse s h c apiKey = do + url <- endPointUrl apiKey + initReq <- parseUrl url + let req = initReq { method = methodPost } + response <- withManager $ httpLbs req + let errorRes = response { responseStatus = s + , responseVersion = http11 + , responseBody = "" + , responseHeaders = h + , responseCookieJar = c } + return errorRes + +-- | Construct the end-point URL +endPointUrl :: String -> IO String +endPointUrl apiKey = return ("https://" ++ (last (splitString '-' apiKey)) ++ ".api.mailchimp.com/2.0") + +-- | Utility function to split strings +splitString :: Char -> String -> [String] +splitString d [] = [] +splitString d s = x : splitString d (drop 1 y) where (x,y) = span (/= d) s
+ MailchimpSimple/Logger.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE OverloadedStrings #-} + +module MailchimpSimple.Logger ( LogLevels(..) + , writeLog ) where + +import Data.Time +import System.FilePath.Posix +import System.Directory ( doesDirectoryExist , createDirectory ) + +-- | Constructor for the Log levels +data LogLevels = ERROR | DEBUG | INFO deriving (Show, Eq) + +-- { +-- Constructor for the Log entry = (LogEntry LogLevels logging logInputData logMessage) +-- logLevel -> Logging purpose (ERROR/INFO/DEBUG) +-- loggingMethod-> Module of the program which writes the log +-- logInputData -> Input data at the point of logging +-- logMessage -> Output message of the method +-- } +data Logger = LogEntry LogLevels String String String deriving (Show, Eq) + +toString :: Logger -> IO String +toString (LogEntry lLevel lMethod lInputData lMessage) = do + utcTime <- getCurrentTime + let myTime = addUTCTime 19800 utcTime + return $ show myTime ++ ", [" ++ show lLevel ++ "], [" ++ lMethod ++ "], Input: " ++ lInputData ++ ", " ++ lMessage + +-- { +-- Append the log entry to an external log file +-- Error logs to 'error.log' file +-- Other logs to 'access.log' file +-- } +writeLog :: LogLevels -> String -> String -> String -> IO () +writeLog lLevel lMethod lInputData lMessage = do + logEntry <- toString (LogEntry lLevel lMethod lInputData lMessage) + let logEntryProcessed = logEntry ++ "\n" + exists <- doesDirectoryExist "log" + if (exists == True) then return () else (createDirectory "log") + if lLevel == ERROR + then appendFile ("log" ++ [pathSeparator] ++ "error.log") logEntryProcessed + else appendFile ("log" ++ [pathSeparator] ++ "access.log") logEntryProcessed
+ MailchimpSimple/Types.hs view
@@ -0,0 +1,352 @@+{-# LANGUAGE DeriveGeneric, OverloadedStrings #-} + +module MailchimpSimple.Types + ( + -- * Request JSON data types + Subscription(..) + , EmailId(..) + , MailList(..) + , Filters(..) + , Subscribers(..) + , BatchSubscription(..) + , Batch(..) + , Campaign(..) + , Options(..) + , Content(..) + , SendMail(..) + , Template(..) + , TemplateTypes(..) + -- * Response JSON data types + , SubscriptionResponse(..) + , MailListResponse(..) + , ListSubscribersResponse(..) + , BatchSubscriptionResponse(..) + , SendMailResponse(..) + , TemplateResponse(..) + ) where + +import Data.Aeson -- ( FromJSON(..), ToJSON(..), toJSON, parseJSON, (.:), (.:?), (.=), object, Value(..) ) +import Data.Aeson.TH hiding ( Options ) +import GHC.Generics hiding ( head ) +import Control.Monad ( mzero ) +import Data.Maybe ( catMaybes ) + +-- | JSON data structure for a single subscription +data Subscription = + Subscription { + s_apikey :: String -- ^ API key of the Mailchimp account + , s_id :: String -- ^ List ID of the mailing list, by calling + , s_email :: EmailId -- ^ Example: jon@example.com + , s_email_type :: String -- ^ Give html/text + , s_dou_opt :: Bool + , s_up_ex :: Bool + , s_rep_int :: Bool + , s_send :: Bool + } deriving (Show) + +instance FromJSON Subscription where + parseJSON (Object v) = do + sApikey <- v .: "apikey" + sID <- v .: "id" + sEmail <- v .: "email" + sEmailType <- v .: "email_type" + sDouOpt <- v .: "double_optin" + sUpEx <- v .: "update_existing" + sRepInt <- v .: "replace_interests" + sSent <- v .: "send_welcome" + return $ Subscription sApikey sID sEmail sEmailType sDouOpt sUpEx sRepInt sSent + parseJSON _ = mzero +instance ToJSON Subscription where + toJSON (Subscription s_apikey s_id s_email s_email_type s_dou_opt s_up_ex s_rep_int s_send) = object [ "apikey" .= s_apikey + , "id" .= s_id + , "email" .= s_email + , "email_type" .= s_email_type + , "double_optin" .= s_dou_opt + , "update_existing" .= s_up_ex + , "replace_interests" .= s_rep_int + , "send_welcome" .= s_send ] + +-- | Enum type JSON data structure for Email related variables +data EmailId = Email String + | EmailUniqueId String + | ListEmailId String + deriving (Show) + +instance FromJSON EmailId where + parseJSON (Object v) = do + email <- fmap (fmap Email) $ v .:? "email" + euid <- fmap (fmap EmailUniqueId) $ v .:? "euid" + leid <- fmap (fmap ListEmailId) $ v .:? "leid" + case catMaybes [email, euid, leid] of + (x:_) -> return x + _ -> mzero + parseJSON _ = mzero +instance ToJSON EmailId where + toJSON (Email t) = object ["email" .= t] + toJSON (EmailUniqueId t) = object ["euid" .= t] + toJSON (ListEmailId t) = object ["leid" .= t] + + +-- | JSON data structure for batch subscriptions +data BatchSubscription = + BatchSubscription { + b_apikey :: String -- ^ API key of the Mailchimp account + , b_id :: String -- ^ List ID of the mailing list + , b_batch :: [Batch] -- ^ Array of tuples of email address and email type + , b_dou_opt :: Bool + , b_up_ex :: Bool + , b_rep_int :: Bool + } deriving (Show) + +instance FromJSON BatchSubscription where + parseJSON (Object v) = do + bApikey <- v .: "apikey" + bID <- v .: "id" + bBatch <- v .: "batch" + bDouOpt <- v .: "double_optin" + bUpEx <- v .: "update_existing" + bRepInt <- v .: "replace_interests" + return $ BatchSubscription bApikey bID bBatch bDouOpt bUpEx bRepInt + parseJSON _ = mzero +instance ToJSON BatchSubscription where + toJSON (BatchSubscription b_apikey b_id b_batch b_dou_opt b_up_ex b_rep_int) = object [ "apikey" .= b_apikey + , "id" .= b_id + , "batch" .= b_batch + , "double_optin" .= b_dou_opt + , "update_existing" .= b_up_ex + , "replace_interests" .= b_rep_int ] + +data Batch = + Batch { b_email :: EmailId + , b_email_type :: String + } deriving (Show) + +instance FromJSON Batch where + parseJSON (Object v) = do + bEmail <- v .: "email" + bEmailType <- v .: "email_type" + return $ Batch bEmail bEmailType + parseJSON _ = mzero +instance ToJSON Batch where + toJSON (Batch b_email b_email_type) = object [ "email" .= b_email + , "email_type" .= b_email_type ] + +data MailList = + MailList { + l_apikey :: String -- ^ API key of the Mailchimp account + , l_filters :: Filters + , l_start :: Int + , l_limit :: Int + , l_sort_field :: String + , l_sort_dir :: String + } deriving (Show) + +instance FromJSON MailList where + parseJSON (Object v) = do + lApikey <- v .: "apikey" + lFilters <- v .: "filters" + lStart <- v .: "start" + lLimit <- v .: "limit" + lSortField <- v .: "sort_field" + lSortDir <- v .: "sort_dir" + return $ MailList lApikey lFilters lStart lLimit lSortField lSortDir + parseJSON _ = mzero +instance ToJSON MailList where + toJSON (MailList l_apikey l_filters l_start l_limit l_sort_field l_sort_dir) = object [ "apikey" .= l_apikey + , "filters" .= l_filters + , "start" .= l_start + , "limit" .= l_limit + , "sort_field" .= l_sort_field + , "sort_dir" .= l_sort_dir ] + +data Filters = + Filters { + list_id :: String + , list_name :: String + } deriving (Show) + +instance FromJSON Filters where + parseJSON (Object v) = do + lID <- v .: "id" + lName <- v .: "name" + return $ Filters lID lName + parseJSON _ = mzero +instance ToJSON Filters where + toJSON (Filters list_id list_name) = object [ "id" .= list_id + , "name" .= list_name ] + +data Subscribers = + Subscribers { + su_apikey :: String -- ^ API key of the Mailchimp account + , su_id :: String -- ^ List ID of the mailing list + , su_status :: String + } deriving (Show) + +instance FromJSON Subscribers where + parseJSON (Object v) = do + suApikey <- v .: "apikey" + suID <- v .: "id" + suStatus <- v .: "status" + return $ Subscribers suApikey suID suStatus + parseJSON _ = mzero +instance ToJSON Subscribers where + toJSON (Subscribers su_apikey su_id su_status) = object [ "apikey" .= su_apikey + , "id" .= su_id + , "status" .= su_status] + +data Campaign = + Campaign { + c_apikey :: String + , c_type :: String + , c_options :: Options + , c_content :: Content + } deriving (Show, Generic) + +instance FromJSON Campaign where +instance ToJSON Campaign where + toJSON (Campaign c_apikey c_type c_options c_content) = object [ "apikey" .= c_apikey + , "type" .= c_type + , "options" .= c_options + , "content" .= c_content ] + +data Options = + Options { + o_list_id :: String + , o_subject :: String + , o_from_email :: String + , o_from_name :: String + , o_to_name :: String + , o_template_id :: Int + } deriving (Show, Generic) + +instance FromJSON Options where +instance ToJSON Options where + toJSON (Options o_list_id o_subject o_from_email o_from_name o_to_name o_template_id) = object [ "list_id" .= o_list_id + , "subject" .= o_subject + , "from_email" .= o_from_email + , "from_name" .= o_from_name + , "to_name" .= o_to_name + , "template_id" .= o_template_id ] +data Content = HTML String + | Text String + | URL String + deriving (Show) + +instance ToJSON Content where + toJSON (HTML t) = object ["html" .= t] + toJSON (Text t) = object ["text" .= t] + toJSON (URL t) = object ["url" .= t] + +instance FromJSON Content where + parseJSON (Object v) = do + html <- fmap (fmap HTML) $ v .:? "html" + text <- fmap (fmap Text) $ v .:? "text" + url <- fmap (fmap URL) $ v .:? "url" + case catMaybes [html, text, url] of + (x:_) -> return x + _ -> mzero + parseJSON _ = mzero + +data SendMail = + SendMail { + m_apikey :: String -- ^ API key of the Mailchimp account + , m_cid :: String -- ^ Campaign ID of the campaign to be sent + } deriving (Show, Generic) + +instance FromJSON SendMail where +instance ToJSON SendMail where + toJSON (SendMail m_apikey m_cid) = object [ "apikey" .= m_apikey + , "cid" .= m_cid ] + +data Template = + Template { + t_apikey :: String + , t_types :: TemplateTypes + } deriving (Show, Generic) + +instance FromJSON Template where +instance ToJSON Template where + toJSON (Template t_apikey t_types) = object [ "apikey" .= t_apikey + , "types" .= t_types ] + +data TemplateTypes = + TemplateTypes { + user :: Bool + , gallery :: Bool + , base :: Bool + } deriving (Show, Generic) + +instance FromJSON TemplateTypes where +instance ToJSON TemplateTypes where + +-- | Response JSON from 'lists/subscribe.json' call +data SubscriptionResponse = + SubscriptionResponse { + email :: String + , euid :: String + , leid :: String + } deriving (Show) + +instance FromJSON SubscriptionResponse where + parseJSON (Object v) = do + srEmail <- v .: "email" + srEuid <- v .: "euid" + srLeid <- v .: "leid" + return $ SubscriptionResponse srEmail srEuid srLeid + parseJSON _ = mzero +instance ToJSON SubscriptionResponse where + toJSON (SubscriptionResponse email euid leid) = object [ "email" .= email + , "euid" .= euid + , "leid" .= leid ] + +-- | Response JSON from 'lists/list.json' call, which lists the mailing lists +-- in the given account with relevant API key +data MailListResponse = + MailListResponse { + l_name :: Maybe String -- ^ List name + , l_id :: Maybe String -- ^ List ID + } deriving (Show, Generic) + +instance FromJSON MailListResponse where +instance ToJSON MailListResponse where + +-- | Response JSON from 'lists/members.json' call, which contains the details +-- each subscriber in the given mailing list +data ListSubscribersResponse = + ListSubscribersResponse { + s_name :: Maybe String -- ^ Subscriber's name + , s_euid :: Maybe String -- ^ Subscriber's euid + , s_list_name :: Maybe String + , s_emailType :: Maybe String + } deriving (Show, Generic) + +instance FromJSON ListSubscribersResponse where +instance ToJSON ListSubscribersResponse where + +-- | Response JSON from the 'lists/batch-subscribe.json' call, which contains the +-- information of the subscriptions of each newly added member +data BatchSubscriptionResponse = + BatchSubscriptionResponse { + add_count :: Maybe Int + , adds :: [Maybe SubscriptionResponse] + } deriving (Show, Generic) + +instance FromJSON BatchSubscriptionResponse where +instance ToJSON BatchSubscriptionResponse where + +data SendMailResponse = + SendMailResponse { + complete :: Bool + } deriving (Show, Generic) + +instance FromJSON SendMailResponse where +instance ToJSON SendMailResponse where + +data TemplateResponse = + TemplateResponse { + t_name :: Maybe String + , t_id :: Maybe Int + } deriving (Show, Generic) + +instance FromJSON TemplateResponse where +instance ToJSON TemplateResponse where
+ README.md view
@@ -0,0 +1,23 @@+# MailchimpSimple+A library to handle mailing lists in Mailchimp (http://mailchimp.com/)++# Introduction+This library is written in Haskell, to interact with Mailchimp's JSON API. The initial commit supports only the Mailchimp 2.0 version.+This currently implements couple of methods in the 'lists' section, they are;++- Adding subscribers+- List out the subscribers in a mailing list+- List the mailing lists for given 'apikey'+- Past activities performed on a mailing list++I hope to develop this further to support Mailchimp version 3.0 as well. Here is the link for the blog post written on this [http://dananjiliyanage.blogspot.com/2015/07/develop-mailchimp-library-with-haskell.html]++# How to use++Given that you have installed Haskell platform in your machine; +(If not, follow this link: https://www.haskell.org/platform/windows.html)++1. Clone the Git repository using 'git clone https://github.com/Dananji/MailchimpSimple.git'+2. Open the terminal, and browse into the cloned project folder+4. Run 'cabal update' +3. Then type 'cabal install' in the terminal
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple +main = defaultMain