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