{-# LANGUAGE TemplateHaskell #-}

module Web.Slack.Pager.Types where

import Web.Slack.Prelude
import Web.Slack.Util

newtype Cursor = Cursor {Cursor -> Text
unCursor :: Text}
  deriving stock (Cursor -> Cursor -> Bool
(Cursor -> Cursor -> Bool)
-> (Cursor -> Cursor -> Bool) -> Eq Cursor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cursor -> Cursor -> Bool
== :: Cursor -> Cursor -> Bool
$c/= :: Cursor -> Cursor -> Bool
/= :: Cursor -> Cursor -> Bool
Eq, (forall x. Cursor -> Rep Cursor x)
-> (forall x. Rep Cursor x -> Cursor) -> Generic Cursor
forall x. Rep Cursor x -> Cursor
forall x. Cursor -> Rep Cursor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Cursor -> Rep Cursor x
from :: forall x. Cursor -> Rep Cursor x
$cto :: forall x. Rep Cursor x -> Cursor
to :: forall x. Rep Cursor x -> Cursor
Generic, Int -> Cursor -> ShowS
[Cursor] -> ShowS
Cursor -> String
(Int -> Cursor -> ShowS)
-> (Cursor -> String) -> ([Cursor] -> ShowS) -> Show Cursor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cursor -> ShowS
showsPrec :: Int -> Cursor -> ShowS
$cshow :: Cursor -> String
show :: Cursor -> String
$cshowList :: [Cursor] -> ShowS
showList :: [Cursor] -> ShowS
Show)
  deriving newtype (Cursor -> ()
(Cursor -> ()) -> NFData Cursor
forall a. (a -> ()) -> NFData a
$crnf :: Cursor -> ()
rnf :: Cursor -> ()
NFData, Eq Cursor
Eq Cursor =>
(Int -> Cursor -> Int) -> (Cursor -> Int) -> Hashable Cursor
Int -> Cursor -> Int
Cursor -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Cursor -> Int
hashWithSalt :: Int -> Cursor -> Int
$chash :: Cursor -> Int
hash :: Cursor -> Int
Hashable, Value -> Parser [Cursor]
Value -> Parser Cursor
(Value -> Parser Cursor)
-> (Value -> Parser [Cursor]) -> FromJSON Cursor
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Cursor
parseJSON :: Value -> Parser Cursor
$cparseJSONList :: Value -> Parser [Cursor]
parseJSONList :: Value -> Parser [Cursor]
FromJSON, [Cursor] -> Value
[Cursor] -> Encoding
Cursor -> Value
Cursor -> Encoding
(Cursor -> Value)
-> (Cursor -> Encoding)
-> ([Cursor] -> Value)
-> ([Cursor] -> Encoding)
-> ToJSON Cursor
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Cursor -> Value
toJSON :: Cursor -> Value
$ctoEncoding :: Cursor -> Encoding
toEncoding :: Cursor -> Encoding
$ctoJSONList :: [Cursor] -> Value
toJSONList :: [Cursor] -> Value
$ctoEncodingList :: [Cursor] -> Encoding
toEncodingList :: [Cursor] -> Encoding
ToJSON, Cursor -> Text
Cursor -> ByteString
Cursor -> Builder
(Cursor -> Text)
-> (Cursor -> Builder)
-> (Cursor -> ByteString)
-> (Cursor -> Text)
-> (Cursor -> Builder)
-> ToHttpApiData Cursor
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> (a -> Builder)
-> ToHttpApiData a
$ctoUrlPiece :: Cursor -> Text
toUrlPiece :: Cursor -> Text
$ctoEncodedUrlPiece :: Cursor -> Builder
toEncodedUrlPiece :: Cursor -> Builder
$ctoHeader :: Cursor -> ByteString
toHeader :: Cursor -> ByteString
$ctoQueryParam :: Cursor -> Text
toQueryParam :: Cursor -> Text
$ctoEncodedQueryParam :: Cursor -> Builder
toEncodedQueryParam :: Cursor -> Builder
ToHttpApiData)

newtype ResponseMetadata = ResponseMetadata {ResponseMetadata -> Maybe Cursor
responseMetadataNextCursor :: Maybe Cursor}
  deriving stock (ResponseMetadata -> ResponseMetadata -> Bool
(ResponseMetadata -> ResponseMetadata -> Bool)
-> (ResponseMetadata -> ResponseMetadata -> Bool)
-> Eq ResponseMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResponseMetadata -> ResponseMetadata -> Bool
== :: ResponseMetadata -> ResponseMetadata -> Bool
$c/= :: ResponseMetadata -> ResponseMetadata -> Bool
/= :: ResponseMetadata -> ResponseMetadata -> Bool
Eq, Int -> ResponseMetadata -> ShowS
[ResponseMetadata] -> ShowS
ResponseMetadata -> String
(Int -> ResponseMetadata -> ShowS)
-> (ResponseMetadata -> String)
-> ([ResponseMetadata] -> ShowS)
-> Show ResponseMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResponseMetadata -> ShowS
showsPrec :: Int -> ResponseMetadata -> ShowS
$cshow :: ResponseMetadata -> String
show :: ResponseMetadata -> String
$cshowList :: [ResponseMetadata] -> ShowS
showList :: [ResponseMetadata] -> ShowS
Show, (forall x. ResponseMetadata -> Rep ResponseMetadata x)
-> (forall x. Rep ResponseMetadata x -> ResponseMetadata)
-> Generic ResponseMetadata
forall x. Rep ResponseMetadata x -> ResponseMetadata
forall x. ResponseMetadata -> Rep ResponseMetadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ResponseMetadata -> Rep ResponseMetadata x
from :: forall x. ResponseMetadata -> Rep ResponseMetadata x
$cto :: forall x. Rep ResponseMetadata x -> ResponseMetadata
to :: forall x. Rep ResponseMetadata x -> ResponseMetadata
Generic)

instance NFData ResponseMetadata

$(deriveJSON (jsonOpts "responseMetadata") ''ResponseMetadata)

class PagedRequest a where
  setCursor :: Maybe Cursor -> a -> a

class PagedResponse a where
  type ResponseObject a
  getResponseMetadata :: a -> Maybe ResponseMetadata
  getResponseData :: a -> [ResponseObject a]