persistent-pagination 0.1.0.0 → 0.1.1.0
raw patch · 6 files changed
+662/−116 lines, 6 filesdep +esqueletoPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: esqueleto
API changes (from Hackage documentation)
- Database.Persist.Pagination: Ascend :: SortOrder
- Database.Persist.Pagination: Descend :: SortOrder
- Database.Persist.Pagination: PageSize :: Int -> PageSize
- Database.Persist.Pagination: Range :: t -> t -> Range t
- Database.Persist.Pagination: [rangeMax] :: Range t -> t
- Database.Persist.Pagination: [rangeMin] :: Range t -> t
- Database.Persist.Pagination: [unPageSize] :: PageSize -> Int
- Database.Persist.Pagination: bumpPageRange :: Ord typ => SortOrder -> DesiredRange typ -> Range typ -> DesiredRange typ
- Database.Persist.Pagination: data Range t
- Database.Persist.Pagination: data SortOrder
- Database.Persist.Pagination: instance (GHC.Enum.Bounded t, GHC.Classes.Ord t) => GHC.Base.Monoid (Database.Persist.Pagination.Range t)
- Database.Persist.Pagination: instance Data.Foldable.Foldable Database.Persist.Pagination.Range
- Database.Persist.Pagination: instance Data.Traversable.Traversable Database.Persist.Pagination.Range
- Database.Persist.Pagination: instance GHC.Base.Functor Database.Persist.Pagination.Range
- Database.Persist.Pagination: instance GHC.Classes.Eq Database.Persist.Pagination.PageSize
- Database.Persist.Pagination: instance GHC.Classes.Eq Database.Persist.Pagination.SortOrder
- Database.Persist.Pagination: instance GHC.Classes.Eq t => GHC.Classes.Eq (Database.Persist.Pagination.Range t)
- Database.Persist.Pagination: instance GHC.Classes.Ord t => GHC.Base.Semigroup (Database.Persist.Pagination.Range t)
- Database.Persist.Pagination: instance GHC.Show.Show Database.Persist.Pagination.PageSize
- Database.Persist.Pagination: instance GHC.Show.Show Database.Persist.Pagination.SortOrder
- Database.Persist.Pagination: instance GHC.Show.Show t => GHC.Show.Show (Database.Persist.Pagination.Range t)
- Database.Persist.Pagination: newtype PageSize
- Database.Persist.Pagination: type DesiredRange t = Range (Maybe t)
+ Database.Esqueleto.Pagination: Page :: [Entity record] -> Int -> Range typ -> DesiredRange typ -> EntityField record typ -> (SqlExpr (Entity record) -> SqlExpr (Value Bool)) -> PageSize -> SortOrder -> Page record typ
+ Database.Esqueleto.Pagination: [pageDesiredRange] :: Page record typ -> DesiredRange typ
+ Database.Esqueleto.Pagination: [pageField] :: Page record typ -> EntityField record typ
+ Database.Esqueleto.Pagination: [pageFilters] :: Page record typ -> SqlExpr (Entity record) -> SqlExpr (Value Bool)
+ Database.Esqueleto.Pagination: [pageRange] :: Page record typ -> Range typ
+ Database.Esqueleto.Pagination: [pageRecordCount] :: Page record typ -> Int
+ Database.Esqueleto.Pagination: [pageRecords] :: Page record typ -> [Entity record]
+ Database.Esqueleto.Pagination: [pageSize] :: Page record typ -> PageSize
+ Database.Esqueleto.Pagination: [pageSortOrder] :: Page record typ -> SortOrder
+ Database.Esqueleto.Pagination: data Page record typ
+ Database.Esqueleto.Pagination: emptyQuery :: SqlExpr (Entity record) -> SqlExpr (Value Bool)
+ Database.Esqueleto.Pagination: getPage :: forall record backend typ m. (PersistRecordBackend record backend, PersistQueryRead backend, PersistUniqueRead backend, BackendCompatible SqlBackend backend, BackendCompatible SqlBackend (BaseBackend backend), Ord typ, PersistField typ, MonadIO m) => (SqlExpr (Entity record) -> SqlExpr (Value Bool)) -> EntityField record typ -> PageSize -> SortOrder -> DesiredRange typ -> ReaderT backend m (Maybe (Page record typ))
+ Database.Esqueleto.Pagination: nextPage :: (PersistRecordBackend record backend, PersistQueryRead backend, PersistUniqueRead backend, BackendCompatible SqlBackend backend, BackendCompatible SqlBackend (BaseBackend backend), Ord typ, PersistField typ, MonadIO m) => Page record typ -> ReaderT backend m (Maybe (Page record typ))
+ Database.Esqueleto.Pagination: rangeToFilters :: (PersistField typ, PersistEntity record) => Range (Maybe typ) -> EntityField record typ -> SqlExpr (Entity record) -> SqlQuery ()
+ Database.Esqueleto.Pagination: streamEntities :: forall record backend typ m a. (PersistRecordBackend record backend, PersistQueryRead backend, PersistUniqueRead backend, BackendCompatible SqlBackend backend, BackendCompatible SqlBackend (BaseBackend backend), Ord typ, PersistField typ, MonadIO m) => (SqlExpr (Entity record) -> SqlExpr (Value Bool)) -> EntityField record typ -> PageSize -> SortOrder -> DesiredRange typ -> ConduitT a (Entity record) (ReaderT backend m) ()
+ Database.Persist.Pagination.Types: Ascend :: SortOrder
+ Database.Persist.Pagination.Types: Descend :: SortOrder
+ Database.Persist.Pagination.Types: PageSize :: Int -> PageSize
+ Database.Persist.Pagination.Types: Range :: t -> t -> Range t
+ Database.Persist.Pagination.Types: [rangeMax] :: Range t -> t
+ Database.Persist.Pagination.Types: [rangeMin] :: Range t -> t
+ Database.Persist.Pagination.Types: [unPageSize] :: PageSize -> Int
+ Database.Persist.Pagination.Types: bumpPageRange :: Ord typ => SortOrder -> DesiredRange typ -> Range typ -> DesiredRange typ
+ Database.Persist.Pagination.Types: data Range t
+ Database.Persist.Pagination.Types: data SortOrder
+ Database.Persist.Pagination.Types: instance (GHC.Enum.Bounded t, GHC.Classes.Ord t) => GHC.Base.Monoid (Database.Persist.Pagination.Types.Range t)
+ Database.Persist.Pagination.Types: instance Data.Foldable.Foldable Database.Persist.Pagination.Types.Range
+ Database.Persist.Pagination.Types: instance Data.Traversable.Traversable Database.Persist.Pagination.Types.Range
+ Database.Persist.Pagination.Types: instance GHC.Base.Functor Database.Persist.Pagination.Types.Range
+ Database.Persist.Pagination.Types: instance GHC.Classes.Eq Database.Persist.Pagination.Types.PageSize
+ Database.Persist.Pagination.Types: instance GHC.Classes.Eq Database.Persist.Pagination.Types.SortOrder
+ Database.Persist.Pagination.Types: instance GHC.Classes.Eq t => GHC.Classes.Eq (Database.Persist.Pagination.Types.Range t)
+ Database.Persist.Pagination.Types: instance GHC.Classes.Ord t => GHC.Base.Semigroup (Database.Persist.Pagination.Types.Range t)
+ Database.Persist.Pagination.Types: instance GHC.Show.Show Database.Persist.Pagination.Types.PageSize
+ Database.Persist.Pagination.Types: instance GHC.Show.Show Database.Persist.Pagination.Types.SortOrder
+ Database.Persist.Pagination.Types: instance GHC.Show.Show t => GHC.Show.Show (Database.Persist.Pagination.Types.Range t)
+ Database.Persist.Pagination.Types: newtype PageSize
+ Database.Persist.Pagination.Types: type DesiredRange t = Range (Maybe t)
Files
- ChangeLog.md +8/−1
- persistent-pagination.cabal +16/−11
- src/Database/Esqueleto/Pagination.hs +283/−0
- src/Database/Persist/Pagination.hs +60/−104
- src/Database/Persist/Pagination/Types.hs +57/−0
- test/Database/Esqueleto/PaginationSpec.hs +238/−0
ChangeLog.md view
@@ -1,3 +1,10 @@ # Changelog for persistent-pagination -## Unreleased changes+## 0.1.1.0++- Add `Database.Esqueleto.Pagination` module for streaming from an `Esqueleto` query.+- Add `Database.Persist.Pagination.Types` module to share common types.++## 0.1.0.0++- Initial Release
persistent-pagination.cabal view
@@ -1,8 +1,8 @@ cabal-version: 1.12 name: persistent-pagination-version: 0.1.0.0-synopsis: Efficient and correct pagination for persistent queries.+version: 0.1.1.0+synopsis: Efficient and correct pagination for persistent or esqueleto 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@@ -24,17 +24,20 @@ library exposed-modules: Database.Persist.Pagination+ Database.Esqueleto.Pagination+ Database.Persist.Pagination.Types 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+ , esqueleto , foldl < 1.5.0 , microlens < 0.5+ , mtl < 3+ , persistent >= 2 && < 3.0 default-language: Haskell2010 ghc-options: -Wall@@ -45,20 +48,22 @@ other-modules: Paths_persistent_pagination Database.Persist.PaginationSpec+ Database.Esqueleto.PaginationSpec hs-source-dirs: test ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.7 && <5- , persistent-pagination+ , conduit+ , containers+ , esqueleto+ , hspec+ , hspec-discover+ , mtl , persistent+ , persistent-pagination , persistent-sqlite , persistent-template- , hspec- , time- , hspec-discover , QuickCheck- , conduit- , containers- , mtl+ , time default-language: Haskell2010
+ src/Database/Esqueleto/Pagination.hs view
@@ -0,0 +1,283 @@+{-# 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.Esqueleto.Pagination+ ( module Database.Esqueleto.Pagination+ , module Types+ ) where++import Conduit+import Control.Applicative+import qualified Control.Foldl as Foldl+import Control.Monad.Reader (ReaderT)+import Data.Foldable (for_, toList)+import Data.Maybe+import Data.Semigroup+import Database.Persist.Class+import Database.Persist.Sql+import Lens.Micro++import Database.Esqueleto (SqlExpr, SqlQuery, Value,+ asc, desc, from, limit,+ orderBy, select, val,+ where_)+import qualified Database.Esqueleto as E++import Database.Persist.Pagination.Types as Types++-- | 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.1.0+streamEntities+ :: forall record backend typ m a.+ ( PersistRecordBackend record backend+ , PersistQueryRead backend+ , PersistUniqueRead backend+ , BackendCompatible SqlBackend backend+ , BackendCompatible SqlBackend (BaseBackend backend)+ , Ord typ+ , PersistField typ+ , MonadIO m+ )+ => (SqlExpr (Entity record) -> SqlExpr (Value Bool))+ -- ^ 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)+ for_ mpage loop+ where+ loop page = do+ yieldMany (pageRecords page)+ mpage <- lift (nextPage page)+ for_ mpage loop++-- | Convert a @'DesiredRange' typ@ into a 'SqlQuery' that operates on the+-- range. The 'DesiredRange' is treated as an exclusive range.+--+-- @since 0.1.1.0+rangeToFilters+ :: (PersistField typ, PersistEntity record)+ => Range (Maybe typ)+ -> EntityField record typ+ -> SqlExpr (Entity record)+ -> SqlQuery ()+rangeToFilters range field sqlRec = do+ for_ (rangeMin range) $ \m ->+ where_ $ sqlRec E.^. field E.>. val m+ for_ (rangeMax range) $ \m ->+ where_ $ sqlRec E.^. field E.<. val m++-- | 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.1.0+getPage+ :: forall record backend typ m.+ ( PersistRecordBackend record backend+ , PersistQueryRead backend+ , PersistUniqueRead backend+ , BackendCompatible SqlBackend backend+ , BackendCompatible SqlBackend (BaseBackend backend)+ , Ord typ+ , PersistField typ+ , MonadIO m+ )+ => (SqlExpr (Entity record) -> SqlExpr (Value Bool))+ -- ^ 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 <-+ select $+ from $ \e -> do+ where_ $ filts e+ rangeToFilters desiredRange field e+ limit (fromIntegral (unPageSize pageSize))+ orderBy . pure $ case sortOrder of+ Ascend -> asc $ e E.^.field+ Descend -> desc $ e E.^. field+ pure e+ case erecs of+ [] ->+ pure Nothing+ rec:recs ->+ pure (Just (mkPage rec recs))+ where+ 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.1.0+nextPage+ ::+ ( PersistRecordBackend record backend+ , PersistQueryRead backend+ , PersistUniqueRead backend+ , BackendCompatible SqlBackend backend+ , BackendCompatible SqlBackend (BaseBackend 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)++-- | A @'Page' record typ@ describes a list of records and enough+-- information necessary to acquire the next page of records, if possible.+--+-- This is a distinct type from the 'Page' in "Database.Persist.Pagination"+-- because the 'pageFilters' field needs a different type. As a result,+-- some of this stuff is duplicated. It's possible that this can be fixed+-- and more code could be shared.+--+-- @since 0.1.1.0+data Page record typ+ = Page+ { pageRecords :: [Entity record]+ -- ^ The collection of records.+ --+ -- @since 0.1.1.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.1.0+ , pageRange :: Range typ+ -- ^ The minimum and maximum value of @typ@ in the list.+ --+ -- @since 0.1.1.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.1.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.1.0+ , pageFilters :: SqlExpr (Entity record) -> SqlExpr (Value Bool)+ -- ^ The extra filters that are placed on the query.+ --+ -- @since 0.1.1.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.1.0+ }++-- | An empty query value to pass to the functions when you don't have any+-- filters to run.+--+-- @since 0.1.1.0+emptyQuery :: SqlExpr (Entity record) -> SqlExpr (Value Bool)+emptyQuery _ = val True
src/Database/Persist/Pagination.hs view
@@ -24,19 +24,23 @@ -- 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+module Database.Persist.Pagination+ ( module Database.Persist.Pagination+ , module Types+ ) where import Conduit-import Control.Applicative-import qualified Control.Foldl as Foldl-import Control.Monad.Reader (ReaderT)-import Data.Foldable (toList, forM_)+import qualified Control.Foldl as Foldl+import Control.Monad.Reader (ReaderT)+import Data.Foldable (for_, toList) import Data.Maybe import Data.Semigroup import Database.Persist.Class import Database.Persist.Sql import Lens.Micro +import Database.Persist.Pagination.Types as Types+ -- | Stream entities out of the database, only pulling a limited amount -- into memory at a time. --@@ -77,95 +81,12 @@ -> 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+ for_ 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- }+ for_ mpage loop -- | Convert a @'DesiredRange' typ@ into a list of 'Filter's for the query. -- The 'DesiredRange' is treated as an exclusive range.@@ -277,19 +198,54 @@ pageSortOrder (bumpPageRange pageSortOrder pageDesiredRange pageRange) --- | Modify the 'DesiredRange' according to the 'Range' that was provided--- by the query and the 'SortOrder'.+-- | 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-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))+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+ }+
+ src/Database/Persist/Pagination/Types.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveTraversable #-}++module Database.Persist.Pagination.Types where++import Control.Applicative (Alternative(..))+import Database.Persist.Sql (Entity)++-- | 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)++-- | 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/Esqueleto/PaginationSpec.hs view
@@ -0,0 +1,238 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+module Database.Esqueleto.PaginationSpec where++import Conduit+import Control.Concurrent+import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Reader+import qualified Data.List as List+import qualified Data.Map as Map+import Data.Maybe+import qualified Data.Set as Set+import Data.Time+import Database.Persist.Sqlite hiding ((==.))+import Database.Persist.TH+import Test.Hspec+import Test.QuickCheck++import Database.Esqueleto.Pagination+import Database.Esqueleto (val, (==.), (^.))++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+ emptyQuery+ 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+ emptyQuery+ 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 emptyQuery 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 emptyQuery 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+ emptyQuery+ 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++ it "works with a filter" $ do+ let searchAge = 1234+ usersWithSearchAge <-+ traverse+ (\k -> fmap k getCurrentTime)+ [User "foo" searchAge, User "bar" searchAge, User "baz" searchAge]+ irrelevantUsers <-+ traverse+ (\k -> fmap k getCurrentTime)+ [User "foo" 0, User "bar" 0, User "baz" 0, User "quux" 0]+ (returnedEntities, properUserIds) <-+ runDb $ do+ userIdsWithSearchAge <- insertMany usersWithSearchAge+ _ <- insertMany irrelevantUsers+ records <- runConduit+ $ streamEntities+ (\e -> e ^. UserAge ==. val searchAge)+ UserCreatedAt+ (PageSize 1)+ Descend+ (Range Nothing Nothing)+ .| sinkList+ pure (records, userIdsWithSearchAge)++ length returnedEntities+ `shouldBe`+ length usersWithSearchAge++ forM_ returnedEntities $ \entity ->+ entity+ `shouldSatisfy`+ ((searchAge ==) . userAge . entityVal)++ Set.fromList (map entityVal returnedEntities)+ `shouldBe`+ Set.fromList usersWithSearchAge++ Set.fromList (map entityKey returnedEntities)+ `shouldBe`+ Set.fromList properUserIds++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+ emptyQuery+ UserCreatedAt+ (PageSize 10)+ Descend+ (Range Nothing Nothing)++typeChecksWithSqlWriteT+ :: MonadIO m+ => ConduitT Void (Entity User) (ReaderT SqlWriteBackend m) ()+typeChecksWithSqlWriteT =+ streamEntities+ emptyQuery+ UserCreatedAt+ (PageSize 10)+ Descend+ (Range Nothing Nothing)