pagination (empty) → 0.1.0

raw patch · 7 files changed

+595/−0 lines, 7 filesdep +QuickCheckdep +basedep +deepseqsetup-changed

Dependencies added: QuickCheck, base, deepseq, exceptions, hspec, pagination, semigroups

Files

CHANGELOG.md +3/−0
Data/Pagination.hs +223/−0
LICENSE.md +28/−0
README.md +16/−0
Setup.hs +6/−0
pagination.cabal +89/−0
tests/Main.hs +230/−0

+ CHANGELOG.md view

@@ -0,0 +1,3 @@+## Pagination 0.1.0++* Initial release.

@@ -0,0 +1,223 @@+-- |+-- Module      :  Data.Pagination+-- Copyright   :  © 2016 Mark Karpov+-- License     :  BSD 3 clause+--+-- Maintainer  :  Mark Karpov <markkarpov@openmailbox.org>+-- 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

+ LICENSE.md view

@@ -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.

+ README.md view

@@ -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.

+ Setup.hs view

@@ -0,0 +1,6 @@+module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMain

+ pagination.cabal view

@@ -0,0 +1,89 @@+--+-- Cabal configuration for ‘pagination’ package.+--+-- Copyright © 2016 Mark Karpov <markkarpov@openmailbox.org>+--+-- 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 <markkarpov@openmailbox.org>+maintainer:           Mark Karpov <markkarpov@openmailbox.org>+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

+ tests/Main.hs view

@@ -0,0 +1,230 @@+--+-- Tests for the ‘pagination’ package.+--+-- Copyright © 2016 Mark Karpov <markkarpov@openmailbox.org>+--+-- 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)