{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, TypeFamilies #-}
module Happstack.Facebook.Notifications where

import Data.Generics (Data, Typeable)
import Data.Ix (Ix)
import Data.Maybe (catMaybes)
import Happstack.Facebook.Common
import Text.RJson

-- * Notifications

-- ** Notifications.get

data Get
    = Get
      deriving (Eq, Ord, Read, Show, Data, Typeable, Ix)

-- ** Notifications.send

data Send 
    = Send 
      { to_ids           :: [User]
      , notification     :: String
      , notificationType :: Maybe NotificationType
      }
      deriving (Eq, Ord, Read, Show, Data, Typeable)

data NotificationType
    = UserToUser | AppToUser
      deriving (Eq, Ord, Read, Show, Data, Typeable, Ix)

instance (HasSessionKey m) => FacebookMethod m Send where
    type FacebookResponse Send = [User]
    parseResponse _ jstr = 
        case fromJsonString [] jstr of
          Left e -> error $ "Notifications.send: " ++ show e
          Right str -> parseUserIds str
    toParams (Send to_ids notification mNotificationType) =
        do sessionKey <- askSessionKey
           return $ catMaybes $ 
                      [ Just ("method", "Notifications.send")
                      , Just ("to_ids", show $ JDArray (map (toJson . uid) to_ids))
                      , Just ("notification", notification)
                      , Just ("session_key", sessionKey)
                      , fmap (\notificationType ->
                                  ("type", case notificationType of
                                             UserToUser -> "user_to_user"
                                             AppToUser  -> "app_to_user")) mNotificationType
                      ]


-- ** Notifications.send (sessionless)

data SendNS
    = SendNS 
      { to_idsNS           :: [User]
      , notificationNS     :: String
      }
      deriving (Eq, Ord, Read, Show, Data, Typeable)

instance (Monad m) => FacebookMethod m SendNS where
    type FacebookResponse SendNS = [User]
    parseResponse _ jstr = 
        case fromJsonString [] jstr of
          Left e -> error $ "Notifications.send: " ++ show e
          Right str -> parseUserIds str
    toParams (SendNS to_ids notification) =
        do return $ catMaybes $ 
                      [ Just ("method", "Notifications.send")
                      , Just ("to_ids", show $ JDArray (map (toJson . uid) to_ids))
                      , Just ("notification", notification)
                      , Just ("type", "app_to_user")
                      ]

-- notificationsSend :: [User] -> String -> Maybe NotificationType -> Facebook (Either FacebookError [User])
-- notificationsSend users msg ntype = callMethodE (NotificationsSend users msg ntype)