{-# LANGUAGE CPP #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

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

import Data.Aeson
import Data.Text (Text)
import Web.Twitter.Types (checkError)

-- $setup
-- >>> type UserId = Integer

{- ORMOLU_DISABLE -}
class CursorKey a where
#if MIN_VERSION_aeson(2, 0, 0)
    cursorKey :: a -> Key
#else
    cursorKey :: a -> Text
#endif
{- ORMOLU_ENABLE -}

-- | Phantom type to specify the key which point out the content in the response.
data IdsCursorKey

instance CursorKey IdsCursorKey where
    cursorKey :: IdsCursorKey -> Key
cursorKey = Key -> IdsCursorKey -> Key
forall a b. a -> b -> a
const Key
"ids"

-- | Phantom type to specify the key which point out the content in the response.
data UsersCursorKey

instance CursorKey UsersCursorKey where
    cursorKey :: UsersCursorKey -> Key
cursorKey = Key -> UsersCursorKey -> Key
forall a b. a -> b -> a
const Key
"users"

-- | Phantom type to specify the key which point out the content in the response.
data ListsCursorKey

instance CursorKey ListsCursorKey where
    cursorKey :: ListsCursorKey -> Key
cursorKey = Key -> ListsCursorKey -> Key
forall a b. a -> b -> a
const Key
"lists"

data EventsCursorKey
instance CursorKey EventsCursorKey where
    cursorKey :: EventsCursorKey -> Key
cursorKey = Key -> EventsCursorKey -> Key
forall a b. a -> b -> a
const Key
"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 IdsCursorKey UserId)
-- >>> nextCursor res
-- Just 1234567890
-- >>> contents res
-- [1111111111]
--
-- >>> let Just res = decode "{\"previous_cursor\": 0, \"next_cursor\": 0, \"users\": [1000]}" :: Maybe (WithCursor Integer UsersCursorKey UserId)
-- >>> nextCursor res
-- Just 0
-- >>> contents res
-- [1000]
--
-- >>> let Just res = decode "{\"next_cursor\": \"hogehoge\", \"events\": [1000]}" :: Maybe (WithCursor Text EventsCursorKey UserId)
-- >>> nextCursor res
-- Just "hogehoge"
-- >>> contents res
-- [1000]
data WithCursor cursorType cursorKey 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 wrapped.
(Show cursorType, Show wrapped) =>
Int -> WithCursor cursorType cursorKey wrapped -> ShowS
forall cursorType cursorKey wrapped.
(Show cursorType, Show wrapped) =>
[WithCursor cursorType cursorKey wrapped] -> ShowS
forall cursorType cursorKey wrapped.
(Show cursorType, Show wrapped) =>
WithCursor cursorType cursorKey wrapped -> String
showList :: [WithCursor cursorType cursorKey wrapped] -> ShowS
$cshowList :: forall cursorType cursorKey wrapped.
(Show cursorType, Show wrapped) =>
[WithCursor cursorType cursorKey wrapped] -> ShowS
show :: WithCursor cursorType cursorKey wrapped -> String
$cshow :: forall cursorType cursorKey wrapped.
(Show cursorType, Show wrapped) =>
WithCursor cursorType cursorKey wrapped -> String
showsPrec :: Int -> WithCursor cursorType cursorKey wrapped -> ShowS
$cshowsPrec :: forall cursorType cursorKey wrapped.
(Show cursorType, Show wrapped) =>
Int -> WithCursor cursorType cursorKey wrapped -> ShowS
Show)

instance
    (FromJSON wrapped, FromJSON ct, CursorKey c) =>
    FromJSON (WithCursor ct c wrapped)
    where
    parseJSON :: Value -> Parser (WithCursor ct c wrapped)
parseJSON (Object Object
o) =
        Object -> Parser ()
checkError Object
o
            Parser ()
-> Parser (WithCursor ct c wrapped)
-> Parser (WithCursor ct c wrapped)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe ct -> Maybe ct -> [wrapped] -> WithCursor ct c wrapped
forall cursorType cursorKey wrapped.
Maybe cursorType
-> Maybe cursorType
-> [wrapped]
-> WithCursor cursorType cursorKey wrapped
WithCursor (Maybe ct -> Maybe ct -> [wrapped] -> WithCursor ct c wrapped)
-> Parser (Maybe ct)
-> Parser (Maybe ct -> [wrapped] -> WithCursor ct c wrapped)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe ct)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"previous_cursor"
            Parser (Maybe ct -> [wrapped] -> WithCursor ct c wrapped)
-> Parser (Maybe ct)
-> Parser ([wrapped] -> WithCursor ct c wrapped)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe ct)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"next_cursor"
            Parser ([wrapped] -> WithCursor ct c wrapped)
-> Parser [wrapped] -> Parser (WithCursor ct c wrapped)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser [wrapped]
forall a. FromJSON a => Object -> Key -> Parser a
.: c -> Key
forall a. CursorKey a => a -> Key
cursorKey (c
forall a. HasCallStack => a
undefined :: c)
    parseJSON Value
_ = Parser (WithCursor ct c wrapped)
forall a. Monoid a => a
mempty