{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Web.Twitter.Conduit.Cursor (
    IdsCursorKey,
    UsersCursorKey,
    ListsCursorKey,
    EventsCursorKey,
    WithCursor (..),
) where

import Control.DeepSeq (NFData)
import Data.Aeson
import Data.Proxy (Proxy (..))
import Data.String
import GHC.Generics
import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)

-- $setup
-- >>> import Data.Text
-- >>> type UserId = Integer

type IdsCursorKey = "ids"
type UsersCursorKey = "users"
type ListsCursorKey = "lists"
type EventsCursorKey = "events"

-- | A wrapper for API responses which have "next_cursor" field.
--
-- The first type parameter of 'WithCursor' specifies the field name of contents.
--
-- >>> let Just res = decode "{\"previous_cursor\": 0, \"next_cursor\": 1234567890, \"ids\": [1111111111]}" :: Maybe (WithCursor Integer "ids" UserId)
-- >>> nextCursor res
-- Just 1234567890
-- >>> contents res
-- [1111111111]
--
-- >>> let Just res = decode "{\"previous_cursor\": 0, \"next_cursor\": 0, \"users\": [1000]}" :: Maybe (WithCursor Integer "users" UserId)
-- >>> nextCursor res
-- Just 0
-- >>> contents res
-- [1000]
--
-- >>> let Just res = decode "{\"next_cursor\": \"hogehoge\", \"events\": [1000]}" :: Maybe (WithCursor Text "events" UserId)
-- >>> nextCursor res
-- Just "hogehoge"
-- >>> contents res
-- [1000]
data WithCursor cursorType (cursorKey :: Symbol) wrapped = WithCursor
    { WithCursor cursorType cursorKey wrapped -> Maybe cursorType
previousCursor :: Maybe cursorType
    , WithCursor cursorType cursorKey wrapped -> Maybe cursorType
nextCursor :: Maybe cursorType
    , WithCursor cursorType cursorKey wrapped -> [wrapped]
contents :: [wrapped]
    }
    deriving (Int -> WithCursor cursorType cursorKey wrapped -> ShowS
[WithCursor cursorType cursorKey wrapped] -> ShowS
WithCursor cursorType cursorKey wrapped -> String
(Int -> WithCursor cursorType cursorKey wrapped -> ShowS)
-> (WithCursor cursorType cursorKey wrapped -> String)
-> ([WithCursor cursorType cursorKey wrapped] -> ShowS)
-> Show (WithCursor cursorType cursorKey wrapped)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall cursorType (cursorKey :: Symbol) wrapped.
(Show cursorType, Show wrapped) =>
Int -> WithCursor cursorType cursorKey wrapped -> ShowS
forall cursorType (cursorKey :: Symbol) wrapped.
(Show cursorType, Show wrapped) =>
[WithCursor cursorType cursorKey wrapped] -> ShowS
forall cursorType (cursorKey :: Symbol) wrapped.
(Show cursorType, Show wrapped) =>
WithCursor cursorType cursorKey wrapped -> String
showList :: [WithCursor cursorType cursorKey wrapped] -> ShowS
$cshowList :: forall cursorType (cursorKey :: Symbol) wrapped.
(Show cursorType, Show wrapped) =>
[WithCursor cursorType cursorKey wrapped] -> ShowS
show :: WithCursor cursorType cursorKey wrapped -> String
$cshow :: forall cursorType (cursorKey :: Symbol) wrapped.
(Show cursorType, Show wrapped) =>
WithCursor cursorType cursorKey wrapped -> String
showsPrec :: Int -> WithCursor cursorType cursorKey wrapped -> ShowS
$cshowsPrec :: forall cursorType (cursorKey :: Symbol) wrapped.
(Show cursorType, Show wrapped) =>
Int -> WithCursor cursorType cursorKey wrapped -> ShowS
Show, WithCursor cursorType cursorKey wrapped
-> WithCursor cursorType cursorKey wrapped -> Bool
(WithCursor cursorType cursorKey wrapped
 -> WithCursor cursorType cursorKey wrapped -> Bool)
-> (WithCursor cursorType cursorKey wrapped
    -> WithCursor cursorType cursorKey wrapped -> Bool)
-> Eq (WithCursor cursorType cursorKey wrapped)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall cursorType (cursorKey :: Symbol) wrapped.
(Eq cursorType, Eq wrapped) =>
WithCursor cursorType cursorKey wrapped
-> WithCursor cursorType cursorKey wrapped -> Bool
/= :: WithCursor cursorType cursorKey wrapped
-> WithCursor cursorType cursorKey wrapped -> Bool
$c/= :: forall cursorType (cursorKey :: Symbol) wrapped.
(Eq cursorType, Eq wrapped) =>
WithCursor cursorType cursorKey wrapped
-> WithCursor cursorType cursorKey wrapped -> Bool
== :: WithCursor cursorType cursorKey wrapped
-> WithCursor cursorType cursorKey wrapped -> Bool
$c== :: forall cursorType (cursorKey :: Symbol) wrapped.
(Eq cursorType, Eq wrapped) =>
WithCursor cursorType cursorKey wrapped
-> WithCursor cursorType cursorKey wrapped -> Bool
Eq, (forall x.
 WithCursor cursorType cursorKey wrapped
 -> Rep (WithCursor cursorType cursorKey wrapped) x)
-> (forall x.
    Rep (WithCursor cursorType cursorKey wrapped) x
    -> WithCursor cursorType cursorKey wrapped)
-> Generic (WithCursor cursorType cursorKey wrapped)
forall x.
Rep (WithCursor cursorType cursorKey wrapped) x
-> WithCursor cursorType cursorKey wrapped
forall x.
WithCursor cursorType cursorKey wrapped
-> Rep (WithCursor cursorType cursorKey wrapped) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall cursorType (cursorKey :: Symbol) wrapped x.
Rep (WithCursor cursorType cursorKey wrapped) x
-> WithCursor cursorType cursorKey wrapped
forall cursorType (cursorKey :: Symbol) wrapped x.
WithCursor cursorType cursorKey wrapped
-> Rep (WithCursor cursorType cursorKey wrapped) x
$cto :: forall cursorType (cursorKey :: Symbol) wrapped x.
Rep (WithCursor cursorType cursorKey wrapped) x
-> WithCursor cursorType cursorKey wrapped
$cfrom :: forall cursorType (cursorKey :: Symbol) wrapped x.
WithCursor cursorType cursorKey wrapped
-> Rep (WithCursor cursorType cursorKey wrapped) x
Generic, (forall a.
 WithCursor cursorType cursorKey a
 -> Rep1 (WithCursor cursorType cursorKey) a)
-> (forall a.
    Rep1 (WithCursor cursorType cursorKey) a
    -> WithCursor cursorType cursorKey a)
-> Generic1 (WithCursor cursorType cursorKey)
forall a.
Rep1 (WithCursor cursorType cursorKey) a
-> WithCursor cursorType cursorKey a
forall a.
WithCursor cursorType cursorKey a
-> Rep1 (WithCursor cursorType cursorKey) a
forall cursorType (cursorKey :: Symbol) a.
Rep1 (WithCursor cursorType cursorKey) a
-> WithCursor cursorType cursorKey a
forall cursorType (cursorKey :: Symbol) a.
WithCursor cursorType cursorKey a
-> Rep1 (WithCursor cursorType cursorKey) a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall cursorType (cursorKey :: Symbol) a.
Rep1 (WithCursor cursorType cursorKey) a
-> WithCursor cursorType cursorKey a
$cfrom1 :: forall cursorType (cursorKey :: Symbol) a.
WithCursor cursorType cursorKey a
-> Rep1 (WithCursor cursorType cursorKey) a
Generic1, a
-> WithCursor cursorType cursorKey b
-> WithCursor cursorType cursorKey a
(a -> b)
-> WithCursor cursorType cursorKey a
-> WithCursor cursorType cursorKey b
(forall a b.
 (a -> b)
 -> WithCursor cursorType cursorKey a
 -> WithCursor cursorType cursorKey b)
-> (forall a b.
    a
    -> WithCursor cursorType cursorKey b
    -> WithCursor cursorType cursorKey a)
-> Functor (WithCursor cursorType cursorKey)
forall a b.
a
-> WithCursor cursorType cursorKey b
-> WithCursor cursorType cursorKey a
forall a b.
(a -> b)
-> WithCursor cursorType cursorKey a
-> WithCursor cursorType cursorKey b
forall cursorType (cursorKey :: Symbol) a b.
a
-> WithCursor cursorType cursorKey b
-> WithCursor cursorType cursorKey a
forall cursorType (cursorKey :: Symbol) a b.
(a -> b)
-> WithCursor cursorType cursorKey a
-> WithCursor cursorType cursorKey b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a
-> WithCursor cursorType cursorKey b
-> WithCursor cursorType cursorKey a
$c<$ :: forall cursorType (cursorKey :: Symbol) a b.
a
-> WithCursor cursorType cursorKey b
-> WithCursor cursorType cursorKey a
fmap :: (a -> b)
-> WithCursor cursorType cursorKey a
-> WithCursor cursorType cursorKey b
$cfmap :: forall cursorType (cursorKey :: Symbol) a b.
(a -> b)
-> WithCursor cursorType cursorKey a
-> WithCursor cursorType cursorKey b
Functor, WithCursor cursorType cursorKey a -> Bool
(a -> m) -> WithCursor cursorType cursorKey a -> m
(a -> b -> b) -> b -> WithCursor cursorType cursorKey a -> b
(forall m. Monoid m => WithCursor cursorType cursorKey m -> m)
-> (forall m a.
    Monoid m =>
    (a -> m) -> WithCursor cursorType cursorKey a -> m)
-> (forall m a.
    Monoid m =>
    (a -> m) -> WithCursor cursorType cursorKey a -> m)
-> (forall a b.
    (a -> b -> b) -> b -> WithCursor cursorType cursorKey a -> b)
-> (forall a b.
    (a -> b -> b) -> b -> WithCursor cursorType cursorKey a -> b)
-> (forall b a.
    (b -> a -> b) -> b -> WithCursor cursorType cursorKey a -> b)
-> (forall b a.
    (b -> a -> b) -> b -> WithCursor cursorType cursorKey a -> b)
-> (forall a.
    (a -> a -> a) -> WithCursor cursorType cursorKey a -> a)
-> (forall a.
    (a -> a -> a) -> WithCursor cursorType cursorKey a -> a)
-> (forall a. WithCursor cursorType cursorKey a -> [a])
-> (forall a. WithCursor cursorType cursorKey a -> Bool)
-> (forall a. WithCursor cursorType cursorKey a -> Int)
-> (forall a.
    Eq a =>
    a -> WithCursor cursorType cursorKey a -> Bool)
-> (forall a. Ord a => WithCursor cursorType cursorKey a -> a)
-> (forall a. Ord a => WithCursor cursorType cursorKey a -> a)
-> (forall a. Num a => WithCursor cursorType cursorKey a -> a)
-> (forall a. Num a => WithCursor cursorType cursorKey a -> a)
-> Foldable (WithCursor cursorType cursorKey)
forall a. Eq a => a -> WithCursor cursorType cursorKey a -> Bool
forall a. Num a => WithCursor cursorType cursorKey a -> a
forall a. Ord a => WithCursor cursorType cursorKey a -> a
forall m. Monoid m => WithCursor cursorType cursorKey m -> m
forall a. WithCursor cursorType cursorKey a -> Bool
forall a. WithCursor cursorType cursorKey a -> Int
forall a. WithCursor cursorType cursorKey a -> [a]
forall a. (a -> a -> a) -> WithCursor cursorType cursorKey a -> a
forall m a.
Monoid m =>
(a -> m) -> WithCursor cursorType cursorKey a -> m
forall b a.
(b -> a -> b) -> b -> WithCursor cursorType cursorKey a -> b
forall a b.
(a -> b -> b) -> b -> WithCursor cursorType cursorKey a -> b
forall cursorType (cursorKey :: Symbol) a.
Eq a =>
a -> WithCursor cursorType cursorKey a -> Bool
forall cursorType (cursorKey :: Symbol) a.
Num a =>
WithCursor cursorType cursorKey a -> a
forall cursorType (cursorKey :: Symbol) a.
Ord a =>
WithCursor cursorType cursorKey a -> a
forall cursorType (cursorKey :: Symbol) m.
Monoid m =>
WithCursor cursorType cursorKey m -> m
forall cursorType (cursorKey :: Symbol) a.
WithCursor cursorType cursorKey a -> Bool
forall cursorType (cursorKey :: Symbol) a.
WithCursor cursorType cursorKey a -> Int
forall cursorType (cursorKey :: Symbol) a.
WithCursor cursorType cursorKey a -> [a]
forall cursorType (cursorKey :: Symbol) a.
(a -> a -> a) -> WithCursor cursorType cursorKey a -> a
forall cursorType (cursorKey :: Symbol) m a.
Monoid m =>
(a -> m) -> WithCursor cursorType cursorKey a -> m
forall cursorType (cursorKey :: Symbol) b a.
(b -> a -> b) -> b -> WithCursor cursorType cursorKey a -> b
forall cursorType (cursorKey :: Symbol) a b.
(a -> b -> b) -> b -> WithCursor cursorType cursorKey a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: WithCursor cursorType cursorKey a -> a
$cproduct :: forall cursorType (cursorKey :: Symbol) a.
Num a =>
WithCursor cursorType cursorKey a -> a
sum :: WithCursor cursorType cursorKey a -> a
$csum :: forall cursorType (cursorKey :: Symbol) a.
Num a =>
WithCursor cursorType cursorKey a -> a
minimum :: WithCursor cursorType cursorKey a -> a
$cminimum :: forall cursorType (cursorKey :: Symbol) a.
Ord a =>
WithCursor cursorType cursorKey a -> a
maximum :: WithCursor cursorType cursorKey a -> a
$cmaximum :: forall cursorType (cursorKey :: Symbol) a.
Ord a =>
WithCursor cursorType cursorKey a -> a
elem :: a -> WithCursor cursorType cursorKey a -> Bool
$celem :: forall cursorType (cursorKey :: Symbol) a.
Eq a =>
a -> WithCursor cursorType cursorKey a -> Bool
length :: WithCursor cursorType cursorKey a -> Int
$clength :: forall cursorType (cursorKey :: Symbol) a.
WithCursor cursorType cursorKey a -> Int
null :: WithCursor cursorType cursorKey a -> Bool
$cnull :: forall cursorType (cursorKey :: Symbol) a.
WithCursor cursorType cursorKey a -> Bool
toList :: WithCursor cursorType cursorKey a -> [a]
$ctoList :: forall cursorType (cursorKey :: Symbol) a.
WithCursor cursorType cursorKey a -> [a]
foldl1 :: (a -> a -> a) -> WithCursor cursorType cursorKey a -> a
$cfoldl1 :: forall cursorType (cursorKey :: Symbol) a.
(a -> a -> a) -> WithCursor cursorType cursorKey a -> a
foldr1 :: (a -> a -> a) -> WithCursor cursorType cursorKey a -> a
$cfoldr1 :: forall cursorType (cursorKey :: Symbol) a.
(a -> a -> a) -> WithCursor cursorType cursorKey a -> a
foldl' :: (b -> a -> b) -> b -> WithCursor cursorType cursorKey a -> b
$cfoldl' :: forall cursorType (cursorKey :: Symbol) b a.
(b -> a -> b) -> b -> WithCursor cursorType cursorKey a -> b
foldl :: (b -> a -> b) -> b -> WithCursor cursorType cursorKey a -> b
$cfoldl :: forall cursorType (cursorKey :: Symbol) b a.
(b -> a -> b) -> b -> WithCursor cursorType cursorKey a -> b
foldr' :: (a -> b -> b) -> b -> WithCursor cursorType cursorKey a -> b
$cfoldr' :: forall cursorType (cursorKey :: Symbol) a b.
(a -> b -> b) -> b -> WithCursor cursorType cursorKey a -> b
foldr :: (a -> b -> b) -> b -> WithCursor cursorType cursorKey a -> b
$cfoldr :: forall cursorType (cursorKey :: Symbol) a b.
(a -> b -> b) -> b -> WithCursor cursorType cursorKey a -> b
foldMap' :: (a -> m) -> WithCursor cursorType cursorKey a -> m
$cfoldMap' :: forall cursorType (cursorKey :: Symbol) m a.
Monoid m =>
(a -> m) -> WithCursor cursorType cursorKey a -> m
foldMap :: (a -> m) -> WithCursor cursorType cursorKey a -> m
$cfoldMap :: forall cursorType (cursorKey :: Symbol) m a.
Monoid m =>
(a -> m) -> WithCursor cursorType cursorKey a -> m
fold :: WithCursor cursorType cursorKey m -> m
$cfold :: forall cursorType (cursorKey :: Symbol) m.
Monoid m =>
WithCursor cursorType cursorKey m -> m
Foldable, Functor (WithCursor cursorType cursorKey)
Foldable (WithCursor cursorType cursorKey)
Functor (WithCursor cursorType cursorKey)
-> Foldable (WithCursor cursorType cursorKey)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b)
    -> WithCursor cursorType cursorKey a
    -> f (WithCursor cursorType cursorKey b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    WithCursor cursorType cursorKey (f a)
    -> f (WithCursor cursorType cursorKey a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b)
    -> WithCursor cursorType cursorKey a
    -> m (WithCursor cursorType cursorKey b))
