{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}

module Facebook.Object.FriendList
  ( FriendList(..)
  , FriendListType(..)
  , getUserFriendLists
  , getFriendListMembers
  ) where
#if __GLASGOW_HASKELL__ <= 784
import Control.Applicative
#endif
import Control.Monad (mzero)
import Data.Aeson ((.:))
import Data.Text (Text)
import Data.Typeable (Typeable)

import qualified Control.Monad.Trans.Resource as R
import qualified Data.Aeson as A

import Facebook.Types
import Facebook.Monad
import Facebook.Graph
import Facebook.Pager
import Facebook.Object.User

-- | A friend list for a 'User'.
data FriendList = FriendList
  { FriendList -> Id
friendListId :: Id
  , FriendList -> Text
friendListName :: Text
  , FriendList -> FriendListType
friendListType :: FriendListType
  } deriving (FriendList -> FriendList -> Bool
(FriendList -> FriendList -> Bool)
-> (FriendList -> FriendList -> Bool) -> Eq FriendList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FriendList -> FriendList -> Bool
$c/= :: FriendList -> FriendList -> Bool
== :: FriendList -> FriendList -> Bool
$c== :: FriendList -> FriendList -> Bool
Eq, Eq FriendList
Eq FriendList
-> (FriendList -> FriendList -> Ordering)
-> (FriendList -> FriendList -> Bool)
-> (FriendList -> FriendList -> Bool)
-> (FriendList -> FriendList -> Bool)
-> (FriendList -> FriendList -> Bool)
-> (FriendList -> FriendList -> FriendList)
-> (FriendList -> FriendList -> FriendList)
-> Ord FriendList
FriendList -> FriendList -> Bool
FriendList -> FriendList -> Ordering
FriendList -> FriendList -> FriendList
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FriendList -> FriendList -> FriendList
$cmin :: FriendList -> FriendList -> FriendList
max :: FriendList -> FriendList -> FriendList
$cmax :: FriendList -> FriendList -> FriendList
>= :: FriendList -> FriendList -> Bool
$c>= :: FriendList -> FriendList -> Bool
> :: FriendList -> FriendList -> Bool
$c> :: FriendList -> FriendList -> Bool
<= :: FriendList -> FriendList -> Bool
$c<= :: FriendList -> FriendList -> Bool
< :: FriendList -> FriendList -> Bool
$c< :: FriendList -> FriendList -> Bool
compare :: FriendList -> FriendList -> Ordering
$ccompare :: FriendList -> FriendList -> Ordering
$cp1Ord :: Eq FriendList
Ord, Int -> FriendList -> ShowS
[FriendList] -> ShowS
FriendList -> String
(Int -> FriendList -> ShowS)
-> (FriendList -> String)
-> ([FriendList] -> ShowS)
-> Show FriendList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FriendList] -> ShowS
$cshowList :: [FriendList] -> ShowS
show :: FriendList -> String
$cshow :: FriendList -> String
showsPrec :: Int -> FriendList -> ShowS
$cshowsPrec :: Int -> FriendList -> ShowS
Show, ReadPrec [FriendList]
ReadPrec FriendList
Int -> ReadS FriendList
ReadS [FriendList]
(Int -> ReadS FriendList)
-> ReadS [FriendList]
-> ReadPrec FriendList
-> ReadPrec [FriendList]
-> Read FriendList
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FriendList]
$creadListPrec :: ReadPrec [FriendList]
readPrec :: ReadPrec FriendList
$creadPrec :: ReadPrec FriendList
readList :: ReadS [FriendList]
$creadList :: ReadS [FriendList]
readsPrec :: Int -> ReadS FriendList
$creadsPrec :: Int -> ReadS FriendList
Read, Typeable)

instance A.FromJSON FriendList where
  parseJSON :: Value -> Parser FriendList
parseJSON (A.Object Object
v) =
    Id -> Text -> FriendListType -> FriendList
FriendList (Id -> Text -> FriendListType -> FriendList)
-> Parser Id -> Parser (Text -> FriendListType -> FriendList)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Id
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id" Parser (Text -> FriendListType -> FriendList)
-> Parser Text -> Parser (FriendListType -> FriendList)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name" Parser (FriendListType -> FriendList)
-> Parser FriendListType -> Parser FriendList
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser FriendListType
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"list_type"
  parseJSON Value
_ = Parser FriendList
forall (m :: * -> *) a. MonadPlus m => m a
mzero

