packages feed

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 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)