module Facebook.Pager
( Pager(..)
, fetchNextPage
, fetchPreviousPage
, fetchAllNextPages
, fetchAllPreviousPages
) where
import Control.Monad (mzero)
import Control.Monad.IO.Class (liftIO)
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, A.FromJSON a, R.MonadThrow m, R.MonadUnliftIO m)
=> Pager a -> FacebookT anyAuth m (Maybe (Pager a))
fetchNextPage = fetchHelper pagerNext
fetchPreviousPage
:: (R.MonadResource m, A.FromJSON a, R.MonadThrow m, R.MonadUnliftIO m)
=> Pager a -> FacebookT anyAuth m (Maybe (Pager a))
fetchPreviousPage = fetchHelper pagerPrevious
fetchHelper
:: (R.MonadResource m, A.FromJSON a, R.MonadThrow m, R.MonadUnliftIO m)
=> (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.parseRequest url)
Just <$>
(asJson =<<
fbhttp
req
{ H.redirectCount = 3
})
fetchAllNextPages
:: (Monad m, A.FromJSON a, R.MonadUnliftIO n, R.MonadThrow n)
=> Pager a -> FacebookT anyAuth m (C.ConduitT () a n ())
fetchAllNextPages = fetchAllHelper pagerNext
fetchAllPreviousPages
:: (Monad m, A.FromJSON a, R.MonadUnliftIO n, R.MonadThrow n)
=> Pager a -> FacebookT anyAuth m (C.ConduitT () a n ())
fetchAllPreviousPages = fetchAllHelper pagerPrevious
fetchAllHelper
:: (Monad m, A.FromJSON a, R.MonadUnliftIO n, R.MonadThrow n)
=> (Pager a -> Maybe String)
-> Pager a
-> FacebookT anyAuth m (C.ConduitT () a n ())
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.parseRequest next)
let get =
fbhttpHelper
manager
req
{ H.redirectCount = 3
}
start =<< lift (R.runResourceT $ asJsonHelper =<< get)
start p = go (pagerData p) $! pagerRef p
return (start pager)