diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,3 @@ +# Changelog for persistent-pagination + +## Unreleased changes diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,57 @@ +# persistent-pagination + +[![Build Status](https://travis-ci.org/parsonsmatt/persistent-pagination.svg?branch=master)](https://travis-ci.org/parsonsmatt/persistent-pagination) ![Hackage-Deps](https://img.shields.io/hackage-deps/v/persistent-pagination.svg) + +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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/persistent-pagination.cabal b/persistent-pagination.cabal new file mode 100644 --- /dev/null +++ b/persistent-pagination.cabal @@ -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 +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 diff --git a/src/Database/Persist/Pagination.hs b/src/Database/Persist/Pagination.hs new file mode 100644 --- /dev/null +++ b/src/Database/Persist/Pagination.hs @@ -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: +-- . +-- +-- @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)) diff --git a/test/Database/Persist/PaginationSpec.hs b/test/Database/Persist/PaginationSpec.hs new file mode 100644 --- /dev/null +++ b/test/Database/Persist/PaginationSpec.hs @@ -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) diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}