module Facebook.Pager
( Pager(..)
, fetchNextPage
, fetchPreviousPage
, fetchAllNextPages
, fetchAllPreviousPages
) 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.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
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 (R.runResourceT $ asJsonHelper =<< get)
start p = go (pagerData p) $! pagerRef p
return (start pager)