{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveDataTypeable #-}
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 a =
{ :: [a]
, :: Maybe String
, :: Maybe String
} deriving (Pager a -> Pager a -> Bool
(Pager a -> Pager a -> Bool)
-> (Pager a -> Pager a -> Bool) -> Eq (Pager a)
forall a. Eq a => Pager a -> Pager a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pager a -> Pager a -> Bool
$c/= :: forall a. Eq a => Pager a -> Pager a -> Bool
== :: Pager a -> Pager a -> Bool
$c== :: forall a. Eq a => Pager a -> Pager a -> Bool
Eq, Eq (Pager a)
Eq (Pager a)
-> (Pager a -> Pager a -> Ordering)
-> (Pager a -> Pager a -> Bool)
-> (Pager a -> Pager a -> Bool)
-> (Pager a -> Pager a -> Bool)
-> (Pager a -> Pager a -> Bool)
-> (Pager a -> Pager a -> Pager a)
-> (Pager a -> Pager a -> Pager a)
-> Ord (Pager a)
Pager a -> Pager a -> Bool
Pager a -> Pager a -> Ordering
Pager a -> Pager a -> Pager a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Pager a)
forall a. Ord a => Pager a -> Pager a -> Bool
forall a. Ord a => Pager a -> Pager a -> Ordering
forall a. Ord a => Pager a -> Pager a -> Pager a
min :: Pager a -> Pager a -> Pager a
$cmin :: forall a. Ord a => Pager a -> Pager a -> Pager a
max :: Pager a -> Pager a -> Pager a
$cmax :: forall a. Ord a => Pager a -> Pager a -> Pager a
>= :: Pager a -> Pager a -> Bool
$c>= :: forall a. Ord a => Pager a -> Pager a -> Bool
> :: Pager a -> Pager a -> Bool
$c> :: forall a. Ord a => Pager a -> Pager a -> Bool
<= :: Pager a -> Pager a -> Bool
$c<= :: forall a. Ord a => Pager a -> Pager a -> Bool
< :: Pager a -> Pager a -> Bool
$c< :: forall a. Ord a => Pager a -> Pager a -> Bool
compare :: Pager a -> Pager a -> Ordering
$ccompare :: forall a. Ord a => Pager a -> Pager a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Pager a)
Ord, Int -> Pager a -> ShowS
[Pager a] -> ShowS
Pager a -> String
(Int -> Pager a -> ShowS)
-> (Pager a -> String) -> ([Pager a] -> ShowS) -> Show (Pager a)
forall a. Show a => Int -> Pager a -> ShowS
forall a. Show a => [Pager a] -> ShowS
forall a. Show a => Pager a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pager a] -> ShowS
$cshowList :: forall a. Show a => [Pager a] -> ShowS
show :: Pager a -> String
$cshow :: forall a. Show a => Pager a -> String
showsPrec :: Int -> Pager a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Pager a -> ShowS
Show, ReadPrec [Pager a]
ReadPrec (Pager a)
Int -> ReadS (Pager a)
ReadS [Pager a]
(Int -> ReadS (Pager a))
-> ReadS [Pager a]
-> ReadPrec (Pager a)
-> ReadPrec [Pager a]
-> Read (Pager a)
forall a. Read a => ReadPrec [Pager a]
forall a. Read a => ReadPrec (Pager a)
forall a. Read a => Int -> ReadS (Pager a)
forall a. Read a => ReadS [Pager a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Pager a]
$creadListPrec :: forall a. Read a => ReadPrec [Pager a]
readPrec :: ReadPrec (Pager a)
$creadPrec :: forall a. Read a => ReadPrec (Pager a)
readList :: ReadS [Pager a]
$creadList :: forall a. Read a => ReadS [Pager a]
readsPrec :: Int -> ReadS (Pager a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Pager a)
Read, Typeable)
instance A.FromJSON a =>
A.FromJSON (Pager a) where
parseJSON :: Value -> Parser (Pager a)
parseJSON (A.Object Object
v) =
let paging :: Key -> Parser (Maybe a)
paging Key
f = Object
v Object -> Key -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"paging" Parser (Maybe Object)
-> (Maybe Object -> Parser (Maybe a)) -> Parser (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser (Maybe a)
-> (Object -> Parser (Maybe a)) -> Maybe Object -> Parser (Maybe a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe a -> Parser (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing) (Object -> Key -> Parser (Maybe a)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
f)
in [a] -> Maybe String -> Maybe String -> Pager a
forall a. [a] -> Maybe String -> Maybe String -> Pager a
Pager ([a] -> Maybe String -> Maybe String -> Pager a)
-> Parser [a] -> Parser (Maybe String -> Maybe String -> Pager a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser [a]
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"data" Parser (Maybe String -> Maybe String -> Pager a)
-> Parser (Maybe String) -> Parser (Maybe String -> Pager a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> Parser (Maybe String)
forall a. FromJSON a => Key -> Parser (Maybe a)
paging Key
"previous" Parser (Maybe String -> Pager a)
-> Parser (Maybe String) -> Parser (Pager a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key -> Parser (Maybe String)
forall a. FromJSON a => Key -> Parser (Maybe a)
paging Key
"next"
parseJSON Value
_ = Parser (Pager a)
forall (m :: * -> *) a. MonadPlus m => m a
mzero
fetchNextPage
:: (R.MonadResource m, A.FromJSON a, R.MonadThrow m, R.MonadUnliftIO m)
=> Pager a -> FacebookT anyAuth m (Maybe (Pager a))
fetchNextPage :: Pager a -> FacebookT anyAuth m (Maybe (Pager a))
fetchNextPage = (Pager a -> Maybe String)
-> Pager a -> FacebookT anyAuth m (Maybe (Pager a))
forall (m :: * -> *) a anyAuth.
(MonadResource m, FromJSON a, MonadThrow m, MonadUnliftIO m) =>
(Pager a -> Maybe String)
-> Pager a -> FacebookT anyAuth m (Maybe (Pager a))
fetchHelper Pager a -> Maybe String
forall a. Pager a -> Maybe String
pagerNext
fetchPreviousPage
:: (R.MonadResource m, A.FromJSON a, R.MonadThrow m, R.MonadUnliftIO m)
=> Pager a -> FacebookT anyAuth m (Maybe (Pager a))
fetchPreviousPage :: Pager a -> FacebookT anyAuth m (Maybe (Pager a))
fetchPreviousPage = (Pager a -> Maybe String)
-> Pager a -> FacebookT anyAuth m (Maybe (Pager a))
forall (m :: * -> *) a anyAuth.
(MonadResource m, FromJSON a, MonadThrow m, MonadUnliftIO m) =>
(Pager a -> Maybe String)
-> Pager a -> FacebookT anyAuth m (Maybe (Pager a))
fetchHelper Pager a -> Maybe String
forall a. Pager a -> Maybe String
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 :: (Pager a -> Maybe String)
-> Pager a -> FacebookT anyAuth m (Maybe (Pager a))
fetchHelper Pager a -> Maybe String
pagerRef Pager a
pager =
case Pager a -> Maybe String
pagerRef Pager a
pager of
Maybe String
Nothing -> Maybe (Pager a) -> FacebookT anyAuth m (Maybe (Pager a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Pager a)
forall a. Maybe a
Nothing
Just String
url -> do
Request
req <- IO Request -> FacebookT anyAuth m Request
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
H.parseRequest String
url)
Pager a -> Maybe (Pager a)
forall a. a -> Maybe a
Just (Pager a -> Maybe (Pager a))
-> FacebookT anyAuth m (Pager a)
-> FacebookT anyAuth m (Maybe (Pager a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Response (ConduitT () ByteString m ())
-> FacebookT anyAuth m (Pager a)
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(MonadIO m, MonadTrans t, MonadThrow m, FromJSON a) =>
Response (ConduitT () ByteString m ()) -> t m a
asJson (Response (ConduitT () ByteString m ())
-> FacebookT anyAuth m (Pager a))
-> FacebookT anyAuth m (Response (ConduitT () ByteString m ()))
-> FacebookT anyAuth m (Pager a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
Request
-> FacebookT anyAuth m (Response (ConduitT () ByteString m ()))
forall (m :: * -> *) anyAuth.
(MonadResource m, MonadUnliftIO m, MonadThrow m) =>
Request
-> FacebookT anyAuth m (Response (ConduitT () ByteString m ()))
fbhttp
Request
req
{ redirectCount :: Int
H.redirectCount = Int
3
})
fetchAllNextPages
:: (Monad m, A.FromJSON a, R.MonadUnliftIO n, R.MonadThrow n)
=> Pager a -> FacebookT anyAuth m (C.ConduitT () a n ())
fetchAllNextPages :: Pager a -> FacebookT anyAuth m (ConduitT () a n ())
fetchAllNextPages = (Pager a -> Maybe String)
-> Pager a -> FacebookT anyAuth m (ConduitT () a n ())
forall (m :: * -> *) a (n :: * -> *) anyAuth.
(Monad m, FromJSON a, MonadUnliftIO n, MonadThrow n) =>
(Pager a -> Maybe String)
-> Pager a -> FacebookT anyAuth m (ConduitT () a n ())
fetchAllHelper Pager a -> Maybe String
forall a. Pager a -> Maybe String
pagerNext
fetchAllPreviousPages
:: (Monad m, A.FromJSON a, R.MonadUnliftIO n, R.MonadThrow n)
=> Pager a -> FacebookT anyAuth m (C.ConduitT () a n ())
fetchAllPreviousPages :: Pager a -> FacebookT anyAuth m (ConduitT () a n ())
fetchAllPreviousPages = (Pager a -> Maybe String)
-> Pager a -> FacebookT anyAuth m (ConduitT () a n ())
forall (m :: * -> *) a (n :: * -> *) anyAuth.
(Monad m, FromJSON a, MonadUnliftIO n, MonadThrow n) =>
(Pager a -> Maybe String)
-> Pager a -> FacebookT anyAuth m (ConduitT () a n ())
fetchAllHelper Pager a -> Maybe String
forall a. Pager a -> Maybe String
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 :: (Pager a -> Maybe String)
-> Pager a -> FacebookT anyAuth m (ConduitT () a n ())
fetchAllHelper Pager a -> Maybe String
pagerRef Pager a
pager = do
Manager
manager <- FacebookT anyAuth m Manager
forall (m :: * -> *) anyAuth.
Monad m =>
FacebookT anyAuth m Manager
getManager
let go :: [a] -> Maybe String -> ConduitT i a m ()
go (a
x:[a]
xs) Maybe String
mnext = a -> ConduitT i a m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
C.yield a
x ConduitT i a m () -> ConduitT i a m () -> ConduitT i a m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [a] -> Maybe String -> ConduitT i a m ()
go [a]
xs Maybe String
mnext
go [] Maybe String
Nothing = () -> ConduitT i a m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
go [] (Just String
next) = do
Request
req <- IO Request -> ConduitT i a m Request
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
H.parseRequest String
next)
let get :: ResourceT m (Response (ConduitT () ByteString (ResourceT m) ()))
get =
Manager
-> Request
-> ResourceT m (Response (ConduitT () ByteString (ResourceT m) ()))
forall (m :: * -> *).
(MonadResource m, MonadUnliftIO m, MonadThrow m) =>
Manager -> Request -> m (Response (ConduitT () ByteString m ()))
fbhttpHelper
Manager
manager
Request
req
{ redirectCount :: Int
H.redirectCount = Int
3
}
Pager a -> ConduitT i a m ()
start (Pager a -> ConduitT i a m ())
-> ConduitT i a m (Pager a) -> ConduitT i a m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (Pager a) -> ConduitT i a m (Pager a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT m (Pager a) -> m (Pager a)
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
R.runResourceT (ResourceT m (Pager a) -> m (Pager a))
-> ResourceT m (Pager a) -> m (Pager a)
forall a b. (a -> b) -> a -> b
$ Response (ConduitT () ByteString (ResourceT m) ())
-> ResourceT m (Pager a)
forall (m :: * -> *) a.
(MonadIO m, MonadThrow m, FromJSON a) =>
Response (ConduitT () ByteString m ()) -> m a
asJsonHelper (Response (ConduitT () ByteString (ResourceT m) ())
-> ResourceT m (Pager a))
-> ResourceT m (Response (ConduitT () ByteString (ResourceT m) ()))
-> ResourceT m (Pager a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ResourceT m (Response (ConduitT () ByteString (ResourceT m) ()))
get)
start :: Pager a -> ConduitT i a m ()
start Pager a
p = [a] -> Maybe String -> ConduitT i a m ()
go (Pager a -> [a]
forall a. Pager a -> [a]
pagerData Pager a
p) (Maybe String -> ConduitT i a m ())
-> Maybe String -> ConduitT i a m ()
forall a b. (a -> b) -> a -> b
$! Pager a -> Maybe String
pagerRef Pager a
p
ConduitT () a n () -> FacebookT anyAuth m (ConduitT () a n ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Pager a -> ConduitT () a n ()
forall (m :: * -> *) i.
(MonadThrow m, MonadUnliftIO m) =>
Pager a -> ConduitT i a m ()
start Pager a
pager)