module Facebook.Graph
( getObject
, postObject
, searchObjects
, Pager(..)
, fetchNextPage
, fetchPreviousPage
, fetchAllNextPages
, fetchAllPreviousPages
, (#=)
, SimpleType(..)
, Place(..)
, Location(..)
, GeoCoordinates(..)
, Tag(..)
) where
import Control.Applicative
import Control.Monad (mzero)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Control (MonadBaseControl)
import Control.Monad.Trans.Resource (MonadResourceBase)
import Data.ByteString.Char8 (ByteString)
import Data.Int (Int8, Int16, Int32, Int64)
import Data.List (intersperse)
import Data.Text (Text)
import Data.Typeable (Typeable)
import Data.Word (Word, Word8, Word16, Word32, Word64)
import System.Locale (defaultTimeLocale)
import qualified Data.Aeson as A
import qualified Data.Aeson.Encode as AE (fromValue)
import qualified Data.ByteString.Char8 as B
import qualified Data.Conduit as C
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TLB
import qualified Data.Time as TI
import qualified Network.HTTP.Conduit as H
import qualified Network.HTTP.Types as HT
import Facebook.Auth
import Facebook.Base
import Facebook.Monad
import Facebook.Types
getObject :: (C.MonadResource m, MonadBaseControl IO m, A.FromJSON a) =>
Text
-> [Argument]
-> Maybe (AccessToken anyKind)
-> FacebookT anyAuth m a
getObject path query mtoken =
runResourceInFb $
asJson =<< fbhttp =<< fbreq path mtoken query
postObject :: (C.MonadResource m, MonadBaseControl IO m, A.FromJSON a) =>
Text
-> [Argument]
-> AccessToken anyKind
-> FacebookT Auth m a
postObject path query token =
runResourceInFb $ do
req <- fbreq path (Just token) query
asJson =<< fbhttp req { H.method = HT.methodPost }
searchObjects :: (C.MonadResource m, MonadBaseControl IO m, A.FromJSON a)
=> Text
-> Text
-> [Argument]
-> Maybe UserAccessToken
-> FacebookT anyAuth m (Pager a)
searchObjects objectType keyword query = getObject "/search" query'
where query' = ("q" #= keyword) : ("type" #= objectType) : query
data Pager a =
Pager {
pagerData :: [a]
, pagerPrevious :: Maybe String
, pagerNext :: Maybe String
} deriving (Eq, Ord, Show, Read, Typeable)
instance A.FromJSON a => A.FromJSON (Pager a) where
parseJSON (A.Object v) =
let paging f = v A..:? "paging" >>= maybe (return Nothing) (A..:? f)
in Pager <$> v A..: "data"
<*> paging "previous"
<*> paging "next"
parseJSON _ = mzero
fetchNextPage :: (C.MonadResource m, MonadBaseControl IO m, A.FromJSON a) =>
Pager a -> FacebookT anyAuth m (Maybe (Pager a))
fetchNextPage = fetchHelper pagerNext
fetchPreviousPage :: (C.MonadResource m, MonadBaseControl IO m, A.FromJSON a) =>
Pager a -> FacebookT anyAuth m (Maybe (Pager a))
fetchPreviousPage = fetchHelper pagerPrevious
fetchHelper :: (C.MonadResource m, MonadBaseControl IO m, A.FromJSON a) =>
(Pager a -> Maybe String) -> Pager a -> FacebookT anyAuth m (Maybe (Pager a))
fetchHelper pagerRef pager =
case pagerRef pager of
Nothing -> return Nothing
Just url -> do
req <- liftIO (H.parseUrl url)
Just <$> (asJson =<< fbhttp req { H.redirectCount = 3 })
fetchAllNextPages ::
(Monad m, MonadResourceBase n, A.FromJSON a) =>
Pager a -> FacebookT anyAuth m (C.Source n a)
fetchAllNextPages = fetchAllHelper pagerNext
fetchAllPreviousPages ::
(Monad m, MonadResourceBase n, A.FromJSON a) =>
Pager a -> FacebookT anyAuth m (C.Source n a)
fetchAllPreviousPages = fetchAllHelper pagerPrevious
fetchAllHelper ::
(Monad m, MonadResourceBase n, A.FromJSON a) =>
(Pager a -> Maybe String) -> Pager a -> FacebookT anyAuth m (C.Source n a)
fetchAllHelper pagerRef pager = do
manager <- getManager
let go (x:xs) mnext = C.yield x >> go xs mnext
go [] Nothing = return ()
go [] (Just next) = do
req <- liftIO (H.parseUrl next)
let get = fbhttpHelper manager req { H.redirectCount = 3 }
start =<< lift (C.runResourceT $ asJsonHelper =<< get)
start p = go (pagerData p) $! pagerRef p
return (start pager)
(#=) :: SimpleType a => ByteString -> a -> Argument
p #= v = (p, encodeFbParam v)
class SimpleType a where
encodeFbParam :: a -> B.ByteString
instance SimpleType Bool where
encodeFbParam b = if b then "1" else "0"
instance SimpleType TI.Day where
encodeFbParam = B.pack . TI.formatTime defaultTimeLocale "%Y-%m-%d"
instance SimpleType TI.UTCTime where
encodeFbParam = B.pack . TI.formatTime defaultTimeLocale "%Y%m%dT%H%MZ"
instance SimpleType TI.ZonedTime where
encodeFbParam = encodeFbParam . TI.zonedTimeToUTC
instance SimpleType Float where
encodeFbParam = showBS
instance SimpleType Double where
encodeFbParam = showBS
instance SimpleType Int where
encodeFbParam = showBS
instance SimpleType Word where
encodeFbParam = showBS
instance SimpleType Int8 where
encodeFbParam = showBS
instance SimpleType Word8 where
encodeFbParam = showBS
instance SimpleType Int16 where
encodeFbParam = showBS
instance SimpleType Word16 where
encodeFbParam = showBS
instance SimpleType Int32 where
encodeFbParam = showBS
instance SimpleType Word32 where
encodeFbParam = showBS
instance SimpleType Int64 where
encodeFbParam = showBS
instance SimpleType Word64 where
encodeFbParam = showBS
instance SimpleType Text where
encodeFbParam = TE.encodeUtf8
instance SimpleType ByteString where
encodeFbParam = id
instance SimpleType Id where
encodeFbParam = TE.encodeUtf8 . idCode
instance SimpleType Permission where
encodeFbParam = encodeFbParam . unPermission
instance SimpleType a => SimpleType [a] where
encodeFbParam = B.concat . intersperse "," . map encodeFbParam
showBS :: Show a => a -> B.ByteString
showBS = B.pack . show
data Place =
Place { placeId :: Id
, placeName :: Maybe Text
, placeLocation :: Maybe Location
}
deriving (Eq, Ord, Show, Read, Typeable)
instance A.FromJSON Place where
parseJSON (A.Object v) =
Place <$> v A..: "id"
<*> v A..:? "name"
<*> v A..:? "location"
parseJSON _ = mzero
data Location =
Location { locationStreet :: Maybe Text
, locationCity :: Maybe Text
, locationState :: Maybe Text
, locationCountry :: Maybe Text
, locationZip :: Maybe Text
, locationCoords :: Maybe GeoCoordinates
}
deriving (Eq, Ord, Show, Read, Typeable)
instance A.FromJSON Location where
parseJSON obj@(A.Object v) =
Location <$> v A..:? "street"
<*> v A..:? "city"
<*> v A..:? "state"
<*> v A..:? "country"
<*> v A..:? "zip"
<*> A.parseJSON obj
parseJSON _ = mzero
data GeoCoordinates =
GeoCoordinates { latitude :: !Double
, longitude :: !Double
}
deriving (Eq, Ord, Show, Read, Typeable)
instance A.FromJSON GeoCoordinates where
parseJSON (A.Object v) =
GeoCoordinates <$> v A..: "latitude"
<*> v A..: "longitude"
parseJSON _ = mzero
instance SimpleType GeoCoordinates where
encodeFbParam c =
let obj = A.object [ "latitude" A..= latitude c
, "longitude" A..= longitude c]
toBS = TE.encodeUtf8 . TL.toStrict . TLB.toLazyText . AE.fromValue
in toBS obj
data Tag =
Tag { tagId :: Id
, tagName :: Text
}
deriving (Eq, Ord, Show, Read, Typeable)
instance A.FromJSON Tag where
parseJSON (A.Object v) =
Tag <$> v A..: "id"
<*> v A..: "name"
parseJSON _ = mzero