| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Servant.Pagination
- data Range (field :: Symbol) typ = Range {
- rangeValue :: Maybe typ
- rangeLimit :: Int
- rangeOffset :: Int
- rangeOrder :: RangeOrder
- data RangeOrder
- data AcceptRanges range = AcceptRanges
- data ContentRange range = ContentRange {
- contentRangeStart :: range
- contentRangeEnd :: range
- data NextRange range = NextRange range
- type PageHeaders range = '[Header "Accept-Ranges" (AcceptRanges range), Header "Content-Range" (ContentRange range), Header "Next-Range" (NextRange range), Header "Total-Count" Natural]
- type TotalCount = Maybe Natural
- class FromRange a where
- class FromHttpApiData a where
- data FromRangeOptions = FromRangeOptions {}
- defaultOptions :: FromRangeOptions
- defaultRange :: Maybe a -> FromRangeOptions -> Range field a
- class KnownSymbol field => HasPagination resource field where
- applyRange :: forall b field. (HasPagination b field, Ord (RangeType b field)) => Range field (RangeType b field) -> [b] -> [b]
- data a :|: b
Types
data Range (field :: Symbol) typ Source #
Constructors
| Range | |
Fields
| |
Instances
| Functor (Range field) Source # | |
| (ToHttpApiData typ, KnownSymbol field) => ToHttpApiData (NextRange (Range field typ)) Source # | |
| (ToHttpApiData typ, KnownSymbol field) => ToHttpApiData (ContentRange (Range field typ)) Source # | |
| Eq typ => Eq (Range field typ) Source # | |
| Show typ => Show (Range field typ) Source # | |
| Generic (Range field typ) Source # | |
| (ToHttpApiData typ, KnownSymbol field) => ToHttpApiData (Range field typ) Source # | |
| (FromHttpApiData typ, KnownSymbol field) => FromHttpApiData (Range field typ) Source # | |
| KnownSymbol field => ToAcceptRanges (Range field typ) Source # | |
| (FromHttpApiData typ, KnownSymbol field) => FromRange (Range field typ) Source # | |
| type Rep (Range field typ) Source # | |
data RangeOrder Source #
Define the sorting order of the paginated resources (ascending or descending)
Instances
data AcceptRanges range Source #
Accepted Ranges in the `Accept-Ranges` response's header
Constructors
| AcceptRanges |
Instances
| ToAcceptRanges a => ToHttpApiData (AcceptRanges a) Source # | |
data ContentRange range Source #
Actual range returned, in the `Content-Range` response's header
Constructors
| ContentRange | |
Fields
| |
Instances
| (ToHttpApiData (ContentRange a), ToHttpApiData (ContentRange b)) => ToHttpApiData (ContentRange ((:|:) a b)) Source # | |
| (ToHttpApiData typ, KnownSymbol field) => ToHttpApiData (ContentRange (Range field typ)) Source # | |
Range to provide to retrieve the next batch of resource, in the `Next-Range` response's header
Constructors
| NextRange range |
Instances
| (ToHttpApiData (NextRange a), ToHttpApiData (NextRange b)) => ToHttpApiData (NextRange ((:|:) a b)) Source # | |
| (ToHttpApiData typ, KnownSymbol field) => ToHttpApiData (NextRange (Range field typ)) Source # | |
type PageHeaders range = '[Header "Accept-Ranges" (AcceptRanges range), Header "Content-Range" (ContentRange range), Header "Next-Range" (NextRange range), Header "Total-Count" Natural] Source #
Type alias to declare response headers related to pagination
type TotalCount = Maybe Natural Source #
Declare Ranges
class FromRange a where Source #
Parse a Range object from a Range request's header. Any `Range field typ` and combinations
of any `Range field typ` provide instance of this class. It is a signature similar to
parseUrlPiece from the FromHttpApiData class and can be used as a drop-in replacement to
define instance of this class.
type MyRange = Range "created_at" UTCTime
instance FromHttpApiData UTCTime => FromHttpApiData MyRange where
parseUrlPiece =
fromRange defaultOptionsMinimal complete definition
Methods
parseRange :: FromRangeOptions -> Text -> Either Text a Source #
Instances
| (FromHttpApiData typ, KnownSymbol field) => FromRange (Range field typ) Source # | |
class FromHttpApiData a where #
Parse value from HTTP API data.
WARNING: Do not derive this using DeriveAnyClass as the generated
instance will loop indefinitely.
Minimal complete definition
Methods
parseUrlPiece :: Text -> Either Text a #
Parse URL path piece.
parseHeader :: ByteString -> Either Text a #
Parse HTTP header value.
parseQueryParam :: Text -> Either Text a #
Parse query param value.
Instances
| FromHttpApiData Bool | |
| FromHttpApiData Char | |
| FromHttpApiData Double | |
| FromHttpApiData Float | |
| FromHttpApiData Int | |
| FromHttpApiData Int8 | |
| FromHttpApiData Int16 | |
| FromHttpApiData Int32 | |
| FromHttpApiData Int64 | |
| FromHttpApiData Integer | |
| FromHttpApiData Natural | |
| FromHttpApiData Ordering | |
| FromHttpApiData Word | |
| FromHttpApiData Word8 | |
| FromHttpApiData Word16 | |
| FromHttpApiData Word32 | |
| FromHttpApiData Word64 | |
| FromHttpApiData () |
|
| FromHttpApiData String | |
| FromHttpApiData Text | |
| FromHttpApiData UTCTime |
|
| FromHttpApiData Text | |
| FromHttpApiData Void | Parsing a |
| FromHttpApiData Version |
|
| FromHttpApiData All | |
| FromHttpApiData Any | |
| FromHttpApiData ZonedTime |
|
| FromHttpApiData LocalTime |
|
| FromHttpApiData TimeOfDay |
|
| FromHttpApiData NominalDiffTime | |
| FromHttpApiData Day |
|
| FromHttpApiData UUID | |
| FromHttpApiData RangeOrder # | |
| FromHttpApiData a => FromHttpApiData (Maybe a) |
|
| FromHttpApiData a => FromHttpApiData (Dual a) | |
| FromHttpApiData a => FromHttpApiData (Sum a) | |
| FromHttpApiData a => FromHttpApiData (Product a) | |
| FromHttpApiData a => FromHttpApiData (First a) | |
| FromHttpApiData a => FromHttpApiData (Last a) | |
| FromHttpApiData a => FromHttpApiData (LenientData a) | |
| (FromHttpApiData a, FromHttpApiData b) => FromHttpApiData (Either a b) |
|
| (FromHttpApiData a, FromHttpApiData b) => FromHttpApiData ((:|:) a b) # | |
| (FromHttpApiData typ, KnownSymbol field) => FromHttpApiData (Range field typ) # | |
data FromRangeOptions Source #
Default values to apply when parsing a Range
Constructors
| FromRangeOptions | |
Fields | |
Instances
defaultOptions :: FromRangeOptions Source #
Some default options of default values for a Range (limit 100; offset 0; order desc)
defaultRange :: Maybe a -> FromRangeOptions -> Range field a Source #
Some default range based on the default options
Use Ranges
class KnownSymbol field => HasPagination resource field where Source #
In addition to the FromHttpApiData instance, one can provide an instance for this
type-class to easily lift a list of response to a Servant handler.
By providing a getter to retrieve the value of an actual range from a resource, the
HasPagination class provides returnPage to handle the plumbering of declaring
response headers related to pagination.
Minimal complete definition
Methods
getRangeField :: Proxy field -> resource -> RangeType resource field Source #
returnPage_ :: forall m ranges. (Monad m, Range field (RangeType resource field) :<: ranges, ToAcceptRanges ranges, ToHttpApiData (ContentRange ranges), ToHttpApiData (NextRange ranges), Ord (RangeType resource field)) => Range field (RangeType resource field) -> [resource] -> m (Headers (PageHeaders ranges) [resource]) Source #
returnPage :: forall m ranges. (Monad m, Range field (RangeType resource field) :<: ranges, ToAcceptRanges ranges, ToHttpApiData (ContentRange ranges), ToHttpApiData (NextRange ranges), Ord (RangeType resource field)) => TotalCount -> Range field (RangeType resource field) -> [resource] -> m (Headers (PageHeaders ranges) [resource]) Source #
applyRange :: forall b field. (HasPagination b field, Ord (RangeType b field)) => Range field (RangeType b field) -> [b] -> [b] Source #
Apply a range to a list of element
Combine Ranges
data a :|: b infixl 7 Source #
Combine two ranges in a new range, parsing is done left-first
Instances