diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,3 @@ +## Pagination 0.1.0 + +* Initial release. diff --git a/Data/Pagination.hs b/Data/Pagination.hs new file mode 100644 --- /dev/null +++ b/Data/Pagination.hs @@ -0,0 +1,223 @@ +-- | +-- Module : Data.Pagination +-- Copyright : © 2016 Mark Karpov +-- License : BSD 3 clause +-- +-- Maintainer : Mark Karpov +-- Stability : experimental +-- Portability : portable +-- +-- Framework-agnostic pagination boilerplate. + +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE RecordWildCards #-} + +module Data.Pagination + ( -- * Pagination settings + Pagination + , mkPagination + , pageSize + , pageIndex + -- * Paginated data + , Paginated + , paginate + , paginatedItems + , paginatedPagination + , paginatedPagesTotal + , paginatedItemsTotal + , hasOtherPages + , pageRange + , hasPrevPage + , hasNextPage + , backwardEllip + , forwardEllip + -- * Exceptions + , 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 + +---------------------------------------------------------------------------- +-- Pagination settings + +-- | The data type represents 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. Throws 'PaginationException'. + +mkPagination :: MonadThrow m + => Natural -- ^ Page size + -> Natural -- ^ Page index + -> m Pagination -- ^ The pagination settings +mkPagination size index + | size == 0 = throwM ZeroPageSize + | index == 0 = throwM ZeroPageIndex + | 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 +{-# INLINE pageSize #-} + +-- | Get page index from a 'Pagination'. + +pageIndex :: Pagination -> Natural +pageIndex (Pagination _ index) = index +{-# INLINE pageIndex #-} + +---------------------------------------------------------------------------- +-- Paginated data + +-- | Data in paginated form. + +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) + +-- | Create paginated data. + +paginate :: (Monad 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 (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 + +-- | Get subset of items for current page. + +paginatedItems :: Paginated a -> [a] +paginatedItems = pgItems +{-# INLINE paginatedItems #-} + +-- | Get 'Pagination' parameters that were used to create this paginated result. + +paginatedPagination :: Paginated a -> Pagination +paginatedPagination = pgPagination +{-# INLINE paginatedPagination #-} + +-- | Get total number of pages in this collection. + +paginatedPagesTotal :: Paginated a -> Natural +paginatedPagesTotal = pgPagesTotal +{-# INLINE paginatedPagesTotal #-} + +-- | Get total number of items in this collection. + +paginatedItemsTotal :: Paginated a -> Natural +paginatedItemsTotal = pgItemsTotal +{-# INLINE paginatedItemsTotal #-} + +-- | Test whether there are other pages. + +hasOtherPages :: Paginated a -> Bool +hasOtherPages Paginated {..} = pgPagesTotal > 1 +{-# INLINE hasOtherPages #-} + +-- | Is there previous page? + +hasPrevPage :: Paginated a -> Bool +hasPrevPage Paginated {..} = pageIndex pgPagination > (1 :: Natural) +{-# INLINE hasPrevPage #-} + +-- | Is there next page? + +hasNextPage :: Paginated a -> Bool +hasNextPage Paginated {..} = pageIndex pgPagination < pgPagesTotal +{-# INLINE hasNextPage #-} + +-- | Get range of pages to show before and after 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 {..} 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] + +-- | 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 p n = NE.head (pageRange p n) > 2 +{-# INLINE backwardEllip #-} + +-- | 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 p@Paginated {..} n = NE.last (pageRange p n) < pred pgPagesTotal +{-# INLINE forwardEllip #-} + +---------------------------------------------------------------------------- +-- 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) + deriving (Eq, Show, Data, Typeable, Generic) + +instance NFData PaginationException +instance Exception PaginationException diff --git a/LICENSE.md b/LICENSE.md new file mode 100644 --- /dev/null +++ b/LICENSE.md @@ -0,0 +1,28 @@ +Copyright © 2016 Mark Karpov + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +* Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + +* Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +* Neither the name Mark Karpov nor the names of contributors may be used to + endorse or promote products derived from this software without specific + prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY EXPRESS +OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES +OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN +NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, +INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, +OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, +EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,16 @@ +# Pagination + +[![License BSD3](https://img.shields.io/badge/license-BSD3-brightgreen.svg)](http://opensource.org/licenses/BSD-3-Clause) +[![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) + +The package implements pagination boilerplate in framework-agnostic way. + +## License + +Copyright © 2016 Mark Karpov + +Distributed under BSD 3 clause license. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,6 @@ +module Main (main) where + +import Distribution.Simple + +main :: IO () +main = defaultMain diff --git a/pagination.cabal b/pagination.cabal new file mode 100644 --- /dev/null +++ b/pagination.cabal @@ -0,0 +1,89 @@ +-- +-- Cabal configuration for ‘pagination’ package. +-- +-- Copyright © 2016 Mark Karpov +-- +-- Redistribution and use in source and binary forms, with or without +-- modification, are permitted provided that the following conditions are +-- met: +-- +-- * Redistributions of source code must retain the above copyright notice, +-- this list of conditions and the following disclaimer. +-- +-- * Redistributions in binary form must reproduce the above copyright +-- notice, this list of conditions and the following disclaimer in the +-- documentation and/or other materials provided with the distribution. +-- +-- * Neither the name Mark Karpov nor the names of contributors may be used +-- to endorse or promote products derived from this software without +-- specific prior written permission. +-- +-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY +-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY +-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +-- POSSIBILITY OF SUCH DAMAGE. + +name: pagination +version: 0.1.0 +cabal-version: >= 1.10 +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-source-files: CHANGELOG.md + , README.md + +source-repository head + type: git + location: https://github.com/mrkkrp/pagination.git + +flag dev + description: Turn on development settings. + manual: True + default: False + +library + build-depends: base >= 4.8 && < 5.0 + , deepseq >= 1.3 && < 1.5 + , exceptions >= 0.6 && < 0.9 + + if !impl(ghc >= 8.0) + build-depends: semigroups == 0.18.* + + exposed-modules: Data.Pagination + if flag(dev) + ghc-options: -Wall -Werror + else + ghc-options: -O2 -Wall + default-language: Haskell2010 + +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 >= 0.1.0 + + 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 diff --git a/tests/Main.hs b/tests/Main.hs new file mode 100644 --- /dev/null +++ b/tests/Main.hs @@ -0,0 +1,230 @@ +-- +-- Tests for the ‘pagination’ package. +-- +-- Copyright © 2016 Mark Karpov +-- +-- Redistribution and use in source and binary forms, with or without +-- modification, are permitted provided that the following conditions are +-- met: +-- +-- * Redistributions of source code must retain the above copyright notice, +-- this list of conditions and the following disclaimer. +-- +-- * Redistributions in binary form must reproduce the above copyright +-- notice, this list of conditions and the following disclaimer in the +-- documentation and/or other materials provided with the distribution. +-- +-- * Neither the name Mark Karpov nor the names of contributors may be used +-- to endorse or promote products derived from this software without +-- specific prior written permission. +-- +-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY +-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY +-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +-- POSSIBILITY OF SUCH DAMAGE. + +{-# LANGUAGE RankNTypes #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Main (main) where + +import Control.Monad +import Control.Monad.Catch (MonadThrow (..), fromException) +import Data.List.NonEmpty (NonEmpty (..)) +import Data.Maybe (fromJust) +import Data.Pagination +import Numeric.Natural +import Test.Hspec +import Test.QuickCheck +import qualified Data.List.NonEmpty as NE + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + describe "mkPagination" $ do + context "when page size is zero" $ + it "throws ZeroPageSize exception" $ + property $ \index -> + asEither (mkPagination 0 index) === Left ZeroPageSize + context "when page index in zero" $ + it "throws ZeroPageIndex exception" $ + property $ \size -> + size > 0 ==> asEither (mkPagination size 0) === Left ZeroPageIndex + context "when page size and page index are positive" $ + it "we get the Pagination value" $ + property $ \size index -> + (size > 0 && index > 0) ==> do + p <- mkPagination size index + 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) + describe "Applicative instance of Paginated" $ do + it "constructs the right pure Paginated value" $ do + p <- mkPagination 1 1 + r <- paginate p 1 ((\_ _ -> return [1]) :: Int -> Int -> IO [Int]) + pure (1 :: Int) `shouldBe` r + it "the (<*>) operator works like with lists" $ + property $ \r0 r1 -> + let f :: Int -> Int -> Int + f = (*) + in paginatedItems (f <$> r0 <*> r1) === + (f <$> paginatedItems r0 <*> paginatedItems r1) + 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) + describe "Traversable instance of Paginated" $ + it "traverse works like with lists" $ + property $ \p -> + (paginatedItems <$> traverse Just (p :: Paginated Int)) + === Just (paginatedItems p) + describe "paginate" $ + context "when total number of items is zero" $ + 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]) + (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 + 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) + 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 + 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 + describe "paginatedItemsTotal" $ + it "returns the same number of items as it was specified for paginate" $ + property $ \p n -> do + r <- paginate p n ((\_ _ -> return []) :: Int -> Int -> IO [Int]) + paginatedItemsTotal r `shouldBe` n + describe "hasOtherPages" $ + it "correctly detects whether we the collection has other pages" $ + property $ \r -> + hasOtherPages (r :: Paginated Int) `shouldBe` paginatedPagesTotal r > 1 + describe "hasPrevPage" $ + it "correctly detect whether paginated data has previous page" $ + property $ \r -> + 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) + 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] + 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) + 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) + +---------------------------------------------------------------------------- +-- Arbitrary instances + +instance Arbitrary Pagination where + arbitrary = do + size <- p + index <- p + (return . fromJust) (mkPagination size index) + where p = arbitrary `suchThat` (> 0) + +instance Arbitrary a => Arbitrary (Paginated a) where + arbitrary = do + pagination <- arbitrary + total <- arbitrary + let f offset limit = vector (plen total offset limit) + paginate pagination total f + +---------------------------------------------------------------------------- +-- Helpers + +-- | Run computation inside 'MonadThrow' and return result as an 'Either'. + +asEither :: (forall m. MonadThrow m => m 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 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)