pagination-0.2.2: Framework-agnostic pagination boilerplate
Copyright© 2016–present Mark Karpov
LicenseBSD 3 clause
MaintainerMark Karpov <markkarpov92@gmail.com>
Stabilityexperimental
Portabilityportable
Safe HaskellSafe-Inferred
LanguageHaskell2010

Data.Pagination

Description

Framework-agnostic pagination boilerplate.

Synopsis

Pagination settings

data Pagination Source #

Settings that are required to organize data in paginated form.

Instances

Instances details
Eq Pagination Source # 
Instance details

Defined in Data.Pagination

Data Pagination Source # 
Instance details

Defined in Data.Pagination

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Pagination -> c Pagination #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Pagination #

toConstr :: Pagination -> Constr #

dataTypeOf :: Pagination -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Pagination) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pagination) #

gmapT :: (forall b. Data b => b -> b) -> Pagination -> Pagination #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pagination -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pagination -> r #

gmapQ :: (forall d. Data d => d -> u) -> Pagination -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Pagination -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Pagination -> m Pagination #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Pagination -> m Pagination #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Pagination -> m Pagination #

Show Pagination Source # 
Instance details

Defined in Data.Pagination

Generic Pagination Source # 
Instance details

Defined in Data.Pagination

Associated Types

type Rep Pagination :: Type -> Type #

NFData Pagination Source # 
Instance details

Defined in Data.Pagination

Methods

rnf :: Pagination -> () #

type Rep Pagination Source # 
Instance details

Defined in Data.Pagination

type Rep Pagination = D1 ('MetaData "Pagination" "Data.Pagination" "pagination-0.2.2-AqQINAW4ekDJkRmvyXQYSI" 'False) (C1 ('MetaCons "Pagination" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Natural) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Natural)))

mkPagination Source #

Arguments

:: MonadThrow m 
=> Natural

Page size

-> Natural

Page index

-> m Pagination

The pagination settings

Create a Pagination value. May throw PaginationException.

pageSize :: Pagination -> Natural Source #

Get page size (maximum number of items on a page) from a Pagination.

pageIndex :: Pagination -> Natural Source #

Get page index from a Pagination.

Paginated data

data Paginated a Source #

Data in the paginated form.

Instances

Instances details
Functor Paginated Source # 
Instance details

Defined in Data.Pagination

Methods

fmap :: (a -> b) -> Paginated a -> Paginated b #

(<$) :: a -> Paginated b -> Paginated a #

Foldable Paginated Source # 
Instance details

Defined in Data.Pagination

Methods

fold :: Monoid m => Paginated m -> m #

foldMap :: Monoid m => (a -> m) -> Paginated a -> m #

foldMap' :: Monoid m => (a -> m) -> Paginated a -> m #

foldr :: (a -> b -> b) -> b -> Paginated a -> b #

foldr' :: (a -> b -> b) -> b -> Paginated a -> b #

foldl :: (b -> a -> b) -> b -> Paginated a -> b #

foldl' :: (b -> a -> b) -> b -> Paginated a -> b #

foldr1 :: (a -> a -> a) -> Paginated a -> a #

foldl1 :: (a -> a -> a) -> Paginated a -> a #

toList :: Paginated a -> [a] #

null :: Paginated a -> Bool #

length :: Paginated a -> Int #

elem :: Eq a => a -> Paginated a -> Bool #

maximum :: Ord a => Paginated a -> a #

minimum :: Ord a => Paginated a -> a #

sum :: Num a => Paginated a -> a #

product :: Num a => Paginated a -> a #

Traversable Paginated Source # 
Instance details

Defined in Data.Pagination

Methods

traverse :: Applicative f => (a -> f b) -> Paginated a -> f (Paginated b) #

sequenceA :: Applicative f => Paginated (f a) -> f (Paginated a) #

mapM :: Monad m => (a -> m b) -> Paginated a -> m (Paginated b) #

sequence :: Monad m => Paginated (m a) -> m (Paginated a) #

Eq a => Eq (Paginated a) Source # 
Instance details

Defined in Data.Pagination

Methods

(==) :: Paginated a -> Paginated a -> Bool #

(/=) :: Paginated a -> Paginated a -> Bool #

Data a => Data (Paginated a) Source # 
Instance details

Defined in Data.Pagination

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Paginated a -> c (Paginated a) #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Paginated a) #

toConstr :: Paginated a -> Constr #

dataTypeOf :: Paginated a -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Paginated a)) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Paginated a)) #

gmapT :: (forall b. Data b => b -> b) -> Paginated a -> Paginated a #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Paginated a -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Paginated a -> r #

