module Facebook.Pager
( Pager(..)
, fetchNextPage
, fetchPreviousPage
, fetchAllNextPages
, fetchAllPreviousPages
) where
#if __GLASGOW_HASKELL__ <= 784
import Control.Applicative
#endif
import Control.Monad (mzero)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Control (MonadBaseControl)
import Control.Monad.Trans.Resource (MonadResourceBase)
import Data.Typeable (Typeable)
import qualified Control.Monad.Trans.Resource as R
import qualified Data.Aeson as A
import qualified Data.Conduit as C
import qualified Network.HTTP.Conduit as H
import Facebook.Base
import Facebook.Monad
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
:: (R.MonadResource m, MonadBaseControl IO m, A.FromJSON a)
=> Pager a -> FacebookT anyAuth m (Maybe (Pager a))
fetchNextPage = fetchHelper pagerNext
fetchPreviousPage
:: (R.MonadResource m, MonadBaseControl IO m, A.FromJSON a)
=> Pager a -> FacebookT anyAuth m (Maybe (Pager a))
fetchPreviousPage = fetchHelper pagerPrevious
fetchHelper
:: (R.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
#if MIN_VERSION_http_client(0,4,30)
req <- liftIO (H.parseRequest url)
#else
req <- liftIO (H.parseUrl url)
#endif
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
#if MIN_VERSION_http_client(0,4,30)
req <- liftIO (H.parseRequest next)
#else
req <- liftIO (H.parseUrl next)
#endif
let get =
fbhttpHelper
manager
req
{ H.redirectCount = 3
}
start =<< lift (R.runResourceT $ asJsonHelper =<< get)
start p = go (pagerData p) $! pagerRef p
return (start pager)