Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Haskell Weekly in 2018
#!/usr/bin/env stack
-- stack --resolver lts-13.0 script
{-# OPTIONS_GHC -Weverything -Wno-implicit-prelude -Wno-unsafe #-}
module Main ( main ) where
import qualified Data.Aeson
import qualified Data.Aeson.Types
import qualified Data.List
import qualified Data.Ord
import qualified Data.Scientific
import qualified Data.Text
import qualified Data.Text.Encoding
import qualified Data.Time
import qualified Network.HTTP.Client
import qualified Network.HTTP.Client.TLS
import qualified Network.HTTP.Types
import qualified Network.URI
import qualified Numeric.Natural
import qualified System.Environment
import qualified Text.Printf
main :: IO ()
main = do
manager <- Network.HTTP.Client.TLS.newTlsManager
dataCenter <- DataCenter
. Data.Text.pack
<$> System.Environment.getEnv "MAILCHIMP_DATA_CENTER"
apiKey <- ApiKey
. Data.Text.pack
<$> System.Environment.getEnv "MAILCHIMP_API_KEY"
campaigns <- getCampaigns manager dataCenter apiKey
writeFile "campaigns.csv"
. campaignsCsv
$ Data.List.sortOn campaignSendTime campaigns
links <- getAllLinks manager dataCenter apiKey $ fmap campaignId campaigns
writeFile "links.csv"
. linksCsv
$ Data.List.sortOn (Data.Ord.Down . linkUniqueClicks) links
campaignsCsv :: [Campaign] -> String
campaignsCsv campaigns = unlines $ fmap (Data.List.intercalate ",")
( ["ID", "Sent at", "Subscribers", "Open rate", "Click rate"]
: fmap campaignCsv campaigns
)
campaignCsv :: Campaign -> [String]
campaignCsv campaign =
[ Data.Text.unpack . unwrapCampaignId $ campaignId campaign
, Data.Time.formatTime Data.Time.defaultTimeLocale "%Y-%m-%d %H:%M:%S" $ campaignSendTime campaign
, show $ campaignEmailsSent campaign
, Data.Scientific.formatScientific Data.Scientific.Fixed (Just 2) . summaryOpenRate $ campaignReportSummary campaign
, Data.Scientific.formatScientific Data.Scientific.Fixed (Just 2) . summaryClickRate $ campaignReportSummary campaign
]
linksCsv :: [Link] -> String
linksCsv links = unlines $ fmap (Data.List.intercalate ",")
( ["ID", "Campaign", "Clicks", "URL"]
: fmap linkCsv links
)
linkCsv :: Link -> [String]
linkCsv link =
[ Data.Text.unpack . unwrapLinkId $ linkId link
, Data.Text.unpack . unwrapCampaignId $ linkCampaignId link
, show $ linkUniqueClicks link
, ($ "") . Network.URI.uriToString id . unwrapUrl $ linkUrl link
]
getCampaigns
:: Network.HTTP.Client.Manager
-> DataCenter
-> ApiKey
-> IO [Campaign]
getCampaigns manager dataCenter apiKey =
campaignResponseCampaigns
<$> apiRequest manager dataCenter apiKey "campaigns"
[ ("since_send_time", "2018-01-01T00:00:00Z")
, ("before_send_time", "2019-01-01T00:00:00Z")
, ("count", "52")
]
getAllLinks
:: Network.HTTP.Client.Manager
-> DataCenter
-> ApiKey
-> [CampaignId]
-> IO [Link]
getAllLinks manager dataCenter apiKey =
fmap concat . mapM (getLinks manager dataCenter apiKey)
getLinks
:: Network.HTTP.Client.Manager
-> DataCenter
-> ApiKey
-> CampaignId
-> IO [Link]
getLinks manager dataCenter apiKey campaign =
linkResponseUrlsClicked
<$> apiRequest manager dataCenter apiKey
(Text.Printf.printf "reports/%s/click-details" $ unwrapCampaignId campaign)
[("count", "100")]
newtype LinkResponse = LinkResponse
{ linkResponseUrlsClicked :: [Link]
} deriving (Eq, Show)
instance Data.Aeson.FromJSON LinkResponse where
parseJSON = Data.Aeson.withObject "LinkResponse" $ \ object -> LinkResponse
<$> required object "urls_clicked"
data Link = Link
{ linkCampaignId :: CampaignId
, linkId :: LinkId
, linkUniqueClicks :: Numeric.Natural.Natural
, linkUrl :: Url
} deriving (Eq, Show)
instance Data.Aeson.FromJSON Link where
parseJSON = Data.Aeson.withObject "Link" $ \ object -> Link
<$> required object "campaign_id"
<*> required object "id"
<*> required object "unique_clicks"
<*> required object "url"
newtype LinkId = LinkId
{ unwrapLinkId :: Data.Text.Text
} deriving (Eq, Show)
instance Data.Aeson.FromJSON LinkId where
parseJSON = Data.Aeson.withText "LinkId" $ pure . LinkId
newtype Url = Url
{ unwrapUrl :: Network.URI.URI
} deriving (Eq, Show)
instance Data.Aeson.FromJSON Url where
parseJSON = Data.Aeson.withText "Url" $ \ text ->
case Network.URI.parseURI $ Data.Text.unpack text of
Nothing -> fail $ "invalid Url: " <> show text
Just uri -> pure $ Url uri
newtype CampaignResponse = CampaignResponse
{ campaignResponseCampaigns :: [Campaign]
} deriving (Eq, Show)
instance Data.Aeson.FromJSON CampaignResponse where
parseJSON = Data.Aeson.withObject "CampaignResponse" $ \ object -> CampaignResponse
<$> required object "campaigns"
data Campaign = Campaign
{ campaignEmailsSent :: Numeric.Natural.Natural
, campaignId :: CampaignId
, campaignReportSummary :: Summary
, campaignSendTime :: Data.Time.UTCTime
} deriving (Eq, Show)
instance Data.Aeson.FromJSON Campaign where
parseJSON = Data.Aeson.withObject "Campaign" $ \ object -> Campaign
<$> required object "emails_sent"
<*> required object "id"
<*> required object "report_summary"
<*> required object "send_time"
newtype CampaignId = CampaignId
{ unwrapCampaignId :: Data.Text.Text
} deriving (Eq, Show)
instance Data.Aeson.FromJSON CampaignId where
parseJSON = Data.Aeson.withText "CampaignId" $ pure . CampaignId
data Summary = Summary
{ summaryClickRate :: Data.Scientific.Scientific
, summaryOpenRate :: Data.Scientific.Scientific
} deriving (Eq, Show)
instance Data.Aeson.FromJSON Summary where
parseJSON = Data.Aeson.withObject "Summary" $ \ object -> Summary
<$> required object "click_rate"
<*> required object "open_rate"
newtype DataCenter = DataCenter
{ unwrapDataCenter :: Data.Text.Text
} deriving (Eq, Show)
newtype ApiKey = ApiKey
{ unwrapApiKey :: Data.Text.Text
} deriving (Eq, Show)
apiRequest
:: (Network.HTTP.Types.QueryLike query, Data.Aeson.FromJSON json)
=> Network.HTTP.Client.Manager
-> DataCenter
-> ApiKey
-> String
-> query
-> IO json
apiRequest manager dataCenter apiKey endpoint queryLike = do
request <- Network.HTTP.Client.parseUrlThrow $ Text.Printf.printf
"https://%s.api.mailchimp.com/3.0/%s"
(unwrapDataCenter dataCenter)
endpoint
let
password = Data.Text.Encoding.encodeUtf8 $ unwrapApiKey apiKey
query = Network.HTTP.Types.toQuery queryLike
response <- flip Network.HTTP.Client.httpLbs manager
. Network.HTTP.Client.applyBasicAuth mempty password
$ Network.HTTP.Client.setQueryString query request
either fail pure
. Data.Aeson.eitherDecode
$ Network.HTTP.Client.responseBody response
required
:: Data.Aeson.FromJSON value
=> Data.Aeson.Object
-> String
-> Data.Aeson.Types.Parser value
required object key = object Data.Aeson..: Data.Text.pack key
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.