gmapQ :: (forall d. Data d => d -> u) -> Paginated a -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Paginated a -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Paginated a -> m (Paginated a) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Paginated a -> m (Paginated a) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Paginated a -> m (Paginated a) #

Show a => Show (Paginated a) Source # 
Instance details

Defined in Data.Pagination

Generic (Paginated a) Source # 
Instance details

Defined in Data.Pagination

Associated Types

type Rep (Paginated a) :: Type -> Type #

Methods

from :: Paginated a -> Rep (Paginated a) x #

to :: Rep (Paginated a) x -> Paginated a #

NFData a => NFData (Paginated a) Source # 
Instance details

Defined in Data.Pagination

Methods

rnf :: Paginated a -> () #

type Rep (Paginated a) Source # 
Instance details

Defined in Data.Pagination

type Rep (Paginated a) = D1 ('MetaData "Paginated" "Data.Pagination" "pagination-0.2.2-AqQINAW4ekDJkRmvyXQYSI" 'False) (C1 ('MetaCons "Paginated" 'PrefixI 'True) ((S1 ('MetaSel ('Just "pgItems") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [a]) :*: S1 ('MetaSel ('Just "pgPagination") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Pagination)) :*: (S1 ('MetaSel ('Just "pgPagesTotal") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Natural) :*: S1 ('MetaSel ('Just "pgItemsTotal") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Natural))))

paginate Source #

Arguments

:: (Functor m, Integral n) 
=> Pagination

Pagination options

-> Natural

Total number of items

-> (n -> n -> m [a])

The element producing callback. The function takes arguments: offset and limit.

-> m (Paginated a)

The paginated data

Create paginated data.

paginatedItems :: Paginated a -> [a] Source #

Get subset of items for current page.

paginatedPagination :: Paginated a -> Pagination Source #

Get Pagination parameters that were used to create this paginated result.

paginatedPagesTotal :: Paginated a -> Natural Source #

Get the total number of pages in this collection.

paginatedItemsTotal :: Paginated a -> Natural Source #

Get the total number of items in this collection.

hasOtherPages :: Paginated a -> Bool Source #

Test whether there are other pages.

pageRange Source #

Arguments

:: Paginated a

Paginated data

-> Natural

Number of pages to show before and after

-> NonEmpty Natural

Page range

Get range of pages to show before and after the current page. This does not necessarily include the first and the last pages (they are supposed to be shown in all cases). Result of the function is always sorted.

hasPrevPage :: Paginated a -> Bool Source #

Is there previous page?

hasNextPage :: Paginated a -> Bool Source #

Is there next page?

backwardEllip Source #

Arguments

:: Paginated a

Paginated data

-> Natural

Number of pages to show before and after

-> Bool 

Backward ellipsis appears when page range (pages around current page to jump to) has gap between its beginning and the first page.

forwardEllip Source #

Arguments

:: Paginated a

Paginated data

-> Natural

Number of pages to show before and after

-> Bool

Do we have forward ellipsis?

Forward ellipsis appears when page range (pages around current page to jump to) has gap between its end and the last page.

Exceptions

data PaginationException Source #

Exception indicating various problems when working with paginated data.

Constructors

ZeroPageSize

Page size (number of items per page) was zero

ZeroPageIndex

Page index was zero (they start from one)

Instances

Instances details
Eq PaginationException Source # 
Instance details

Defined in Data.Pagination

Data PaginationException Source # 
Instance details

Defined in Data.Pagination

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> PaginationException -> c PaginationException #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c PaginationException #

toConstr :: PaginationException -> Constr #

dataTypeOf :: PaginationException -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c PaginationException) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PaginationException) #

gmapT :: (forall b. Data b => b -> b) -> PaginationException -> PaginationException #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> PaginationException -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> PaginationException -> r #

gmapQ :: (forall d. Data d => d -> u) -> PaginationException -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> PaginationException -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> PaginationException -> m PaginationException #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> PaginationException -> m PaginationException #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> PaginationException -> m PaginationException #

Show PaginationException Source # 
Instance details

Defined in Data.Pagination

Generic PaginationException Source # 
Instance details

Defined in Data.Pagination

Associated Types

type Rep PaginationException :: Type -> Type #

Exception PaginationException Source # 
Instance details

Defined in Data.Pagination

NFData PaginationException Source # 
Instance details

Defined in Data.Pagination

Methods

rnf :: PaginationException -> () #

type Rep PaginationException Source # 
Instance details

Defined in Data.Pagination

type Rep PaginationException = D1 ('MetaData "PaginationException" "Data.Pagination" "pagination-0.2.2-AqQINAW4ekDJkRmvyXQYSI" 'False) (C1 ('MetaCons "ZeroPageSize" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "ZeroPageIndex" 'PrefixI 'False) (U1 :: Type -> Type))