module Data.Pagination
(
Pagination
, mkPagination
, pageSize
, pageIndex
, Paginated
, paginate
, paginatedItems
, paginatedPagination
, paginatedPagesTotal
, paginatedItemsTotal
, hasOtherPages
, pageRange
, hasPrevPage
, hasNextPage
, backwardEllip
, forwardEllip
, PaginationException (..) )
where
import Control.DeepSeq
import Control.Monad.Catch
import Data.Data (Data)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Typeable (Typeable)
import GHC.Generics
import Numeric.Natural
import qualified Data.List.NonEmpty as NE
data Pagination = Pagination Natural Natural
deriving (Eq, Show, Data, Typeable, Generic)
instance NFData Pagination
mkPagination :: MonadThrow m
=> Natural
-> Natural
-> m Pagination
mkPagination size index
| size == 0 = throwM ZeroPageSize
| index == 0 = throwM ZeroPageIndex
| otherwise = return (Pagination size index)
pageSize :: Pagination -> Natural
pageSize (Pagination size _) = size
pageIndex :: Pagination -> Natural
pageIndex (Pagination _ index) = index
data Paginated a = Paginated
{ pgItems :: [a]
, pgPagination :: Pagination
, pgPagesTotal :: Natural
, pgItemsTotal :: Natural
} deriving (Eq, Show, Data, Typeable, Generic)
instance NFData a => NFData (Paginated a)
instance Functor Paginated where
fmap f p@Paginated {..} = p { pgItems = fmap f pgItems }
instance Applicative Paginated where
pure x = Paginated [x] (Pagination 1 1) 1 1
f <*> p = p { pgItems = pgItems f <*> pgItems p }
instance Foldable Paginated where
foldr f x = foldr f x . pgItems
instance Traversable Paginated where
traverse f p =
let g p' xs = p' { pgItems = xs }
in g p <$> traverse f (pgItems p)
paginate :: (Monad m, Integral n)
=> Pagination
-> Natural
-> (n -> n -> m [a])
-> m (Paginated a)
paginate (Pagination size index') totalItems f = do
items <- f (fromIntegral offset) (fromIntegral size)
return Paginated
{ pgItems = items
, pgPagination = Pagination size index
, pgPagesTotal = totalPages
, pgItemsTotal = totalItems }
where
(whole, rems) = totalItems `quotRem` size
totalPages = max 1 (whole + if rems == 0 then 0 else 1)
index = min index' totalPages
offset = (index 1) * size
paginatedItems :: Paginated a -> [a]
paginatedItems = pgItems
paginatedPagination :: Paginated a -> Pagination
paginatedPagination = pgPagination
paginatedPagesTotal :: Paginated a -> Natural
paginatedPagesTotal = pgPagesTotal
paginatedItemsTotal :: Paginated a -> Natural
paginatedItemsTotal = pgItemsTotal
hasOtherPages :: Paginated a -> Bool
hasOtherPages Paginated {..} = pgPagesTotal > 1
hasPrevPage :: Paginated a -> Bool
hasPrevPage Paginated {..} = pageIndex pgPagination > (1 :: Natural)
hasNextPage :: Paginated a -> Bool
hasNextPage Paginated {..} = pageIndex pgPagination < pgPagesTotal
pageRange
:: Paginated a
-> Natural
-> NonEmpty Natural
pageRange Paginated {..} 0 = NE.fromList [pageIndex pgPagination]
pageRange Paginated {..} n =
let len = min pgPagesTotal (n * 2 + 1)
index = pageIndex pgPagination
shift | index <= n = 0
| index >= pgPagesTotal n = pgPagesTotal len
| otherwise = index n 1
in (+ shift) <$> NE.fromList [1..len]
backwardEllip
:: Paginated a
-> Natural
-> Bool
backwardEllip p n = NE.head (pageRange p n) > 2
forwardEllip
:: Paginated a
-> Natural
-> Bool
forwardEllip p@Paginated {..} n = NE.last (pageRange p n) < pred pgPagesTotal
data PaginationException
= ZeroPageSize
| ZeroPageIndex
deriving (Eq, Show, Data, Typeable, Generic)
instance NFData PaginationException
instance Exception PaginationException