persistent-pagination (empty) → 0.1.0.0
raw patch · 8 files changed
+646/−0 lines, 8 filesdep +QuickCheckdep +basedep +conduitsetup-changed
Dependencies added: QuickCheck, base, conduit, containers, foldl, hspec, hspec-discover, microlens, mtl, persistent, persistent-pagination, persistent-sqlite, persistent-template, time
Files
- ChangeLog.md +3/−0
- LICENSE +30/−0
- README.md +57/−0
- Setup.hs +2/−0
- persistent-pagination.cabal +64/−0
- src/Database/Persist/Pagination.hs +295/−0
- test/Database/Persist/PaginationSpec.hs +194/−0
- test/Spec.hs +1/−0
+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for persistent-pagination++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Matt Parsons (c) 2019++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 of Matt Parsons nor the names of other+ 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 AND CONTRIBUTORS+"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+OWNER OR CONTRIBUTORS 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,57 @@+# persistent-pagination++[](https://travis-ci.org/parsonsmatt/persistent-pagination) ++A library that provides Correct pagination behavior.++# Why not use `LIMIT/OFFSET`?++Ok so here's the thing.++`LIMIT/OFFSET` is bad.+When you do a query that has a limit and an offset, the database server must process *the entire query* up to the `LIMIT + OFFSET`.+If you have `LIMIT 50 OFFSET 150`, then the database has to load all 200 rows, then drop the first 150.+So as you page through your database, you're loading more and more data.+Eventually, to reach the last page of data, the database is forced to load the entire result set before it can start pruning it down to the last bit.++As far as the database is concerned, it's exactly the same amount of work to deliver the entire dang dataset as it is to deliver the last page of the dataset!++[Here's a good article explaining more](https://use-the-index-luke.com/sql/partial-results/fetch-next-page).++# But I don't care about performance++Well, correctness is a problem with `LIMIT/OFFSET` too.+You might receive rows multiple times, and you might receive some rows not-at-all.+It comes down to how your data is ordered.++How is your data ordered?+If you don't specify a sort order, it's probably taking the primary key.+However, if you don't specify a sort order, then the order is totally non-deterministic!+There's nothing stopping your database server from returning a different ordering on two different "pages" of a query.+If you expect that you'll be processing each row in your database exactly once, then this can throw a wrench into things.++We need to provide an `ORDER BY` clause when we're paginating, or we'll get these problems.++If someone inserts into or deletes data from your database while you're paging through the data, then you may skip rows or get duplicate rows again.++# The Ideal Pagination++- `ORDER BY` an column+- That column should be immutable and monotonic - the ideal column for this is a `created` timestamp.+- That column should have an index+- Instead of talking about "pages", we talk about "ranges"++This requires a slightly different way of thinking about pagination.+Instead of saying "Give me page 6 of this query," we're going to say:++> I want all the rows with a `$COLUMN` value at least `X` and at most `Y` in chunks of 50.++The server is going to respond with:++> Here's 50 rows starting at `X` and ending at `Z`.++The next request we make will say:++> I want all the rows with a `$COLUMN` value at least `Z` and at most `Y` in chunks of 50.++And the server will continue giving results, until there are less than `50` rows in the response, at which point we've "run out" of rows satisfying the range.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ persistent-pagination.cabal view
@@ -0,0 +1,64 @@+cabal-version: 1.12++name: persistent-pagination+version: 0.1.0.0+synopsis: Efficient and correct pagination for persistent queries.+description: Please see the README on GitHub at <https://github.com/parsonsmatt/persistent-pagination#readme>+homepage: https://github.com/parsonsmatt/persistent-pagination#readme+bug-reports: https://github.com/parsonsmatt/persistent-pagination/issues+author: Matt Parsons+maintainer: parsonsmattt@gmail.com+copyright: 2019 Matt Parsons+license: BSD3+license-file: LICENSE+build-type: Simple+category: Database+extra-source-files:+ README.md+ ChangeLog.md++source-repository head+ type: git+ location: https://github.com/parsonsmatt/persistent-pagination++library+ exposed-modules:+ Database.Persist.Pagination+ other-modules:+ Paths_persistent_pagination+ hs-source-dirs:+ src+ build-depends:+ base >= 4.11 && < 5+ , persistent >= 2 && < 3.0+ , conduit >= 1.2.8 && < 1.4+ , mtl < 3+ , foldl < 1.5.0+ , microlens < 0.5+ default-language: Haskell2010+ ghc-options:+ -Wall++test-suite persistent-pagination-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Paths_persistent_pagination+ Database.Persist.PaginationSpec+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.7 && <5+ , persistent-pagination+ , persistent+ , persistent-sqlite+ , persistent-template+ , hspec+ , time+ , hspec-discover+ , QuickCheck+ , conduit+ , containers+ , mtl+ default-language: Haskell2010
+ src/Database/Persist/Pagination.hs view
@@ -0,0 +1,295 @@+{-# LANGUAGE ApplicativeDo #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | This module provides efficient pagination over your database queries.+-- No @OFFSET@ here - we use ranges to do this right!+--+-- The ideal "range" column for a datatype has a few properties:+--+-- 1. It should have an index. An index on the column will dramatically+-- improve performance on pagination.+-- 2. It should be monotonic - that is, we shouldn't be able to insert new+-- data into the middle of a range. An example would be a @created_at@+-- timestamp field, or a auto-incrementing primary key.+--+-- This module offers two ways to page through a database. You can use the+-- 'streamingEntities' to get a 'ConduitT' of @'Entity' record@ values+-- streaming out. Or, if you'd like finer control, you can use 'getPage'+-- to get the first page of data, and then 'nextPage' to get the next+-- possible page of data.+module Database.Persist.Pagination where++import Conduit+import Control.Applicative+import qualified Control.Foldl as Foldl+import Control.Monad.Reader (ReaderT)+import Data.Foldable (toList, forM_)+import Data.Maybe+import Data.Semigroup+import Database.Persist.Class+import Database.Persist.Sql+import Lens.Micro++-- | Stream entities out of the database, only pulling a limited amount+-- into memory at a time.+--+-- You should use this instead of 'selectSource' because 'selectSource'+-- doesn't really work. It doesn't work at all in MySQL, and it's somewhat+-- sketchy with PostgreSQL and SQLite. This function is guaranteed to use+-- only as much memory as a single page, and if you tune the page size+-- right, you'll get efficient queries from the database.+--+-- There's an open issue for 'selectSource' not working:+-- <https://github.com/yesodweb/persistent/issues/657 GitHub Issue>.+--+-- @since 0.1.0.0+streamEntities+ :: forall record backend typ m a.+ ( PersistRecordBackend record backend+ , PersistQueryRead backend+ , Ord typ+ , PersistField typ+ , MonadIO m+ )+ => [Filter record]+ -- ^ The filters to apply.+ -> EntityField record typ+ -- ^ The field to sort on. This field should have an index on it, and+ -- ideally, the field should be monotonic - that is, you can only+ -- insert values at either extreme end of the range. A @created_at@+ -- timestamp or autoincremented ID work great for this. Non-monotonic+ -- keys can work too, but you may miss records that are inserted during+ -- a traversal.+ -> PageSize+ -- ^ How many records in a page+ -> SortOrder+ -- ^ Ascending or descending+ -> DesiredRange typ+ -- ^ The desired range. Provide @'Range' Nothing Nothing@ if you want+ -- everything in the database.+ -> ConduitT a (Entity record) (ReaderT backend m) ()+streamEntities filters field pageSize sortOrder range = do+ mpage <- lift (getPage filters field pageSize sortOrder range)+ forM_ mpage loop+ where+ loop page = do+ yieldMany (pageRecords page)+ mpage <- lift (nextPage page)+ forM_ mpage loop++-- | The amount of records in a 'Page' of results.+--+-- @since 0.1.0.0+newtype PageSize = PageSize { unPageSize :: Int }+ deriving (Eq, Show)++-- | Whether to sort by @ASC@ or @DESC@ when you're paging over results.+--+-- @since 0.1.0.0+data SortOrder = Ascend | Descend+ deriving (Eq, Show)++-- | A datatype describing the min and max value of the relevant field that+-- you are ranging over in a non-empty sequence of records.+--+-- @since 0.1.0.0+data Range t = Range { rangeMin :: t, rangeMax :: t }+ deriving (Eq, Show, Functor, Foldable, Traversable)++instance Ord t => Semigroup (Range t) where+ Range l h <> Range l' h' = Range (min l l') (max h h')++instance (Bounded t, Ord t) => Monoid (Range t) where+ mempty = Range minBound maxBound+ mappend = (<>)++-- | Users aren't required to put a value in for the range - a value of+-- 'Nothing' is equivalent to saying "unbounded from below."+--+-- @since 0.1.0.0+type DesiredRange t = Range (Maybe t)++-- | A @'Page' record typ@ describes a list of records and enough+-- information necessary to acquire the next page of records, if possible.+--+-- @since 0.1.0.0+data Page record typ+ = Page+ { pageRecords :: [Entity record]+ -- ^ The collection of records.+ --+ -- @since 0.1.0.0+ , pageRecordCount :: Int+ -- ^ The count of records in the collection. If this number is less+ -- than the 'pageSize' field, then a call to 'nextPage' will result in+ -- 'Nothing'.+ --+ -- @since 0.1.0.0+ , pageRange :: Range typ+ -- ^ The minimum and maximum value of @typ@ in the list.+ --+ -- @since 0.1.0.0+ , pageDesiredRange :: DesiredRange typ+ -- ^ The desired range in the next page of values. When the+ -- 'pageSortOrder' is 'Ascending', then the 'rangeMin' value will+ -- increase with each page until the set of data is complete. Likewise,+ -- when the 'pageSortOrder' is 'Descending', then the 'rangeMax' will+ -- decrease until the final page is reached.+ --+ -- @since 0.1.0.0+ , pageField :: EntityField record typ+ -- ^ The field to sort on. This field should have an index on it, and+ -- ideally, the field should be monotonic - that is, you can only+ -- insert values at either extreme end of the range. A @created_at@+ -- timestamp or autogenerated ID work great for this. Non-monotonic+ -- keys can work too, but you may miss records that are inserted during+ -- a traversal.+ --+ -- @since 0.1.0.0+ , pageFilters :: [Filter record]+ -- ^ The extra filters that are placed on the query.+ --+ -- @since 0.1.0.0+ , pageSize :: PageSize+ -- ^ The desired size of the 'Page' for successive results.+ , pageSortOrder :: SortOrder+ -- ^ Whether to sort on the 'pageField' in 'Ascending' or 'Descending'+ -- order. The choice you make here determines how the+ -- 'pageDesiredRange' changes with each page.+ --+ -- @since 0.1.0.0+ }++-- | Convert a @'DesiredRange' typ@ into a list of 'Filter's for the query.+-- The 'DesiredRange' is treated as an exclusive range.+--+-- @since 0.1.0.0+rangeToFilters+ :: PersistField typ+ => Range (Maybe typ)+ -> EntityField record typ+ -> [Filter record]+rangeToFilters range field =+ fmap (field >.) (toList (rangeMin range))+ +++ fmap (field <.) (toList (rangeMax range))++-- | Get the first 'Page' according to the given criteria. This returns+-- a @'Maybe' 'Page'@, because there may not actually be any records that+-- correspond to the query you issue. You can call 'pageRecords' on the+-- result object to get the row of records for this page, and you can call+-- 'nextPage' with the 'Page' object to get the next page, if one exists.+--+-- This function gives you lower level control over pagination than the+-- 'streamEntities' function.+--+-- @since 0.1.0.0+getPage+ :: forall record backend typ m.+ ( PersistRecordBackend record backend+ , PersistQueryRead backend+ , Ord typ+ , PersistField typ+ , MonadIO m+ )+ => [Filter record]+ -- ^ The filters to apply.+ -> EntityField record typ+ -- ^ The field to sort on. This field should have an index on it, and+ -- ideally, the field should be monotonic - that is, you can only+ -- insert values at either extreme end of the range. A @created_at@+ -- timestamp or autogenerated ID work great for this. Non-monotonic+ -- keys can work too, but you may miss records that are inserted during+ -- a traversal.+ -> PageSize+ -- ^ How many records in a page+ -> SortOrder+ -- ^ Ascending or descending+ -> DesiredRange typ+ -- ^ The desired range. Provide @'Range' Nothing Nothing@ if you want+ -- everything in the database.+ -> ReaderT backend m (Maybe (Page record typ))+getPage filts field pageSize sortOrder desiredRange = do+ erecs <- selectList filters selectOpts+ case erecs of+ [] ->+ pure Nothing+ rec:recs ->+ pure (Just (mkPage rec recs))+ where+ selectOpts =+ LimitTo (unPageSize pageSize) : case sortOrder of+ Ascend -> [Asc field]+ Descend -> [Desc field]+ filters =+ filts <> rangeToFilters desiredRange field+ mkPage rec recs = flip Foldl.fold (rec:recs) $ do+ let recs' = rec : recs+ rangeDefault = initRange rec+ maxRange <- Foldl.premap (Just . Max . (^. fieldLens field)) Foldl.mconcat+ minRange <- Foldl.premap (Just . Min . (^. fieldLens field)) Foldl.mconcat+ len <- Foldl.length+ pure Page+ { pageRecords = recs'+ , pageRange = fromMaybe rangeDefault $+ Range <$> fmap getMin minRange <*> fmap getMax maxRange+ , pageDesiredRange = desiredRange+ , pageField = field+ , pageFilters = filts+ , pageSize = pageSize+ , pageRecordCount = len+ , pageSortOrder = sortOrder+ }+ initRange :: Entity record -> Range typ+ initRange rec =+ Range+ { rangeMin = rec ^. fieldLens field+ , rangeMax = rec ^. fieldLens field+ }++-- | Retrieve the next 'Page' of data, if possible.+--+-- @since 0.1.0.0+nextPage+ ::+ ( PersistRecordBackend record backend+ , PersistQueryRead backend+ , Ord typ+ , PersistField typ+ , MonadIO m+ )+ => Page record typ -> ReaderT backend m (Maybe (Page record typ))+nextPage Page{..}+ | pageRecordCount < unPageSize pageSize =+ pure Nothing+ | otherwise =+ getPage+ pageFilters+ pageField+ pageSize+ pageSortOrder+ (bumpPageRange pageSortOrder pageDesiredRange pageRange)++-- | Modify the 'DesiredRange' according to the 'Range' that was provided+-- by the query and the 'SortOrder'.+--+-- @since 0.1.0.0+bumpPageRange+ :: Ord typ+ => SortOrder+ -> DesiredRange typ+ -> Range typ+ -> DesiredRange typ+bumpPageRange sortOrder (Range mmin mmax) (Range min' max') =+ case sortOrder of+ Ascend ->+ Range (mmin `max` Just max') mmax+ Descend ->+ Range mmin (Just min' <|> (Just min' `min` mmax))
+ test/Database/Persist/PaginationSpec.hs view
@@ -0,0 +1,194 @@+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE OverloadedStrings, MultiParamTypeClasses, GADTs, GeneralizedNewtypeDeriving #-}+module Database.Persist.PaginationSpec where++import Control.Monad.Reader+import qualified Data.Set as Set+import qualified Data.Map as Map+import qualified Data.List as List+import Control.Concurrent+import Conduit+import Data.Maybe+import Control.Monad.IO.Class+import Test.Hspec+import Test.QuickCheck+import Control.Monad+import Database.Persist.TH+import Database.Persist.Sql+import Database.Persist.Sqlite+import Data.Time++import Database.Persist.Pagination++share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistUpperCase|++User+ name String+ age Int+ createdAt UTCTime++ deriving Eq Ord Show+|]++spec :: Spec+spec = do+ it "streamEntities descend" $ do+ xs <- runDb $ do+ runConduit+ $ streamEntities+ []+ UserCreatedAt+ (PageSize 10)+ Descend+ (Range Nothing Nothing)+ .| sinkList+ let sortedKeys = List.sort (map entityKey xs)++ map length (List.group sortedKeys)+ `shouldBe`+ map length (map (:[]) sortedKeys)++ it "streamEntities ascend" $ do+ xs <- runDb $ do+ runConduit+ $ streamEntities+ []+ UserCreatedAt+ (PageSize 10)+ Ascend+ (Range Nothing Nothing)+ .| sinkList+ length xs `shouldBe` entityCount+ Set.toList (Set.fromList (map entityKey xs))+ `shouldBe`+ List.sort (map entityKey xs)++ it "getPage" $ do+ let pgSize = 10+ Just page <- runDb $ do+ getPage [] UserCreatedAt (PageSize pgSize) Ascend (Range Nothing Nothing :: DesiredRange UTCTime)+ let records1 = pageRecords page+ length records1+ `shouldBe`+ pgSize+ pageRecordCount page+ `shouldBe`+ pgSize+ let mmin = rangeMin (pageRange page)++ mpage2 <- runDb $ do+ nextPage page++ void mpage2 `shouldSatisfy` isJust++ let Just page2 = mpage2+ records2 = pageRecords page2++ length records2+ `shouldBe`+ pageRecordCount page2+++ (Set.fromList records1 `Set.intersection` Set.fromList records2)+ `shouldBe` Set.empty++ (Set.fromList (map entityKey records1) `Set.intersection` Set.fromList (map entityKey records2))+ `shouldBe` Set.empty++ it "works for all pages" $ do+ pages <- runDb $ do+ Just page <-+ getPage [] UserCreatedAt (PageSize 10) Ascend (Range Nothing Nothing :: DesiredRange UTCTime)+ whileJust page nextPage+ let sortedKeys =+ List.sort (concatMap (map entityKey . pageRecords) pages)++ List.group sortedKeys `shouldBe` map pure sortedKeys++ it "works for id" $ do+ (records0, records1) <-+ runDb $+ (,) <$> do+ runConduit+ $ streamEntities+ []+ UserId+ (PageSize 10)+ Ascend+ (Range Nothing Nothing)+ .| sinkList+ <*> do+ selectList [] []+ length (Set.fromList records0)+ `shouldBe`+ entityCount+ let mkMap = Map.fromList . map (\e -> (entityKey e, entityVal e))+ r0map = mkMap records0+ r1map = mkMap records1++ Map.keys r0map+ `shouldBe`+ Map.keys r1map++ void $ flip Map.traverseWithKey r0map $ \k a ->+ Map.lookup k r1map+ `shouldBe`+ Just a++ void $ flip Map.traverseWithKey r1map $ \k a ->+ Map.lookup k r0map+ `shouldBe`+ Just a++whileJust :: Monad m => a -> (a -> m (Maybe a)) -> m [a]+whileJust a k = (a :) <$> do+ ma <- k a+ case ma of+ Nothing -> pure []+ Just a' -> whileJust a' k+++runDb :: SqlPersistM a -> IO a+runDb action = do+ runSqlite ":memory:" $ do+ runMigration migrateAll+ seedDatabase+ action++entityCount :: Int+entityCount = 63++seedDatabase :: SqlPersistM ()+seedDatabase = do+ let now = UTCTime (fromGregorian 1990 1 1) 0+ forM_ [1..entityCount] $ \n -> do+ str <- liftIO $ generate $ do+ i <- choose (5, 20)+ vectorOf i arbitrary+ insert $ User str n ((50 * fromIntegral n) `addUTCTime` now)++typeChecksWithSqlReadT+ :: MonadIO m+ => ConduitT Void (Entity User) (ReaderT SqlReadBackend m) ()+typeChecksWithSqlReadT =+ streamEntities+ []+ UserCreatedAt+ (PageSize 10)+ Descend+ (Range Nothing Nothing)++typeChecksWithSqlWriteT+ :: MonadIO m+ => ConduitT Void (Entity User) (ReaderT SqlWriteBackend m) ()+typeChecksWithSqlWriteT =+ streamEntities+ []+ UserCreatedAt+ (PageSize 10)+ Descend+ (Range Nothing Nothing)
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}