module Web.MailChimp.List.Member
( ListMemberApi
, ListMemberClient (..)
, ListMemberRequest (..)
, makeListMemberRequest
, ListMemberResponse (..)
, ListMembersResponse (..)
, getAllListMembers
, ListMemberId
, ListMemberStatus (..)
)
where
import Data.Aeson
import qualified Data.Aeson as Aeson
import GHC.Generics
import Generics.SOP
import Web.MailChimp.Common
import Servant.API
import Servant.Client
import Servant.Client.Generic
import Data.Text (Text)
type ListMemberId =
Id
type ListMemberApi =
ReqBody '[JSON] ListMemberRequest
:> Post '[JSON] ListMemberResponse
:<|>
QueryParam "offset" Int
:> Get '[JSON] ListMembersResponse
:<|>
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
{
addListMember
:: ListMemberRequest
-> ClientM ListMemberResponse
, getListMembers
:: Maybe Int
-> ClientM ListMembersResponse
, getListMember
:: ListMemberId
-> ClientM ListMemberResponse
, updateListMember
:: ListMemberId
-> ListMemberRequest
-> ClientM ListMemberResponse
, addOrUpdateListMember
:: ListMemberId
-> ListMemberRequest
-> ClientM ListMemberResponse
, deleteListMember
:: ListMemberId
-> ClientM String
}
deriving (GHC.Generics.Generic)
getAllListMembers
:: ListMemberClient
-> ClientM [ListMemberResponse]
getAllListMembers ListMemberClient {..} = do
xs <- listMembersMembers <$> getListMembers Nothing
rest <- go 0 (length xs)
return $ xs ++ rest
where
go :: Int -> Int -> ClientM [ListMemberResponse]
go _ 0 = return []
go offset n = do
xs <- listMembersMembers <$> getListMembers (Just $ offset + n)
rest <- go (offset + n) (length xs)
return $ xs ++ rest
instance Generics.SOP.Generic ListMemberClient
instance (Client ListMemberApi ~ client) => ClientLike client ListMemberClient
data ListMemberRequest =
ListMemberRequest
{ listMemberEmailAddress :: Text
, listMemberMergeFields :: [(Text, Text)]
, listMemberStatus :: ListMemberStatus
, listMemberExtra :: [(Text, Aeson.Value)]
}
deriving (Show)
makeListMemberRequest
:: Text
-> 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
, listMemberResponseEmail :: Text
, listMemberResponseStatus :: ListMemberStatus
}
deriving (Show)
instance FromJSON ListMemberResponse where
parseJSON =
Aeson.withObject "" $
\o ->
ListMemberResponse
<$> o .: "id"
<*> o .: "email_address"
<*> o .: "status"
data ListMembersResponse =
ListMembersResponse
{ listMembersMembers :: [ListMemberResponse]
}
deriving (Show)
instance FromJSON ListMembersResponse where
parseJSON =
Aeson.withObject "" $
\o ->
ListMembersResponse
<$> o .: "members"
data ListMemberStatus
= Cleaned
| Pending
| Subscribed
| Unsubscribed
deriving (Show)
instance ToJSON ListMemberStatus where
toJSON Cleaned = "cleaned"
toJSON Pending = "pending"
toJSON Subscribed = "subscribed"
toJSON Unsubscribed = "unsubscribed"
instance FromJSON ListMemberStatus where
parseJSON =
Aeson.withText "" $
\s -> case s of
"cleaned" -> return Cleaned
"pending" -> return Pending
"subscribed" -> return Subscribed
"unsubscribed" -> return Unsubscribed
other -> fail $ "expected ListMemberStatus, encountered " ++ show other