{-# 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