data FriendListType
  = CloseFriendsList
  | AcquaintancesList
  | RestrictedList
  | UserCreatedList
  | EducationList
  | WorkList
  | CurrentCityList
  | FamilyList
  deriving (FriendListType -> FriendListType -> Bool
(FriendListType -> FriendListType -> Bool)
-> (FriendListType -> FriendListType -> Bool) -> Eq FriendListType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FriendListType -> FriendListType -> Bool
$c/= :: FriendListType -> FriendListType -> Bool
== :: FriendListType -> FriendListType -> Bool
$c== :: FriendListType -> FriendListType -> Bool
Eq, Eq FriendListType
Eq FriendListType
-> (FriendListType -> FriendListType -> Ordering)
-> (FriendListType -> FriendListType -> Bool)
-> (FriendListType -> FriendListType -> Bool)
-> (FriendListType -> FriendListType -> Bool)
-> (FriendListType -> FriendListType -> Bool)
-> (FriendListType -> FriendListType -> FriendListType)
-> (FriendListType -> FriendListType -> FriendListType)
-> Ord FriendListType
FriendListType -> FriendListType -> Bool
FriendListType -> FriendListType -> Ordering
FriendListType -> FriendListType -> FriendListType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FriendListType -> FriendListType -> FriendListType
$cmin :: FriendListType -> FriendListType -> FriendListType
max :: FriendListType -> FriendListType -> FriendListType
$cmax :: FriendListType -> FriendListType -> FriendListType
>= :: FriendListType -> FriendListType -> Bool
$c>= :: FriendListType -> FriendListType -> Bool
> :: FriendListType -> FriendListType -> Bool
$c> :: FriendListType -> FriendListType -> Bool
<= :: FriendListType -> FriendListType -> Bool
$c<= :: FriendListType -> FriendListType -> Bool
< :: FriendListType -> FriendListType -> Bool
$c< :: FriendListType -> FriendListType -> Bool
compare :: FriendListType -> FriendListType -> Ordering
$ccompare :: FriendListType -> FriendListType -> Ordering
$cp1Ord :: Eq FriendListType
Ord, Int -> FriendListType -> ShowS
[FriendListType] -> ShowS
FriendListType -> String
(Int -> FriendListType -> ShowS)
-> (FriendListType -> String)
-> ([FriendListType] -> ShowS)
-> Show FriendListType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FriendListType] -> ShowS
$cshowList :: [FriendListType] -> ShowS
show :: FriendListType -> String
$cshow :: FriendListType -> String
showsPrec :: Int -> FriendListType -> ShowS
$cshowsPrec :: Int -> FriendListType -> ShowS
Show, ReadPrec [FriendListType]
ReadPrec FriendListType
Int -> ReadS FriendListType
ReadS [FriendListType]
(Int -> ReadS FriendListType)
-> ReadS [FriendListType]
-> ReadPrec FriendListType
-> ReadPrec [FriendListType]
-> Read FriendListType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FriendListType]
$creadListPrec :: ReadPrec [FriendListType]
readPrec :: ReadPrec FriendListType
$creadPrec :: ReadPrec FriendListType
readList :: ReadS [FriendListType]
$creadList :: ReadS [FriendListType]
readsPrec :: Int -> ReadS FriendListType
$creadsPrec :: Int -> ReadS FriendListType
Read, Int -> FriendListType
FriendListType -> Int
FriendListType -> [FriendListType]
FriendListType -> FriendListType
FriendListType -> FriendListType -> [FriendListType]
FriendListType
-> FriendListType -> FriendListType -> [FriendListType]
(FriendListType -> FriendListType)
-> (FriendListType -> FriendListType)
-> (Int -> FriendListType)
-> (FriendListType -> Int)
-> (FriendListType -> [FriendListType])
-> (FriendListType -> FriendListType -> [FriendListType])
-> (FriendListType -> FriendListType -> [FriendListType])
-> (FriendListType
    -> FriendListType -> FriendListType -> [FriendListType])
-> Enum FriendListType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: FriendListType
-> FriendListType -> FriendListType -> [FriendListType]
$cenumFromThenTo :: FriendListType
-> FriendListType -> FriendListType -> [FriendListType]
enumFromTo :: FriendListType -> FriendListType -> [FriendListType]
$cenumFromTo :: FriendListType -> FriendListType -> [FriendListType]
enumFromThen :: FriendListType -> FriendListType -> [FriendListType]
$cenumFromThen :: FriendListType -> FriendListType -> [FriendListType]
enumFrom :: FriendListType -> [FriendListType]
$cenumFrom :: FriendListType -> [FriendListType]
fromEnum :: FriendListType -> Int
$cfromEnum :: FriendListType -> Int
toEnum :: Int -> FriendListType
$ctoEnum :: Int -> FriendListType
pred :: FriendListType -> FriendListType
$cpred :: FriendListType -> FriendListType
succ :: FriendListType -> FriendListType
$csucc :: FriendListType -> FriendListType
Enum, Typeable)

