fb 0.11.2.1 → 0.12

raw patch · 13 files changed

+556/−323 lines, 13 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• fb.cabal +4/−2
• src/Facebook.hs +26/−12
• src/Facebook/Base.hs +20/−6
• src/Facebook/FQL.hs +26/−0
• src/Facebook/Graph.hs +298/−38
• src/Facebook/Object/Action.hs +84/−0
• src/Facebook/Object/Checkin.hs +88/−0
• src/Facebook/Object/Page.hs +2/−3
• src/Facebook/Object/User.hs +2/−17
• src/Facebook/OpenGraph.hs +0/−240
• src/Facebook/RealTime.hs +4/−3
• src/Facebook/Types.hs +1/−1
• tests/runtests.hs +1/−1

@@ -1,5 +1,5 @@ name:              fb-version:           0.11.2.1+version:           0.12 license:           BSD3 license-file:      LICENSE author:            Felipe Lessa@@ -51,10 +51,12 @@     Facebook.Base     Facebook.Auth     Facebook.Graph+    Facebook.Object.Action+    Facebook.Object.Checkin     Facebook.Object.User     Facebook.Object.Page-    Facebook.OpenGraph     Facebook.RealTime+    Facebook.FQL   build-depends:       base               >= 4       && < 5     , lifted-base        >= 0.1     && < 0.2

@@ -33,31 +33,41 @@       -- ** Signed requests     , parseSignedRequest -      -- * Facebook's Graph API Objects+      -- * Facebook's Graph API       -- ** User     , User(..)     , UserId     , Gender(..)-    , UserLocation(..)     , getUser     , searchUsers       -- ** Page     , Page(..)     , getPage     , searchPages--      -- * Facebook's Open Graph API       -- ** Actions-    , createAction     , Action+    , createAction       -- ** Checkins+    , Checkin(..)+    , CheckinFrom(..)+    , getCheckin     , createCheckin-      -- ** FQL-    , fqlQuery-    , FQLResult(..)-      -- ** Helpers++      -- * Facebook's Graph API basic functionality+      -- ** Simple types     , (#=)     , SimpleType(..)+      -- ** Complex types+    , Place(..)+    , Location(..)+    , GeoCoordinates(..)+    , Tag(..)+      -- ** Pagination+    , Pager(..)+    , fetchNextPage+    , fetchPreviousPage+    , fetchAllNextPages+    , fetchAllPreviousPages        -- * Real-time update notifications       -- ** Subscriptions@@ -74,13 +84,15 @@     , RealTimeUpdateNotification(..)     , RealTimeUpdateNotificationUserEntry(..) +      -- * FQL+    , fqlQuery+       -- * Raw access to the Graph API     , getObject     , postObject+    , searchObjects     , Id(..)     , Argument-    , searchObjects-    , SearchResultPage(..)        -- * Exceptions     , FacebookException(..)@@ -96,5 +108,7 @@ import Facebook.Graph import Facebook.Object.Page import Facebook.Object.User-import Facebook.OpenGraph+import Facebook.Object.Action+import Facebook.Object.Checkin import Facebook.RealTime+import Facebook.FQL

@@ -6,6 +6,7 @@     , asBS     , FacebookException(..)     , fbhttp+    , fbhttpHelper     , httpCheck     ) where @@ -16,6 +17,7 @@ import Data.Typeable (Typeable)  import qualified Control.Exception.Lifted as E+import Control.Monad.Trans.Class (MonadTrans) import Control.Monad.Trans.Control (MonadBaseControl) import qualified Data.Aeson as A import qualified Data.Attoparsec.Char8 as AT@@ -78,11 +80,16 @@  -- | Converts a plain 'H.Response' coming from 'H.http' into a -- JSON value.-asJson :: (C.MonadThrow m, A.FromJSON a) =>+asJson :: (MonadTrans t, C.MonadThrow m, A.FromJSON a) =>           H.Response (C.ResumableSource m ByteString)-       -> FacebookT anyAuth m a-asJson response = do-  val <- lift $ H.responseBody response C.$$+- C.sinkParser A.json'+       -> t m a+asJson = lift . asJsonHelper++asJsonHelper :: (C.MonadThrow m, A.FromJSON a) =>+                H.Response (C.ResumableSource m ByteString)+             -> m a+asJsonHelper response = do+  val <- H.responseBody response C.$$+- C.sinkParser A.json'   case A.fromJSON val of     A.Success r -> return r     A.Error str ->@@ -126,11 +133,18 @@        -> FacebookT anyAuth m (H.Response (C.ResumableSource m ByteString)) fbhttp req = do   manager <- getManager+  lift (fbhttpHelper manager req)++fbhttpHelper :: (MonadBaseControl IO m, C.MonadResource m) =>+                H.Manager+             -> H.Request m+             -> m (H.Response (C.ResumableSource m ByteString))+fbhttpHelper manager req = do   let req' = req { H.checkStatus = \_ _ -> Nothing } #if DEBUG   _ <- liftIO $ printf "fbhttp doing request\n\tmethod: %s\n\tsecure: %s\n\thost: %s\n\tport: %s\n\tpath: %s\n\tqueryString: %s\n\trequestHeaders: %s\n" (show $ H.method req') (show $ H.secure req') (show $ H.host req') (show $ H.port req') (show $ H.path req') (show $ H.queryString req') (show $ H.requestHeaders req') #endif-  response@(H.Response status _ headers _) <- lift (H.http req' manager)+  response@(H.Response status _ headers _) <- H.http req' manager #if DEBUG   _ <- liftIO $ printf "fbhttp response status: %s\n" (show status) #endif@@ -138,7 +152,7 @@     then return response     else do       let statusexc = H.StatusCodeException status headers-      val <- E.try $ asJson response+      val <- E.try $ asJsonHelper response       case val :: Either E.SomeException FacebookException of         Right fbexc -> E.throw fbexc         Left _ -> do

