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
data GetStandardInfo
= GetStandardInfo [User] [StandardInfoField]
deriving (Eq, Ord, Read, Show, Typeable)
data StandardInfoField
= UID
| FirstName
| LastName
| Name
| TimeZone
| Birthday
| Sex
| 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 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
, locale :: Maybe String
, profileURL :: Maybe String
, proxiedEmail :: Maybe String
}
deriving (Eq, Ord, Read, Show, Typeable)
instance JSON StandardInfo where
readJSON = parseStandardInfo
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"
, sex = parseSex =<< val "sex"
, locale = val "locale"
, profileURL = val "profile_url"
, 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)
]