-> (forall (m :: * -> *) a.
    Monad m =>
    WithCursor cursorType cursorKey (m a)
    -> m (WithCursor cursorType cursorKey a))
-> Traversable (WithCursor cursorType cursorKey)
(a -> f b)
-> WithCursor cursorType cursorKey a
-> f (WithCursor cursorType cursorKey b)
forall cursorType (cursorKey :: Symbol).
Functor (WithCursor cursorType cursorKey)
forall cursorType (cursorKey :: Symbol).
Foldable (WithCursor cursorType cursorKey)
forall cursorType (cursorKey :: Symbol) (m :: * -> *) a.
Monad m =>
WithCursor cursorType cursorKey (m a)
-> m (WithCursor cursorType cursorKey a)
forall cursorType (cursorKey :: Symbol) (f :: * -> *) a.
Applicative f =>
WithCursor cursorType cursorKey (f a)
-> f (WithCursor cursorType cursorKey a)
forall cursorType (cursorKey :: Symbol) (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> WithCursor cursorType cursorKey a
-> m (WithCursor cursorType cursorKey b)
forall cursorType (cursorKey :: Symbol) (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> WithCursor cursorType cursorKey a
-> f (WithCursor cursorType cursorKey b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
WithCursor cursorType cursorKey (m a)
-> m (WithCursor cursorType cursorKey a)
forall (f :: * -> *) a.
Applicative f =>
WithCursor cursorType cursorKey (f a)
-> f (WithCursor cursorType cursorKey a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> WithCursor cursorType cursorKey a
-> m (WithCursor cursorType cursorKey b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> WithCursor cursorType cursorKey a
-> f (WithCursor cursorType cursorKey b)
sequence :: WithCursor cursorType cursorKey (m a)
-> m (WithCursor cursorType cursorKey a)
$csequence :: forall cursorType (cursorKey :: Symbol) (m :: * -> *) a.
Monad m =>
WithCursor cursorType cursorKey (m a)
-> m (WithCursor cursorType cursorKey a)
mapM :: (a -> m b)
-> WithCursor cursorType cursorKey a
-> m (WithCursor cursorType cursorKey b)
$cmapM :: forall cursorType (cursorKey :: Symbol) (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> WithCursor cursorType cursorKey a
-> m (WithCursor cursorType cursorKey b)
sequenceA :: WithCursor cursorType cursorKey (f a)
-> f (WithCursor cursorType cursorKey a)
$csequenceA :: forall cursorType (cursorKey :: Symbol) (f :: * -> *) a.
Applicative f =>
WithCursor cursorType cursorKey (f a)
-> f (WithCursor cursorType cursorKey a)
traverse :: (a -> f b)
-> WithCursor cursorType cursorKey a
-> f (WithCursor cursorType cursorKey b)
$ctraverse :: forall cursorType (cursorKey :: Symbol) (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> WithCursor cursorType cursorKey a
-> f (WithCursor cursorType cursorKey b)
$cp2Traversable :: forall cursorType (cursorKey :: Symbol).
Foldable (WithCursor cursorType cursorKey)
$cp1Traversable :: forall cursorType (cursorKey :: Symbol).
Functor (WithCursor cursorType cursorKey)
Traversable)

instance (KnownSymbol cursorKey, FromJSON cursorType) => FromJSON1 (WithCursor cursorType cursorKey) where
    liftParseJSON :: (Value -> Parser a)
-> (Value -> Parser [a])
-> Value
-> Parser (WithCursor cursorType cursorKey a)
liftParseJSON Value -> Parser a
_ Value -> Parser [a]
lp =
        String
-> (Object -> Parser (WithCursor cursorType cursorKey a))
-> Value
-> Parser (WithCursor cursorType cursorKey a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject (String
"WithCursor \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
cursorKeyStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\"") ((Object -> Parser (WithCursor cursorType cursorKey a))
 -> Value -> Parser (WithCursor cursorType cursorKey a))
-> (Object -> Parser (WithCursor cursorType cursorKey a))
-> Value
-> Parser (WithCursor cursorType cursorKey a)
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
            Maybe cursorType
-> Maybe cursorType -> [a] -> WithCursor cursorType cursorKey a
forall cursorType (cursorKey :: Symbol) wrapped.
Maybe cursorType
-> Maybe cursorType
-> [wrapped]
-> WithCursor cursorType cursorKey wrapped
WithCursor (Maybe cursorType
 -> Maybe cursorType -> [a] -> WithCursor cursorType cursorKey a)
-> Parser (Maybe cursorType)
-> Parser
     (Maybe cursorType -> [a] -> WithCursor cursorType cursorKey a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser (Maybe cursorType)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"previous_cursor"
                Parser
  (Maybe cursorType -> [a] -> WithCursor cursorType cursorKey a)
-> Parser (Maybe cursorType)
-> Parser ([a] -> WithCursor cursorType cursorKey a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe cursorType)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"next_cursor"
                Parser ([a] -> WithCursor cursorType cursorKey a)
-> Parser [a] -> Parser (WithCursor cursorType cursorKey a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
obj Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: String -> Key
forall a. IsString a => String -> a
fromString String
cursorKeyStr Parser Value -> (Value -> Parser [a]) -> Parser [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser [a]
lp)
      where
        cursorKeyStr :: String
cursorKeyStr = Proxy cursorKey -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy cursorKey
forall k (t :: k). Proxy t
Proxy :: Proxy cursorKey)

instance (KnownSymbol cursorKey, FromJSON cursorType, FromJSON wrapped) => FromJSON (WithCursor cursorType cursorKey wrapped) where
    parseJSON :: Value -> Parser (WithCursor cursorType cursorKey wrapped)
parseJSON = Value -> Parser (WithCursor cursorType cursorKey wrapped)
forall (f :: * -> *) a.
(FromJSON1 f, FromJSON a) =>
Value -> Parser (f a)
parseJSON1

instance (NFData cursorType, NFData wrapped) => NFData (WithCursor cursorType cursorKey wrapped)