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

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