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

import Control.Applicative
import Control.Applicative.Error
import Control.Monad (mzero)
import Data.Traversable (sequenceA)
import Data.Generics (Data, Typeable)
import Data.Ix (Ix)
import qualified Data.Map as Map
import Data.List (intercalate)
import Data.Maybe (catMaybes)
import Data.Time  (Day, TimeZone)
import Data.Time.LocalTime (hoursToTimeZone)
import Happstack.Facebook.Common hiding (uid, name)
import qualified Happstack.Facebook.Common as C
import Text.JSON

-- * Users

-- ** Users.getStandardInfo

-- TODO: add Data instances once TimeZone and Day have them

data GetStandardInfo
    = GetStandardInfo [User] [StandardInfoField]
      deriving (Eq, Ord, Read, Show, Typeable)

data StandardInfoField
    = UID
    | FirstName
    | LastName
    | Name
    | TimeZone
    | Birthday
    | Sex
--    | Affiliations -- ^ not supported but could be if you write the parser instance
    | Locale
    | ProfileURL
    | ProxiedEmail
      deriving (Eq, Ord, Read, Show, Data, Typeable, Ix, Enum)

instance JSON StandardInfoField where
    showJSON UID          = showJSON "uid"
    showJSON FirstName    = showJSON "first_name"
    showJSON LastName     = showJSON "last_name"
    showJSON Name         = showJSON "name"
    showJSON TimeZone     = showJSON "timezone"
    showJSON Birthday     = showJSON "birthday"
    showJSON Sex          = showJSON "sex"
--    showJSON Affiliations = showJSON "affiliations"
    showJSON Locale       = showJSON "locale"
    showJSON ProfileURL   = showJSON "profile_url"
    showJSON ProxiedEmail = showJSON "proxied_email"
    readJSON (JSString jsstr) =
        let str = fromJSString jsstr in
        case str of
          "uid"           -> Ok UID
          "first_name"    -> Ok FirstName
          "last_name"     -> Ok LastName
          "name"          -> Ok Name
          "timezone"      -> Ok TimeZone
          "birthday"      -> Ok Birthday
          "sex"           -> Ok Sex
          "locale"        -> Ok Locale
          "profile_url"   -> Ok ProfileURL
          "proxied_email" -> Ok ProxiedEmail
          o               -> Error $ "Could not parse " ++ o ++ " as a StandardInfoField."
    readJSON jsval =         Error $ "Could not parse " ++ show jsval ++ " as a StandardInfoField."

data StandardInfo
    = StandardInfo { uid          :: Maybe User
                   , firstName    :: Maybe String
                   , lastName     :: Maybe String
                   , name         :: Maybe String
                   , timeZone     :: Maybe TimeZone
                   , birthday     :: Maybe String
                   , sex          :: Maybe Sex
--                   , affiliations :: 
                   , locale       :: Maybe String
                   , profileURL   :: Maybe String
                   , proxiedEmail :: Maybe String
                   }
      deriving (Eq, Ord, Read, Show, Typeable)

-- parseStandardInfos :: JSValue -> Result [StandardInfo]
-- parseStandardInfos (JSArray vals) = sequenceA $ map parseStandardInfo vals
   
instance JSON StandardInfo where
    readJSON = parseStandardInfo

-- [{"birthday":"January 6, 1977","first_name":"Jane","last_name":"Rahre","name":"Jane Rahre","sex":"female","timezone":-5,"uid":100000160317250,"locale":"en_US","profile_url":"http:\/\/www.facebook.com\/profile.php?id=100000160317250"}]

parseStandardInfo :: JSValue -> Result StandardInfo
parseStandardInfo (JSObject obj) =
    Ok $ StandardInfo { uid       = User <$> val "uid"
                      , firstName = val "first_name"
                      , lastName  = val "last_name"
                      , name      = val "name"
                      , timeZone  = toTZ <$> val "timezone"
                      , birthday  = val "birthday" -- FIXME: parse to Day
                      , sex       = parseSex =<< val "sex"
                      , locale    = val "locale" -- FIXME
                      , profileURL = val "profile_url" -- FIXME
                      , proxiedEmail = val "proxied_email"
                      }
    where
      val :: (JSON a) => String -> Maybe a
      val name = r2m $ valFromObj name obj
      r2m :: Result a -> Maybe a
      r2m (Ok a) = Just a
      r2m _      = Nothing
      toTZ :: Int -> TimeZone
      toTZ = hoursToTimeZone
      parseSex "male" = return Male
      parseSex "female" = return Female
      parseSex o = mzero
parseStandardInfo o =
    Error $ "Can not parse as StandardInfo: " ++ show o

instance (HasSessionKey m) => FacebookMethod m GetStandardInfo where
    type FacebookResponse GetStandardInfo = [StandardInfo]
    parseResponse _ jstr =
        case (decode jstr) of
          (Ok a) -> Right a
          (Error msg) -> Left msg
    toParams (GetStandardInfo users fields) =
        do sessionKey <- askSessionKey
           return $ catMaybes $ 
                      [ Just ("method", "Users.getStandardInfo")
                      , Just ("session_key", sessionKey)
                      , Just ("uids", intercalate "," $ map (show . C.uid) users)
                      , Just ("fields", encode fields)
                      ]