    {-# 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

    -- | 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
      { forall a. Pager a -> [a]
    pagerData :: [a]
      , forall a. Pager a -> Maybe String
    pagerPrevious :: Maybe String
      , forall a. Pager a -> Maybe String
    pagerNext :: 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
    $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
    /= :: 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
    $ccompare :: forall a. Ord a => Pager a -> Pager a -> Ordering
    compare :: Pager a -> Pager a -> Ordering
    $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
    >= :: Pager a -> Pager a -> Bool
    $cmax :: forall a. Ord a => Pager a -> Pager a -> Pager a
    max :: Pager a -> Pager a -> Pager a
    $cmin :: forall a. Ord a => Pager a -> Pager a -> Pager a
    min :: Pager a -> Pager a -> 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
    $cshowsPrec :: forall a. Show a => Int -> Pager a -> ShowS
    showsPrec :: Int -> Pager a -> ShowS
    $cshow :: forall a. Show a => Pager a -> String
    show :: Pager a -> String
    $cshowList :: forall a. Show a => [Pager a] -> ShowS
    showList :: [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
    $creadsPrec :: forall a. Read a => Int -> ReadS (Pager a)
    readsPrec :: Int -> ReadS (Pager a)
    $creadList :: forall a. Read a => ReadS [Pager a]
    readList :: ReadS [Pager a]
    $creadPrec :: forall a. Read a => ReadPrec (Pager a)
    readPrec :: ReadPrec (Pager a)
    $creadListPrec :: forall a. Read a => ReadPrec [Pager a]
    readListPrec :: ReadPrec [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 a b. Parser a -> (a -> Parser b) -> Parser b
    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 a. a -> Parser 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 a b. Parser (a -> b) -> Parser a -> Parser b
    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 a b. Parser (a -> b) -> Parser a -> Parser b
    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 a. Parser a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero

    -- | Tries to fetch the next page of a 'Pager'.  Returns
    -- 'Nothing' whenever the current @Pager@ does not have a
    -- 'pagerNext'.
    fetchNextPage
      :: (R.MonadResource m, A.FromJSON a, R.MonadThrow m, R.MonadUnliftIO m)
      => Pager a -> FacebookT anyAuth m (Maybe (Pager a))
    fetchNextPage :: forall (m :: * -> *) a anyAuth.
    (MonadResource m, FromJSON a, MonadThrow m, MonadUnliftIO m) =>
    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

    -- | Tries to fetch the previous page of a 'Pager'.  Returns
    -- 'Nothing' whenever the current @Pager@ does not have a
    -- 'pagerPrevious'.
    fetchPreviousPage
      :: (R.MonadResource m, A.FromJSON a, R.MonadThrow m, R.MonadUnliftIO m)
      => Pager a -> FacebookT anyAuth m (Maybe (Pager a))
    fetchPreviousPage :: forall (m :: * -> *) a anyAuth.
    (MonadResource m, FromJSON a, MonadThrow m, MonadUnliftIO m) =>
    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

    -- | (Internal) See 'fetchNextPage' and 'fetchPreviousPage'.
    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 :: 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
    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 a. a -> FacebookT anyAuth m 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 a. IO a -> FacebookT anyAuth m a
    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
               { 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, A.FromJSON a, R.MonadUnliftIO n, R.MonadThrow n)
      => Pager a -> FacebookT anyAuth m (C.ConduitT () a n ())
    fetchAllNextPages :: forall (m :: * -> *) a (n :: * -> *) anyAuth.
    (Monad m, FromJSON a, MonadUnliftIO n, MonadThrow n) =>
    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

    -- | 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, A.FromJSON a, R.MonadUnliftIO n, R.MonadThrow n)
      => Pager a -> FacebookT anyAuth m (C.ConduitT () a n ())
    fetchAllPreviousPages :: forall (m :: * -> *) a (n :: * -> *) anyAuth.
    (Monad m, FromJSON a, MonadUnliftIO n, MonadThrow n) =>
    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

    -- | (Internal) See 'fetchAllNextPages' and 'fetchAllPreviousPages'.
    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 :: 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
    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 a b.
    ConduitT i a m a -> ConduitT i a m b -> ConduitT i a m b
    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 a. a -> ConduitT i a m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          go [] (Just String
    next) = do
            Request
    req <- IO Request -> ConduitT i a m Request
    forall a. IO a -> ConduitT i a m a
    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
                    { H.redirectCount = 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 (m :: * -> *) a. Monad m => m a -> ConduitT i a m 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 a. a -> FacebookT anyAuth m a
    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)