diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,7 @@ +## Pagination 0.2.2 + +* Works with 9.0.1. Dropped support for GHC 8.6 and older. + ## Pagination 0.2.1 * Fix test suite failure with `QuickCheck-2.10`. diff --git a/Data/Pagination.hs b/Data/Pagination.hs --- a/Data/Pagination.hs +++ b/Data/Pagination.hs @@ -1,6 +1,11 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE RecordWildCards #-} + -- | -- Module : Data.Pagination --- Copyright : © 2016–2017 Mark Karpov +-- Copyright : © 2016–present Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov @@ -8,72 +13,69 @@ -- Portability : portable -- -- Framework-agnostic pagination boilerplate. - -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE RecordWildCards #-} - module Data.Pagination ( -- * Pagination settings - Pagination - , mkPagination - , pageSize - , pageIndex + Pagination, + mkPagination, + pageSize, + pageIndex, + -- * Paginated data - , Paginated - , paginate - , paginatedItems - , paginatedPagination - , paginatedPagesTotal - , paginatedItemsTotal - , hasOtherPages - , pageRange - , hasPrevPage - , hasNextPage - , backwardEllip - , forwardEllip + Paginated, + paginate, + paginatedItems, + paginatedPagination, + paginatedPagesTotal, + paginatedItemsTotal, + hasOtherPages, + pageRange, + hasPrevPage, + hasNextPage, + backwardEllip, + forwardEllip, + -- * Exceptions - , PaginationException (..) ) + PaginationException (..), + ) where import Control.DeepSeq import Control.Monad.Catch import Data.Data (Data) import Data.List.NonEmpty (NonEmpty (..)) +import qualified Data.List.NonEmpty as NE import Data.Typeable (Typeable) import GHC.Generics import Numeric.Natural -import qualified Data.List.NonEmpty as NE ---------------------------------------------------------------------------- -- Pagination settings -- | Settings that are required to organize data in paginated form. - data Pagination = Pagination Natural Natural deriving (Eq, Show, Data, Typeable, Generic) instance NFData Pagination -- | Create a 'Pagination' value. May throw 'PaginationException'. - -mkPagination :: MonadThrow m - => Natural -- ^ Page size - -> Natural -- ^ Page index - -> m Pagination -- ^ The pagination settings +mkPagination :: + MonadThrow m => + -- | Page size + Natural -> + -- | Page index + Natural -> + -- | The pagination settings + m Pagination mkPagination size index - | size == 0 = throwM ZeroPageSize + | size == 0 = throwM ZeroPageSize | index == 0 = throwM ZeroPageIndex - | otherwise = return (Pagination size index) + | otherwise = return (Pagination size index) -- | Get page size (maximum number of items on a page) from a 'Pagination'. - pageSize :: Pagination -> Natural pageSize (Pagination size _) = size -- | Get page index from a 'Pagination'. - pageIndex :: Pagination -> Natural pageIndex (Pagination _ index) = index @@ -81,13 +83,13 @@ -- Paginated data -- | Data in the paginated form. - data Paginated a = Paginated - { pgItems :: [a] - , pgPagination :: Pagination - , pgPagesTotal :: Natural - , pgItemsTotal :: Natural - } deriving (Eq, Show, Data, Typeable, Generic, Functor) + { pgItems :: [a], + pgPagination :: Pagination, + pgPagesTotal :: Natural, + pgItemsTotal :: Natural + } + deriving (Eq, Show, Data, Typeable, Generic, Functor) instance NFData a => NFData (Paginated a) @@ -96,111 +98,117 @@ instance Traversable Paginated where traverse f p = - let g p' xs = p' { pgItems = xs } - in g p <$> traverse f (pgItems p) + let g p' xs = p' {pgItems = xs} + in g p <$> traverse f (pgItems p) -- | Create paginated data. - -paginate :: (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 +paginate :: + (Functor m, Integral n) => + -- | Pagination options + Pagination -> + -- | Total number of items + Natural -> + -- | The element producing callback. The function takes arguments: + -- offset and limit. + (n -> n -> m [a]) -> + -- | The paginated data + m (Paginated a) paginate (Pagination size index') totalItems f = r <$> f (fromIntegral offset) (fromIntegral size) where - r xs = Paginated - { pgItems = xs - , pgPagination = Pagination size index - , pgPagesTotal = totalPages - , pgItemsTotal = totalItems } + r xs = + Paginated + { pgItems = xs, + pgPagination = Pagination size index, + pgPagesTotal = totalPages, + pgItemsTotal = totalItems + } (whole, rems) = totalItems `quotRem` size - totalPages = max 1 (whole + if rems == 0 then 0 else 1) - index = min index' totalPages - offset = (index - 1) * size + totalPages = max 1 (whole + if rems == 0 then 0 else 1) + index = min index' totalPages + offset = (index - 1) * size -- | Get subset of items for current page. - paginatedItems :: Paginated a -> [a] paginatedItems = pgItems -- | Get 'Pagination' parameters that were used to create this paginated -- result. - paginatedPagination :: Paginated a -> Pagination paginatedPagination = pgPagination -- | Get the total number of pages in this collection. - paginatedPagesTotal :: Paginated a -> Natural paginatedPagesTotal = pgPagesTotal -- | Get the total number of items in this collection. - paginatedItemsTotal :: Paginated a -> Natural paginatedItemsTotal = pgItemsTotal -- | Test whether there are other pages. - hasOtherPages :: Paginated a -> Bool hasOtherPages Paginated {..} = pgPagesTotal > 1 -- | Is there previous page? - hasPrevPage :: Paginated a -> Bool hasPrevPage Paginated {..} = pageIndex pgPagination > 1 -- | Is there next page? - hasNextPage :: Paginated a -> Bool hasNextPage Paginated {..} = pageIndex pgPagination < pgPagesTotal -- | 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. - -pageRange - :: Paginated a -- ^ Paginated data - -> Natural -- ^ Number of pages to show before and after - -> NonEmpty Natural -- ^ Page range +pageRange :: + -- | Paginated data + Paginated a -> + -- | Number of pages to show before and after + Natural -> + -- | Page range + NonEmpty Natural pageRange Paginated {..} 0 = NE.fromList [pageIndex pgPagination] pageRange Paginated {..} n = - let len = min pgPagesTotal (n * 2 + 1) + 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] + shift + | index <= n = 0 + | index >= pgPagesTotal - n = pgPagesTotal - len + | otherwise = index - n - 1 + in (+ shift) <$> NE.fromList [1 .. len] -- | Backward ellipsis appears when page range (pages around current page to -- jump to) has gap between its beginning and the first page. - -backwardEllip - :: Paginated a -- ^ Paginated data - -> Natural -- ^ Number of pages to show before and after - -> Bool +backwardEllip :: + -- | Paginated data + Paginated a -> + -- | Number of pages to show before and after + Natural -> + Bool backwardEllip p n = NE.head (pageRange p n) > 2 -- | Forward ellipsis appears when page range (pages around current page to -- jump to) has gap between its end and the last page. - -forwardEllip - :: Paginated a -- ^ Paginated data - -> Natural -- ^ Number of pages to show before and after - -> Bool -- ^ Do we have forward ellipsis? +forwardEllip :: + -- | Paginated data + Paginated a -> + -- | Number of pages to show before and after + Natural -> + -- | Do we have forward ellipsis? + Bool forwardEllip p@Paginated {..} n = NE.last (pageRange p n) < pred pgPagesTotal ---------------------------------------------------------------------------- -- Exceptions -- | Exception indicating various problems when working with paginated data. - data PaginationException - = ZeroPageSize -- ^ Page size (number of items per page) was zero - | ZeroPageIndex -- ^ Page index was zero (they start from one) + = -- | Page size (number of items per page) was zero + ZeroPageSize + | -- | Page index was zero (they start from one) + ZeroPageIndex deriving (Eq, Show, Data, Typeable, Generic) instance NFData PaginationException + instance Exception PaginationException diff --git a/LICENSE.md b/LICENSE.md --- a/LICENSE.md +++ b/LICENSE.md @@ -1,4 +1,4 @@ -Copyright © 2016–2017 Mark Karpov +Copyright © 2016–present Mark Karpov All rights reserved. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -4,13 +4,19 @@ [![Hackage](https://img.shields.io/hackage/v/pagination.svg?style=flat)](https://hackage.haskell.org/package/pagination) [![Stackage Nightly](http://stackage.org/package/pagination/badge/nightly)](http://stackage.org/nightly/package/pagination) [![Stackage LTS](http://stackage.org/package/pagination/badge/lts)](http://stackage.org/lts/package/pagination) -[![Build Status](https://travis-ci.org/mrkkrp/pagination.svg?branch=master)](https://travis-ci.org/mrkkrp/pagination) -[![Coverage Status](https://coveralls.io/repos/mrkkrp/pagination/badge.svg?branch=master&service=github)](https://coveralls.io/github/mrkkrp/pagination?branch=master) +![CI](https://github.com/mrkkrp/pagination/workflows/CI/badge.svg?branch=master) The package implements pagination boilerplate in a framework-agnostic way. +## Contribution + +Issues, bugs, and questions may be reported in [the GitHub issue tracker for +this project](https://github.com/mrkkrp/pagination/issues). + +Pull requests are also welcome. + ## License -Copyright © 2016–2017 Mark Karpov +Copyright © 2016–present Mark Karpov Distributed under BSD 3 clause license. diff --git a/pagination.cabal b/pagination.cabal --- a/pagination.cabal +++ b/pagination.cabal @@ -1,58 +1,63 @@ -name: pagination -version: 0.2.1 -cabal-version: >= 1.18 -tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.1 -license: BSD3 -license-file: LICENSE.md -author: Mark Karpov -maintainer: Mark Karpov -homepage: https://github.com/mrkkrp/pagination -bug-reports: https://github.com/mrkkrp/pagination/issues -category: Data -synopsis: Framework-agnostic pagination boilerplate -build-type: Simple -description: Framework-agnostic pagination boilerplate. -extra-doc-files: CHANGELOG.md - , README.md +cabal-version: 1.18 +name: pagination +version: 0.2.2 +license: BSD3 +license-file: LICENSE.md +maintainer: Mark Karpov +author: Mark Karpov +tested-with: ghc ==8.8.4 ghc ==8.10.4 ghc ==9.0.1 +homepage: https://github.com/mrkkrp/pagination +bug-reports: https://github.com/mrkkrp/pagination/issues +synopsis: Framework-agnostic pagination boilerplate +description: Framework-agnostic pagination boilerplate. +category: Data +build-type: Simple +extra-doc-files: + CHANGELOG.md + README.md source-repository head - type: git - location: https://github.com/mrkkrp/pagination.git + type: git + location: https://github.com/mrkkrp/pagination.git flag dev - description: Turn on development settings. - manual: True - default: False + description: Turn on development settings. + default: False + manual: True library - build-depends: base >= 4.8 && < 5.0 - , deepseq >= 1.3 && < 1.5 - , exceptions >= 0.6 && < 0.9 + exposed-modules: Data.Pagination + default-language: Haskell2010 + build-depends: + base >=4.13 && <5.0, + deepseq >=1.3 && <1.5, + exceptions >=0.6 && <0.11 - if !impl(ghc >= 8.0) - build-depends: semigroups == 0.18.* + if flag(dev) + ghc-options: -Wall -Werror - exposed-modules: Data.Pagination - if flag(dev) - ghc-options: -Wall -Werror - else - ghc-options: -O2 -Wall - default-language: Haskell2010 + else + ghc-options: -O2 -Wall + if flag(dev) + ghc-options: + -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns + -Wnoncanonical-monad-instances + test-suite tests - main-is: Main.hs - hs-source-dirs: tests - type: exitcode-stdio-1.0 - build-depends: base >= 4.8 && < 5.0 - , QuickCheck >= 2.4 && < 3.0 - , exceptions >= 0.6 && < 0.9 - , hspec >= 2.0 && < 3.0 - , pagination + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: tests + default-language: Haskell2010 + build-depends: + base >=4.13 && <5.0, + QuickCheck >=2.10 && <3.0, + exceptions >=0.6 && <0.11, + hspec >=2.0 && <3.0, + pagination - if !impl(ghc >= 8.0) - build-depends: semigroups == 0.18.* - if flag(dev) - ghc-options: -Wall -Werror - else - ghc-options: -O2 -Wall - default-language: Haskell2010 + if flag(dev) + ghc-options: -Wall -Werror + + else + ghc-options: -O2 -Wall diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -1,18 +1,17 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RankNTypes #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Main (main) where import Control.Monad -import Control.Monad.Catch (MonadThrow (..), fromException) +import Control.Monad.Catch (SomeException, fromException) import Data.List.NonEmpty (NonEmpty (..)) +import qualified Data.List.NonEmpty as NE import Data.Maybe (fromJust) import Data.Pagination import Numeric.Natural import Test.Hspec import Test.QuickCheck hiding (total) -import qualified Data.List.NonEmpty as NE main :: IO () main = hspec spec @@ -33,20 +32,20 @@ property $ \size index -> (size > 0 && index > 0) ==> do p <- mkPagination size index - pageSize p `shouldBe` size + pageSize p `shouldBe` size pageIndex p `shouldBe` index describe "Functor instance of Paginated" $ it "works" $ property $ \r -> let f :: Int -> Int f = (+ 1) - in paginatedItems (f <$> r) === (f <$> paginatedItems r) + in paginatedItems (f <$> r) === (f <$> paginatedItems r) describe "Foldable instance of Paginated" $ it "foldr works like with lists" $ property $ \p n -> let f :: Foldable f => f Int -> Int f = foldr (+) n - in f p === f (paginatedItems p) + in f p === f (paginatedItems p) describe "Traversable instance of Paginated" $ it "traverse works like with lists" $ property $ \p -> @@ -57,43 +56,44 @@ it "produces an empty pagination" $ property $ \p n -> do r <- paginate p 0 $ \offset limit -> do - offset `shouldBe` 0 - limit `shouldBe` pageSize p - return [] - paginatedItems r `shouldBe` ([] :: [Int]) + offset `shouldBe` 0 + limit `shouldBe` pageSize p + return [] + paginatedItems r `shouldBe` ([] :: [Int]) (pageSize . paginatedPagination) r `shouldBe` pageSize p (pageIndex . paginatedPagination) r `shouldBe` 1 paginatedPagesTotal r `shouldBe` 1 paginatedItemsTotal r `shouldBe` 0 - pageRange r n `shouldBe` 1 :| [] - hasOtherPages r `shouldBe` False - hasPrevPage r `shouldBe` False - hasNextPage r `shouldBe` False - backwardEllip r n `shouldBe` False - forwardEllip r n `shouldBe` False + pageRange r n `shouldBe` 1 :| [] + hasOtherPages r `shouldBe` False + hasPrevPage r `shouldBe` False + hasNextPage r `shouldBe` False + backwardEllip r n `shouldBe` False + forwardEllip r n `shouldBe` False describe "paginatedItems" $ it "number of actual items is less than or equal to page size" $ property $ \r -> let size = pageSize (paginatedPagination (r :: Paginated Int)) - in (fromIntegral . length . paginatedItems) r `shouldSatisfy` (<= size) + in (fromIntegral . length . paginatedItems) r `shouldSatisfy` (<= size) describe "paginatedPagination" $ it "returns original pagination correcting index if necessary" $ property $ \p n -> do r <- paginate p n $ \offset limit -> do - let totalPages = ptotal n (pageSize p) - offset `shouldBe` - min ((pageIndex p - 1) * pageSize p) - ((totalPages - 1) * pageSize p) - limit `shouldBe` pageSize p - return (replicate (plen n offset limit) (0 :: Int)) - pageSize (paginatedPagination r) `shouldBe` pageSize p + let totalPages = ptotal n (pageSize p) + offset + `shouldBe` min + ((pageIndex p - 1) * pageSize p) + ((totalPages - 1) * pageSize p) + limit `shouldBe` pageSize p + return (replicate (plen n offset limit) (0 :: Int)) + pageSize (paginatedPagination r) `shouldBe` pageSize p pageIndex (paginatedPagination r) `shouldSatisfy` (<= pageIndex p) describe "paginatedPagesTotal" $ it "returns correct number of total pages" $ property $ \r -> let itemsTotal = paginatedItemsTotal (r :: Paginated Int) - psize = pageSize (paginatedPagination r) - in paginatedPagesTotal r `shouldBe` ptotal itemsTotal psize + psize = pageSize (paginatedPagination r) + in paginatedPagesTotal r `shouldBe` ptotal itemsTotal psize describe "paginatedItemsTotal" $ it "returns the same number of items as it was specified for paginate" $ property $ \p n -> do @@ -106,60 +106,60 @@ describe "hasPrevPage" $ it "correctly detect whether paginated data has previous page" $ property $ \r -> - hasPrevPage (r :: Paginated Int) === - (pageIndex (paginatedPagination r) /= 1) + hasPrevPage (r :: Paginated Int) + === (pageIndex (paginatedPagination r) /= 1) describe "hasNextPage" $ it "correctly detect whether paginated data has next page" $ property $ \r -> - hasNextPage (r :: Paginated Int) === - (pageIndex (paginatedPagination r) /= paginatedPagesTotal r) + hasNextPage (r :: Paginated Int) + === (pageIndex (paginatedPagination r) /= paginatedPagesTotal r) describe "pageRange" $ it "correctly performs generation of page ranges" $ - forM_ [1..10] $ \n -> do - p <- mkPagination 10 n - r <- paginate p 95 (\_ limit -> return [1..limit]) - let x = NE.toList (pageRange (r :: Paginated Int) 2) - x `shouldBe` case n of - 1 -> [1..5] - 2 -> [1..5] - 3 -> [1..5] - 4 -> [2..6] - 5 -> [3..7] - 6 -> [4..8] - 7 -> [5..9] - 8 -> [6..10] - 9 -> [6..10] - _ -> [6..10] + forM_ [1 .. 10] $ + \n -> do + p <- mkPagination 10 n + r <- paginate p 95 (\_ limit -> return [1 .. limit]) + let x = NE.toList (pageRange (r :: Paginated Int) 2) + x `shouldBe` case n of + 1 -> [1 .. 5] + 2 -> [1 .. 5] + 3 -> [1 .. 5] + 4 -> [2 .. 6] + 5 -> [3 .. 7] + 6 -> [4 .. 8] + 7 -> [5 .. 9] + 8 -> [6 .. 10] + 9 -> [6 .. 10] + _ -> [6 .. 10] describe "backwardEllip" $ it "correctly detects when there is a backward ellipsis" $ property $ \r n -> - backwardEllip (r :: Paginated Int) n === - (NE.head (pageRange r n) > 2) + backwardEllip (r :: Paginated Int) n + === (NE.head (pageRange r n) > 2) describe "forwardEllip" $ it "correctly detects when there is a forward ellipsis" $ property $ \r n -> - forwardEllip (r :: Paginated Int) n === - (NE.last (pageRange r n) < paginatedPagesTotal r - 1) + forwardEllip (r :: Paginated Int) n + === (NE.last (pageRange r n) < paginatedPagesTotal r - 1) ---------------------------------------------------------------------------- -- Arbitrary instances -#if MIN_VERSION_QuickCheck(2,10,0) instance Arbitrary Natural where arbitrary = fromInteger . getNonNegative <$> arbitrary -#endif instance Arbitrary Pagination where arbitrary = do - size <- p + size <- p index <- p (return . fromJust) (mkPagination size index) - where p = arbitrary `suchThat` (> 0) + where + p = arbitrary `suchThat` (> 0) instance Arbitrary a => Arbitrary (Paginated a) where arbitrary = do pagination <- arbitrary - total <- arbitrary + total <- arbitrary let f offset limit = vector (plen total offset limit) paginate pagination total f @@ -167,27 +167,32 @@ -- Helpers -- | Run computation inside 'MonadThrow' and return result as an 'Either'. - -asEither :: (forall m. MonadThrow m => m a) -> Either PaginationException a +asEither :: Either SomeException a -> Either PaginationException a asEither = either (Left . fromJust . fromException) Right -- | Calculate number of items in paginated selection given total number of -- items, offset, and limit. - -plen :: Integral n - => Natural -- ^ Total items - -> Natural -- ^ Offset - -> Natural -- ^ Limit - -> n +plen :: + Integral n => + -- | Total items + Natural -> + -- | Offset + Natural -> + -- | Limit + Natural -> + n plen total offset limit = fromIntegral (min (total - offset) limit) -- | Calculate total number of pages given total number of items, and page -- size. - -ptotal :: Integral n - => Natural -- ^ Total items - -> Natural -- ^ Page size - -> n -ptotal total size = fromIntegral $ - let (whole, rems) = total `quotRem` size - in max 1 (whole + if rems == 0 then 0 else 1) +ptotal :: + Integral n => + -- | Total items + Natural -> + -- | Page size + Natural -> + n +ptotal total size = + fromIntegral $ + let (whole, rems) = total `quotRem` size + in max 1 (whole + if rems == 0 then 0 else 1)