instance A.FromJSON FriendListType where
  parseJSON :: Value -> Parser FriendListType
parseJSON (A.String Text
"close_friends") = FriendListType -> Parser FriendListType
forall (m :: * -> *) a. Monad m => a -> m a
return FriendListType
CloseFriendsList
  parseJSON (A.String Text
"acquaintances") = FriendListType -> Parser FriendListType
forall (m :: * -> *) a. Monad m => a -> m a
return FriendListType
AcquaintancesList
  parseJSON (A.String Text
"restricted") = FriendListType -> Parser FriendListType
forall (m :: * -> *) a. Monad m => a -> m a
return FriendListType
RestrictedList
  parseJSON (A.String Text
"user_created") = FriendListType -> Parser FriendListType
forall (m :: * -> *) a. Monad m => a -> m a
return FriendListType
UserCreatedList
  parseJSON (A.String Text
"education") = FriendListType -> Parser FriendListType
forall (m :: * -> *) a. Monad m => a -> m a
return FriendListType
EducationList
  parseJSON (A.String Text
"work") = FriendListType -> Parser FriendListType
forall (m :: * -> *) a. Monad m => a -> m a
return FriendListType
WorkList
  parseJSON (A.String Text
"current_city") = FriendListType -> Parser FriendListType
forall (m :: * -> *) a. Monad m => a -> m a
return FriendListType
CurrentCityList
  parseJSON (A.String Text
"family") = FriendListType -> Parser FriendListType
forall (m :: * -> *) a. Monad m => a -> m a
return FriendListType
FamilyList
  parseJSON Value
_ = Parser FriendListType
forall (m :: * -> *) a. MonadPlus m => m a
mzero

instance A.ToJSON FriendListType where
  toJSON :: FriendListType -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value)
-> (FriendListType -> Text) -> FriendListType -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FriendListType -> Text
toText
    where
      toText :: FriendListType -> Text
      toText :: FriendListType -> Text
toText FriendListType
CloseFriendsList = Text
"close_friends"
      toText FriendListType
AcquaintancesList = Text
"aquaintances"
      toText FriendListType
RestrictedList = Text
"restricted"
      toText FriendListType
UserCreatedList = Text
"user_created"
      toText FriendListType
EducationList = Text
"education"
      toText FriendListType
WorkList = Text
"work"
      toText FriendListType
CurrentCityList = Text
"current_city"
      toText FriendListType
FamilyList = Text
"family"

-- close_friends, acquaintances, restricted, user_created, education, work, current_city, family
-- | Get the friend lists of the given user.
getUserFriendLists
  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)
  => UserId -- ^ User ID or @\"me\"@.
  -> [Argument] -- ^ Arguments to be passed to Facebook.
  -> UserAccessToken -- ^ User access token.
  -> FacebookT anyAuth m (Pager FriendList)
getUserFriendLists :: Id
-> [Argument]
-> UserAccessToken
-> FacebookT anyAuth m (Pager FriendList)
getUserFriendLists Id
id_ [Argument]
query UserAccessToken
token =
  Text
-> [Argument]
-> Maybe UserAccessToken
-> FacebookT anyAuth m (Pager FriendList)
forall (m :: * -> *) a anyKind anyAuth.
(MonadResource m, MonadUnliftIO m, MonadThrow m, FromJSON a) =>
Text
-> [Argument]
-> Maybe (AccessToken anyKind)
-> FacebookT anyAuth m a
getObject (Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Id -> Text
idCode Id
id_ Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/friendlists") [Argument]
query (UserAccessToken -> Maybe UserAccessToken
forall a. a -> Maybe a
Just UserAccessToken
token)

-- | Get the members of a friend list.
getFriendListMembers
  :: (R.MonadResource m, R.MonadUnliftIO m, R.MonadThrow m)
  => Id -- ^ List ID.
  -> [Argument] -- ^ Arguments to be passed to Facebook.
  -> UserAccessToken -- ^ User access token.
  -> FacebookT anyAuth m (Pager Friend)
getFriendListMembers :: Id
-> [Argument]
-> UserAccessToken
-> FacebookT anyAuth m (Pager Friend)
getFriendListMembers Id
id_ [Argument]
query UserAccessToken
token =
  Text
-> [Argument]
-> Maybe UserAccessToken
-> FacebookT anyAuth m (Pager Friend)
forall (m :: * -> *) a anyKind anyAuth.
(MonadResource m, MonadUnliftIO m, MonadThrow m, FromJSON a) =>
Text
-> [Argument]
-> Maybe (AccessToken anyKind)
-> FacebookT anyAuth m a
getObject (Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Id -> Text
idCode Id
id_ Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/members") [Argument]
query (UserAccessToken -> Maybe UserAccessToken
forall a. a -> Maybe a
Just UserAccessToken
token)