@@ -0,0 +1,26 @@+{-# LANGUAGE FlexibleContexts, OverloadedStrings #-}+module Facebook.FQL+    ( fqlQuery+    ) where++import Control.Monad.Trans.Control (MonadBaseControl)+import Data.Text (Text)++import qualified Data.Aeson as A+import qualified Data.Conduit as C++import Facebook.Types+import Facebook.Monad+import Facebook.Base+import Facebook.Graph+++-- | Query the Facebook Graph using FQL.+fqlQuery :: (C.MonadResource m, MonadBaseControl IO m, A.FromJSON a) =>+            Text                        -- ^ FQL Query+         -> Maybe (AccessToken anyKind) -- ^ Optional access token+         -> FacebookT anyAuth m (Pager a)+fqlQuery fql mtoken =+  runResourceInFb $ do+    let query = ["q" #= fql]+    asJson =<< fbhttp =<< fbreq "/fql" mtoken query

@@ -1,24 +1,43 @@ {-# LANGUAGE DeriveDataTypeable, FlexibleContexts, OverloadedStrings #-} module Facebook.Graph-    ( getObject+    ( Id(..)+    , getObject     , postObject-    , Id(..)     , searchObjects-    , SearchResultPage(..)+    , Pager(..)+    , fetchNextPage+    , fetchPreviousPage+    , fetchAllNextPages+    , fetchAllPreviousPages+    , (#=)+    , SimpleType(..)+    , Place(..)+    , Location(..)+    , GeoCoordinates(..)+    , Tag(..)     ) where   import Control.Applicative-import Control.Monad.Trans.Control (MonadBaseControl) import Control.Monad (mzero)+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Control (MonadBaseControl) import Data.ByteString.Char8 (ByteString)--- import Data.Text (Text)+import Data.Int (Int8, Int16, Int32)+import Data.List (intersperse)+import Data.Text (Text) import Data.Typeable (Typeable)+import Data.Word (Word8, Word16, Word32, Word)+import System.Locale (defaultTimeLocale) --- import qualified Control.Exception.Lifted as E 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 as T+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 @@ -28,6 +47,15 @@ import Facebook.Base  +-- | The identification code of an object.+newtype Id = Id { idCode :: ByteString }+    deriving (Eq, Ord, Show, Read, Typeable)++instance A.FromJSON Id where+    parseJSON (A.Object v) = Id <$> v A..: "id"+    parseJSON other        = Id <$> A.parseJSON other++ -- | Make a raw @GET@ request to Facebook's Graph API. getObject :: (C.MonadResource m, MonadBaseControl IO m, A.FromJSON a) =>              ByteString     -- ^ Path (should begin with a slash @\/@)@@ -51,15 +79,6 @@     asJson =<< fbhttp req { H.method = HT.methodPost }  --- | The identification code of an object.-newtype Id = Id { idCode :: ByteString }-    deriving (Eq, Ord, Show, Read, Typeable)--instance A.FromJSON Id where-    parseJSON (A.Object v) = Id <$> v A..: "id"-    parseJSON other        = Id <$> A.parseJSON other-- -- | Make a raw @GET@ request to the /search endpoint of Facebook’s -- Graph API.  Returns a raw JSON 'A.Value'. searchObjects :: (C.MonadResource m, MonadBaseControl IO m, A.FromJSON a)@@ -67,35 +86,276 @@               -> ByteString            -- ^ The keyword to search for               -> [Argument]            -- ^ Additional arguments to pass               -> Maybe UserAccessToken -- ^ Optional access token-              -> FacebookT anyAuth m (SearchResultPage a)+              -> FacebookT anyAuth m (Pager a) searchObjects objectType keyword query = getObject "/search" query'   where query' = ("q", keyword) : ("type", objectType) : query  --- | The result object for searchObjects. The type parameter is--- expected to be an instance of A.FromJSON, but nothing has been done--- to assure that Facebook will return the type expected.-data SearchResultPage a = SearchResultPage-                          { searchResults :: [a]-                          , searchPage :: Maybe Pager-                          } deriving (Eq, Ord, Show, Read, Typeable)+---------------------------------------------------------------------- -instance (A.FromJSON a) => A.FromJSON (SearchResultPage a) where-  parseJSON (A.Object v) = SearchResultPage-                           <$> v A..: "data"-                           <*> v A..:? "paging"++-- | Many Graph API results are returned as a JSON object with+-- the following structure:+--+-- @+-- {+--   \"data\": [+--     ...item 1...,+--          :+--     ...item n...+--   ],+--   \"paging\": {+--     \"previous\": \"http://...link to previous page...\",+--     \"next\":     \"http://...link to next page...\"+--   }+-- }+-- @+--+-- Only the @\"data\"@ field is required, the others may or may+-- not appear.+--+-- A @Pager a@ datatype encodes such result where each item has+-- type @a@.  You may use functions 'fetchNextPage' and+-- 'fetchPreviousPage' to navigate through the results.+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  --- | Simply wraps potential links for previous and next pages within a--- search result set.  TODO: Replace with a type that encapsulates the--- paging requests instead of just their URLs?-data Pager = Pager { previousPage :: Maybe ByteString-                   , nextPage :: Maybe ByteString-                   } deriving (Eq, Ord, Show, Read, Typeable)+-- | Tries to fetch the next page of a 'Pager'.  Returns+-- 'Nothing' whenever the current @Pager@ does not have a+-- 'pagerNext'.+fetchNextPage :: (C.MonadResource m, MonadBaseControl IO m, A.FromJSON a) =>+                 Pager a -> FacebookT anyAuth m (Maybe (Pager a))+fetchNextPage = fetchHelper pagerNext -instance A.FromJSON Pager where-  parseJSON (A.Object v) = Pager-                           <$> v A..:? "previous"-                           <*> v A..:? "next"++-- | Tries to fetch the previous page of a 'Pager'.  Returns+-- 'Nothing' whenever the current @Pager@ does not have a+-- 'pagerPrevious'.+fetchPreviousPage :: (C.MonadResource m, MonadBaseControl IO m, A.FromJSON a) =>+                     Pager a -> FacebookT anyAuth m (Maybe (Pager a))+fetchPreviousPage = fetchHelper pagerPrevious+++-- | (Internal) See 'fetchNextPage' and 'fetchPreviousPage'.+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 })+++-- | Tries to fetch all next pages and returns a 'C.Source' with+-- all results.  The 'C.Source' will include the results from+-- this page as well.  Previous pages will not be considered.+-- Next pages will be fetched on-demand.+fetchAllNextPages ::+  (Monad m, C.MonadResource n, MonadBaseControl IO n, A.FromJSON a) =>+  Pager a -> FacebookT anyAuth m (C.Source n a)+fetchAllNextPages = fetchAllHelper pagerNext+++-- | Tries to fetch all previous pages and returns a 'C.Source'+-- with all results.  The 'C.Source' will include the results+-- from this page as well.  Next pages will not be+-- considered.  Previous pages will be fetched on-demand.+fetchAllPreviousPages ::+  (Monad m, C.MonadResource n, MonadBaseControl IO n, A.FromJSON a) =>+  Pager a -> FacebookT anyAuth m (C.Source n a)+fetchAllPreviousPages = fetchAllHelper pagerPrevious+++-- | (Internal) See 'fetchAllNextPages' and 'fetchAllPreviousPages'.+fetchAllHelper ::+  (Monad m, C.MonadResource n, MonadBaseControl IO 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 =<< asJson =<< lift get+      start p = go (pagerData p) $! pagerRef pager+  return (start pager)+++----------------------------------------------------------------------+++-- | Create an 'Argument' with a 'SimpleType'.  See the docs on+-- 'createAction' for an example.+(#=) :: SimpleType a => ByteString -> a -> Argument+p #= v = (p, encodeFbParam v)+++-- | Class for data types that may be represented as a Facebook+-- simple type. (see+-- <https://developers.facebook.com/docs/opengraph/simpletypes/>).+class SimpleType a where+    encodeFbParam :: a -> B.ByteString++-- | Facebook's simple type @Boolean@.+instance SimpleType Bool where+    encodeFbParam b = if b then "1" else "0"++-- | Facebook's simple type @DateTime@ with only the date.+instance SimpleType TI.Day where+    encodeFbParam = B.pack . TI.formatTime defaultTimeLocale "%Y-%m-%d"+-- | Facebook's simple type @DateTime@.+instance SimpleType TI.UTCTime where+    encodeFbParam = B.pack . TI.formatTime defaultTimeLocale "%Y%m%dT%H%MZ"+-- | Facebook's simple type @DateTime@.+instance SimpleType TI.ZonedTime where+    encodeFbParam = encodeFbParam . TI.zonedTimeToUTC++-- @Enum@ doesn't make sense to support as a Haskell data type.++-- | Facebook's simple type @Float@ with less precision than supported.+instance SimpleType Float where+    encodeFbParam = showBS+-- | Facebook's simple type @Float@.+instance SimpleType Double where+    encodeFbParam = showBS++-- | Facebook's simple type @Integer@.+instance SimpleType Int where+    encodeFbParam = showBS+-- | Facebook's simple type @Integer@.+instance SimpleType Word where+    encodeFbParam = showBS+-- | Facebook's simple type @Integer@.+instance SimpleType Int8 where+    encodeFbParam = showBS+-- | Facebook's simple type @Integer@.+instance SimpleType Word8 where+    encodeFbParam = showBS+-- | Facebook's simple type @Integer@.+instance SimpleType Int16 where+    encodeFbParam = showBS+-- | Facebook's simple type @Integer@.+instance SimpleType Word16 where+    encodeFbParam = showBS+-- | Facebook's simple type @Integer@.+instance SimpleType Int32 where+    encodeFbParam = showBS+-- | Facebook's simple type @Integer@.+instance SimpleType Word32 where+    encodeFbParam = showBS++-- | Facebook's simple type @String@.+instance SimpleType Text where+    encodeFbParam = TE.encodeUtf8+-- | Facebook's simple type @String@.+instance SimpleType ByteString where+    encodeFbParam = id++-- | An object's 'Id' code.+instance SimpleType Id where+    encodeFbParam = idCode++-- | A comma-separated list of simple types.  This definition+-- doesn't work everywhere, just for a few combinations that+-- Facebook uses (e.g. @[Int]@).  Also, encoding a list of lists+-- is the same as encoding the concatenation of all lists.  In+-- other words, this instance is here more for your convenience+-- than to make sure your code is correct.+instance SimpleType a => SimpleType [a] where+    encodeFbParam = B.concat . intersperse "," . map encodeFbParam++showBS :: Show a => a -> B.ByteString+showBS = B.pack . show+++----------------------------------------------------------------------+++-- | Information about a place.  This is not a Graph Object,+-- instead it's just a field of a Object.  (Not to be confused+-- with the @Page@ object.)+data Place =+  Place { placeId       :: Id         -- ^ @Page@ ID.+        , placeName     :: Maybe Text -- ^ @Page@ name.+        , 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+++-- | A geographical location.+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+++-- | Geographical coordinates.+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+++-- | A tag (i.e. \"I'll /tag/ you on my post\").+data Tag =+  Tag { tagId   :: Id   -- ^ Who is tagged.+      , tagName :: Text -- ^ Name of the tagged person.+      }+  deriving (Eq, Ord, Show, Read, Typeable)++instance A.FromJSON Tag where+  parseJSON (A.Object v) =+    Tag <$> v A..: "id"+        <*> v A..: "name"   parseJSON _ = mzero

@@ -0,0 +1,84 @@+{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, OverloadedStrings #-}+module Facebook.Object.Action+   ( createAction+   , Action(..)+   ) where++import Control.Arrow (first)+import Control.Monad.Trans.Control (MonadBaseControl)+import Data.ByteString.Char8 (ByteString)+import Data.Function (on)+import Data.String (IsString(..))++import qualified Data.Conduit as C++import Facebook.Types+import Facebook.Monad+import Facebook.Graph+++-- | Creates an Open Graph action on the user's timeline. Returns+-- the 'Id' of the newly created action.  For example:+--+-- > now <- liftIO getCurrentTime+-- > createAction "cook"+-- >              [ "recipe" #= "http://example.com/cookie.html"+-- >              , "when"   #= now ]+-- >              token+createAction :: (C.MonadResource m, MonadBaseControl IO m)  =>+                Action     -- ^ Action kind to be created.+             -> [Argument] -- ^ Arguments of the action.+             -> Maybe AppAccessToken+                -- ^ Optional app access token (optional with+                -- respect to this library, since you can't make+                -- this mandatory by changing the settings of+                -- your action on Facebook).+             -> UserAccessToken -- ^ Required user access token.+             -> FacebookT Auth m Id+createAction (Action action) query mapptoken usertoken = do+  creds <- getCreds+  let post :: (C.MonadResource m, MonadBaseControl IO m)  => ByteString -> AccessToken anyKind -> FacebookT Auth m Id+      post prepath = postObject (prepath <> appName creds <> ":" <> action) query+  case mapptoken of+    Nothing       -> post "/me/" usertoken+    Just apptoken -> post ("/" <> accessTokenUserId usertoken <> "/") apptoken+++-- | An action of your app.  Please refer to Facebook's+-- documentation at+-- <https://developers.facebook.com/docs/opengraph/keyconcepts/#actions-objects>+-- to see how you can create actions.+--+-- This is a @newtype@ of 'ByteString' that supports only 'IsString'.+-- This means that to create an 'Action' you should use the+-- @OverloadedStrings@ language extension.  For example,+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- >+-- > foo token = do+-- >   ...+-- >   createAction "cook" [...] token+newtype Action = Action { unAction :: ByteString }++instance Show Action where+    show = show . unAction++-- | Since 0.7.1+instance Eq Action where+    (==) = (==) `on` unAction+    (/=) = (/=) `on` unAction++-- | Since 0.7.1+instance Ord Action where+    compare = compare `on` unAction+    (<=) = (<=) `on` unAction+    (<)  = (<)  `on` unAction+    (>=) = (>=) `on` unAction+    (>)  = (>)  `on` unAction++-- | Since 0.7.1+instance Read Action where+    readsPrec = (fmap (first Action) .) . readsPrec++instance IsString Action where+    fromString = Action . fromString

@@ -0,0 +1,88 @@+{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, OverloadedStrings #-}+module Facebook.Object.Checkin+   ( Checkin(..)+   , CheckinFrom(..)+   , getCheckin+   , createCheckin+   ) where++import Control.Applicative+import Control.Monad (mzero)+import Control.Monad.Trans.Control (MonadBaseControl)+import Data.Aeson ((.:), (.:?))+import Data.Text (Text)+import Data.Time (UTCTime)+import Data.Typeable (Typeable)++import qualified Data.Aeson as A+import qualified Data.Conduit as C+++import Facebook.Types+import Facebook.Monad+import Facebook.Graph+++-- | A Facebook check-in (see+-- <https://developers.facebook.com/docs/reference/api/checkin/>).+--+-- /NOTE:/ We still don't support all fields supported by+-- Facebook. Please fill an issue if you need access to any other+-- fields.+data Checkin =+    Checkin { checkinId          :: Id+            , checkinFrom        :: Maybe CheckinFrom+            , checkinPlace       :: Maybe Place+            , checkinCreatedTime :: Maybe UTCTime+            , checkinTags        :: Maybe (Pager Tag)+            , checkinMessage     :: Maybe Text+            }+    deriving (Eq, Ord, Show, Read, Typeable)++instance A.FromJSON Checkin where+    parseJSON (A.Object v) =+      Checkin <$> v .:  "id"+              <*> v .:? "from"+              <*> v .:? "place"+              <*> v .:? "created_time"+              <*> v .:? "tags"+              <*> v .:? "message"+    parseJSON _ = mzero+++-- | Information about the user who made the check-in.+data CheckinFrom =+    CheckinFrom { checkinFromId   :: UserId+                , checkinFromName :: Text+                }+    deriving (Eq, Ord, Show, Read, Typeable)++instance A.FromJSON CheckinFrom where+  parseJSON (A.Object v) =+    CheckinFrom <$> v .: "id"+                <*> v .: "name"+  parseJSON _ = mzero+++-- | Get a checkin from its ID.  The user access token is+-- optional, but when provided more information can be returned+-- back by Facebook.+getCheckin :: (C.MonadResource m, MonadBaseControl IO m) =>+              Id                    -- ^ Checkin ID.+           -> [Argument]            -- ^ Arguments to be passed to Facebook.+           -> Maybe UserAccessToken -- ^ Optional user access token.+           -> FacebookT anyAuth m Checkin+getCheckin (Id id_) query mtoken = getObject ("/" <> id_) query mtoken+++-- | Creates a 'check-in' and returns its ID. Place and+-- coordinates are both required by Facebook.+createCheckin :: (C.MonadResource m, MonadBaseControl IO m)  =>+                 Id               -- ^ Place ID.+              -> GeoCoordinates   -- ^ Coordinates.+              -> [Argument]       -- ^ Other arguments of the action.+              -> UserAccessToken  -- ^ Required user access token.+              -> FacebookT Auth m Id+createCheckin pid coords args usertoken = do+  let body = ("place" #= pid) : ("coordinates" #= coords) : args+  postObject "me/checkins" body usertoken

@@ -20,7 +20,6 @@  import Facebook.Graph import Facebook.Monad-import Facebook.Object.User (UserLocation) import Facebook.Types  -- | A Facebook page (see@@ -35,7 +34,7 @@                  , pageIsPublished       :: Maybe Bool                  , pageCanPost           :: Maybe Bool                  , pageLikes             :: Maybe Integer-                 , pageLocation          :: Maybe UserLocation+                 , pageLocation          :: Maybe Location                  , pagePhone             :: Maybe Text                  , pageCheckins          :: Maybe Integer                  , pagePicture           :: Maybe ByteString@@ -75,5 +74,5 @@             => ByteString            -- ^ Keyword to search for             -> [Argument]            -- ^ Arguments to pass to Facebook             -> Maybe UserAccessToken -- ^ Optional user access token-            -> FacebookT anyAuth m (SearchResultPage Page)+            -> FacebookT anyAuth m (Pager Page) searchPages = searchObjects "page"

@@ -2,7 +2,6 @@ module Facebook.Object.User     ( User(..)     , Gender(..)-    , UserLocation(..)     , getUser     , searchUsers     ) where@@ -43,7 +42,7 @@          , userUsername   :: Maybe Text          , userVerified   :: Maybe Bool          , userEmail      :: Maybe Text-         , userLocation   :: Maybe UserLocation+         , userLocation   :: Maybe Place          }     deriving (Eq, Ord, Show, Read, Typeable) @@ -79,20 +78,6 @@           toText Female = "female"  --- | An user's location.-data UserLocation =-    UserLocation { userLocationId   :: Id-                 , userLocationName :: Text-                 }-    deriving (Eq, Ord, Show, Read, Typeable)--instance A.FromJSON UserLocation where-    parseJSON (A.Object v) =-      UserLocation <$> v .: "id"-                   <*> v .: "name"-    parseJSON _ = mzero-- -- | Get an user using his user ID.  The user access token is -- optional, but when provided more information can be returned -- back by Facebook.  The user ID may be @\"me\"@, in which@@ -111,5 +96,5 @@             => ByteString             -> [Argument]             -> Maybe UserAccessToken-            -> FacebookT anyAuth m (SearchResultPage User)+            -> FacebookT anyAuth m (Pager User) searchUsers = searchObjects "user"

@@ -1,240 +0,0 @@-{-# LANGUAGE FlexibleContexts, OverloadedStrings #-}-module Facebook.OpenGraph-    ( createAction-    , Action(..)-    , createCheckin-    , fqlQuery-    , FQLResult(..)-    , (#=)-    , SimpleType(..)-    ) where--import Control.Applicative ((<$>))-import Control.Arrow (first)-import Control.Monad.Trans.Control (MonadBaseControl)-import Control.Monad (mzero)-import Data.ByteString.Char8 (ByteString)-import Data.Function (on)-import Data.List (intersperse)-import Data.Text (Text)-import qualified Data.Text.Lazy as TL (toStrict)-import Data.Text.Lazy.Builder (toLazyText)--- import Data.Typeable (Typeable, Typeable1)-import Data.Int (Int8, Int16, Int32)-import Data.Word (Word8, Word16, Word32, Word)-import Data.String (IsString(..))-import System.Locale (defaultTimeLocale)---- import qualified Control.Exception.Lifted as E-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 as T-import qualified Data.Text.Encoding as TE-import qualified Data.Time as TI--- import qualified Network.HTTP.Types as HT---import Facebook.Types-import Facebook.Monad-import Facebook.Base-import Facebook.Graph----- | Creates an Open Graph action on the user's timeline. Returns--- the 'Id' of the newly created action.  For example:------ > now <- liftIO getCurrentTime--- > createAction "cook"--- >              [ "recipe" #= "http://example.com/cookie.html"--- >              , "when"   #= now ]--- >              token-createAction :: (C.MonadResource m, MonadBaseControl IO m)  =>-                Action     -- ^ Action kind to be created.-             -> [Argument] -- ^ Arguments of the action.-             -> Maybe AppAccessToken-                -- ^ Optional app access token (optional with-                -- respect to this library, since you can't make-                -- this mandatory by changing the settings of-                -- your action on Facebook).-             -> UserAccessToken -- ^ Required user access token.-             -> FacebookT Auth m Id-createAction (Action action) query mapptoken usertoken = do-  creds <- getCreds-  let post :: (C.MonadResource m, MonadBaseControl IO m)  => ByteString -> AccessToken anyKind -> FacebookT Auth m Id-      post prepath = postObject (prepath <> appName creds <> ":" <> action) query-  case mapptoken of-    Nothing       -> post "/me/" usertoken-    Just apptoken -> post ("/" <> accessTokenUserId usertoken <> "/") apptoken----- | An action of your app.  Please refer to Facebook's--- documentation at--- <https://developers.facebook.com/docs/opengraph/keyconcepts/#actions-objects>--- to see how you can create actions.------ This is a @newtype@ of 'ByteString' that supports only 'IsString'.--- This means that to create an 'Action' you should use the--- @OverloadedStrings@ language extension.  For example,------ > {-# LANGUAGE OverloadedStrings #-}--- >--- > foo token = do--- >   ...--- >   createAction "cook" [...] token-newtype Action = Action { unAction :: ByteString }--instance Show Action where-    show = show . unAction---- | Since 0.7.1-instance Eq Action where-    (==) = (==) `on` unAction-    (/=) = (/=) `on` unAction---- | Since 0.7.1-instance Ord Action where-    compare = compare `on` unAction-    (<=) = (<=) `on` unAction-    (<)  = (<)  `on` unAction-    (>=) = (>=) `on` unAction-    (>)  = (>)  `on` unAction---- | Since 0.7.1-instance Read Action where-    readsPrec = (fmap (first Action) .) . readsPrec--instance IsString Action where-    fromString = Action . fromString----- | Creates a 'check-in' and returns its id. Place and--- coordinates are both required by Facebook.-createCheckin :: (C.MonadResource m, MonadBaseControl IO m)  =>-                 Id               -- ^ Place Id-              -> (Double, Double) -- ^ (Latitude, Longitude)-              -> [Argument]       -- ^ Other arguments of the action.-              -> UserAccessToken  -- ^ Required user access token.-              -> FacebookT Auth m Id-createCheckin pid (lat,lon) args usertoken = do-  let coords = ("coordinates", toBS $ A.object ["latitude" A..= lat, "longitude" A..= lon])-      body = ("place" #= pid) : coords : args-      toBS = TE.encodeUtf8 . TL.toStrict . toLazyText . AE.fromValue-  postObject "me/checkins" body usertoken----- | Query the Facebook Graph using FQL.  You may want to use--- 'FQLResult' when parsing the returned JSON.-fqlQuery :: (C.MonadResource m, MonadBaseControl IO m, A.FromJSON a) =>-             Text                        -- ^ FQL Query-          -> Maybe (AccessToken anyKind) -- ^ Optional access token-          -> FacebookT anyAuth m a-fqlQuery fql mtoken =-  runResourceInFb $ do-    let query = ["q" #= fql]-    asJson =<< fbhttp =<< fbreq "/fql" mtoken query----- | Parses an FQL query result.  FQL query results are always of the form------ @---   { "data": [ret1, ret2, ...] }--- @------ This @newtype@ unwraps the array from the @"data"@ field--- automatically for you, so you may write something like:------ @---   FQLResult [...] <- fqlQuery ...--- @-newtype FQLResult a = FQLResult [a] deriving (Eq, Ord, Show, Read)--instance A.FromJSON a => A.FromJSON (FQLResult a) where-  parseJSON (A.Object v) = FQLResult <$> (v A..: "data")-  parseJSON _ = mzero----- | Create an 'Argument' with a 'SimpleType'.  See the docs on--- 'createAction' for an example.-(#=) :: SimpleType a => ByteString -> a -> Argument-p #= v = (p, encodeFbParam v)------ | Class for data types that may be represented as a Facebook--- simple type. (see--- <https://developers.facebook.com/docs/opengraph/simpletypes/>).-class SimpleType a where-    encodeFbParam :: a -> B.ByteString---- | Facebook's simple type @Boolean@.-instance SimpleType Bool where-    encodeFbParam b = if b then "1" else "0"---- | Facebook's simple type @DateTime@ with only the date.-instance SimpleType TI.Day where-    encodeFbParam = B.pack . TI.formatTime defaultTimeLocale "%Y-%m-%d"--- | Facebook's simple type @DateTime@.-instance SimpleType TI.UTCTime where-    encodeFbParam = B.pack . TI.formatTime defaultTimeLocale "%Y%m%dT%H%MZ"--- | Facebook's simple type @DateTime@.-instance SimpleType TI.ZonedTime where-    encodeFbParam = encodeFbParam . TI.zonedTimeToUTC---- @Enum@ doesn't make sense to support as a Haskell data type.---- | Facebook's simple type @Float@ with less precision than supported.-instance SimpleType Float where-    encodeFbParam = showBS--- | Facebook's simple type @Float@.-instance SimpleType Double where-    encodeFbParam = showBS---- | Facebook's simple type @Integer@.-instance SimpleType Int where-    encodeFbParam = showBS--- | Facebook's simple type @Integer@.-instance SimpleType Word where-    encodeFbParam = showBS--- | Facebook's simple type @Integer@.-instance SimpleType Int8 where-    encodeFbParam = showBS--- | Facebook's simple type @Integer@.-instance SimpleType Word8 where-    encodeFbParam = showBS--- | Facebook's simple type @Integer@.-instance SimpleType Int16 where-    encodeFbParam = showBS--- | Facebook's simple type @Integer@.-instance SimpleType Word16 where-    encodeFbParam = showBS--- | Facebook's simple type @Integer@.-instance SimpleType Int32 where-    encodeFbParam = showBS--- | Facebook's simple type @Integer@.-instance SimpleType Word32 where-    encodeFbParam = showBS---- | Facebook's simple type @String@.-instance SimpleType Text where-    encodeFbParam = TE.encodeUtf8--- | Facebook's simple type @String@.-instance SimpleType ByteString where-    encodeFbParam = id---- | An object's 'Id' code.-instance SimpleType Id where-    encodeFbParam = idCode---- | A comma-separated list of simple types.  This definition--- doesn't work everywhere, just for a few combinations that--- Facebook uses (e.g. @[Int]@).  Also, encoding a list of lists--- is the same as encoding the concatenation of all lists.  In--- other words, this instance is here more for your convenience--- than to make sure your code is correct.-instance SimpleType a => SimpleType [a] where-    encodeFbParam = B.concat . intersperse "," . map encodeFbParam--showBS :: Show a => a -> B.ByteString-showBS = B.pack . show

@@ -28,6 +28,7 @@ import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.Conduit as C+import qualified Data.Conduit.List as CL import qualified Data.Text.Encoding as TE import qualified Network.HTTP.Conduit as H import qualified Network.HTTP.Types as HT@@ -36,7 +37,6 @@ import Facebook.Monad import Facebook.Base import Facebook.Graph-import Facebook.OpenGraph   -- | The type of objects that a real-time update refers to.@@ -150,8 +150,9 @@   AppAccessToken -> FacebookT Auth m [RealTimeUpdateSubscription] listSubscriptions apptoken = do   path <- getSubscriptionsPath-  FQLResult ret <- getObject path [] (Just apptoken)-  return ret+  pager <- getObject path [] (Just apptoken)+  src <- fetchAllNextPages pager+  lift $ src C.$$ CL.consume   -- | Verifies the input's authenticity (i.e. it comes from

@@ -24,7 +24,7 @@ -- | Credentials that you get for your app when you register on -- Facebook. data Credentials =-    Credentials { appName   :: ByteString -- ^ Your application name (e.g. for OpenGraph calls).+    Credentials { appName   :: ByteString -- ^ Your application name (e.g. for Open Graph calls).                 , appId     :: ByteString -- ^ Your application ID.                 , appSecret :: ByteString -- ^ Your application secret key.                 }

@@ -165,7 +165,7 @@     it "is able to query Facebook's page name from its page id" $       runNoAuth $ do         r <- FB.fqlQuery "SELECT name FROM page WHERE page_id = 20531316728" Nothing-        r &?= FB.FQLResult [PageName "Facebook"]+        FB.pagerData r &?= [PageName "Facebook"]    describe' "listSubscriptions" $ do     it "returns something" $ do