{-# 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
    ( module Database.Persist.Pagination
    , module Types
    ) where

import           Conduit
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.
--
-- 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 :: [Filter record]
-> EntityField record typ
-> PageSize
-> SortOrder
-> DesiredRange typ
-> ConduitT a (Entity record) (ReaderT backend m) ()
streamEntities [Filter record]
filters EntityField record typ
field PageSize
pageSize SortOrder
sortOrder DesiredRange typ
range = do
    Maybe (Page record typ)
mpage <- ReaderT backend m (Maybe (Page record typ))
-> ConduitT
     a (Entity record) (ReaderT backend m) (Maybe (Page record typ))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ([Filter record]
-> EntityField record typ
-> PageSize
-> SortOrder
-> DesiredRange typ
-> ReaderT backend m (Maybe (Page record typ))
forall record backend typ (m :: * -> *).
(PersistRecordBackend record backend, PersistQueryRead backend,
 Ord typ, PersistField typ, MonadIO m) =>
[Filter record]
-> EntityField record typ
-> PageSize
-> SortOrder
-> DesiredRange typ
-> ReaderT backend m (Maybe (Page record typ))
getPage [Filter record]
filters EntityField record typ
field PageSize
pageSize SortOrder
sortOrder DesiredRange typ
range)
    Maybe (Page record typ)
-> (Page record typ
    -> ConduitT a (Entity record) (ReaderT backend m) ())
-> ConduitT a (Entity record) (ReaderT backend m) ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe (Page record typ)
mpage Page record typ
-> ConduitT a (Entity record) (ReaderT backend m) ()
forall (m :: * -> *) record backend typ i.
(PersistEntity record, PersistQueryRead backend, MonadIO m,
 PersistField typ, Ord typ,
 PersistEntityBackend record ~ BaseBackend backend) =>
Page record typ
-> ConduitT i (Entity record) (ReaderT backend m) ()
loop
  where
    loop :: Page record typ
-> ConduitT i (Entity record) (ReaderT backend m) ()
loop Page record typ
page = do
        [Entity record]
-> ConduitT i (Element [Entity record]) (ReaderT backend m) ()
forall (m :: * -> *) mono i.
(Monad m, MonoFoldable mono) =>
mono -> ConduitT i (Element mono) m ()
yieldMany (Page record typ -> [Entity record]
forall record typ. Page record typ -> [Entity record]
pageRecords Page record typ
page)
        Maybe (Page record typ)
mpage <- ReaderT backend m (Maybe (Page record typ))
-> ConduitT
     i (Entity record) (ReaderT backend m) (Maybe (Page record typ))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Page record typ -> ReaderT backend m (Maybe (Page record typ))
forall record backend typ (m :: * -> *).
(PersistRecordBackend record backend, PersistQueryRead backend,
 Ord typ, PersistField typ, MonadIO m) =>
Page record typ -> ReaderT backend m (Maybe (Page record typ))
nextPage Page record typ
page)
        Maybe (Page record typ)
-> (Page record typ
    -> ConduitT i (Entity record) (ReaderT backend m) ())
-> ConduitT i (Entity record) (ReaderT backend m) ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe (Page record typ)
mpage Page record typ
-> ConduitT i (Entity record) (ReaderT backend m) ()
loop

-- | 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 (Maybe typ) -> EntityField record typ -> [Filter record]
rangeToFilters Range (Maybe typ)
range EntityField record typ
field =
    (typ -> Filter record) -> [typ] -> [Filter record]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EntityField record typ
field EntityField record typ -> typ -> Filter record
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
>.) (Maybe typ -> [typ]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Range (Maybe typ) -> Maybe typ
forall t. Range t -> t
rangeMin Range (Maybe typ)
range))
    [Filter record] -> [Filter record] -> [Filter record]
forall a. [a] -> [a] -> [a]
++
    (typ -> Filter record) -> [typ] -> [Filter record]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EntityField record typ
field EntityField record typ -> typ -> Filter record
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
<.) (Maybe typ -> [typ]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Range (Maybe typ) -> Maybe typ
forall t. Range t -> t
rangeMax Range (Maybe typ)
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 :: [Filter record]
-> EntityField record typ
-> PageSize
-> SortOrder
-> DesiredRange typ
-> ReaderT backend m (Maybe (Page record typ))
getPage [Filter record]
filts EntityField record typ
field PageSize
pageSize SortOrder
sortOrder DesiredRange typ
desiredRange = do
    [Entity record]
erecs <- [Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [Filter record]
filters [SelectOpt record]
selectOpts
    case [Entity record]
erecs of
        [] ->
            Maybe (Page record typ)
-> ReaderT backend m (Maybe (Page record typ))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Page record typ)
forall a. Maybe a
Nothing
        Entity record
rec:[Entity record]
recs ->
            Maybe (Page record typ)
-> ReaderT backend m (Maybe (Page record typ))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Page record typ -> Maybe (Page record typ)
forall a. a -> Maybe a
Just (Entity record -> [Entity record] -> Page record typ
mkPage Entity record
rec [Entity record]
recs))
  where
    selectOpts :: [SelectOpt record]
selectOpts =
        Int -> SelectOpt record
forall record. Int -> SelectOpt record
LimitTo (PageSize -> Int
unPageSize PageSize
pageSize) SelectOpt record -> [SelectOpt record] -> [SelectOpt record]
forall a. a -> [a] -> [a]
: case SortOrder
sortOrder of
            SortOrder
Ascend  -> [EntityField record typ -> SelectOpt record
forall record typ. EntityField record typ -> SelectOpt record
Asc EntityField record typ
field]
            SortOrder
Descend -> [EntityField record typ -> SelectOpt record
forall record typ. EntityField record typ -> SelectOpt record
Desc EntityField record typ
field]
    filters :: [Filter record]
filters =
        [Filter record]
filts [Filter record] -> [Filter record] -> [Filter record]
forall a. Semigroup a => a -> a -> a
<> DesiredRange typ -> EntityField record typ -> [Filter record]
forall typ record.
PersistField typ =>
Range (Maybe typ) -> EntityField record typ -> [Filter record]
rangeToFilters DesiredRange typ
desiredRange EntityField record typ
field
    mkPage :: Entity record -> [Entity record] -> Page record typ
mkPage Entity record
rec [Entity record]
recs = (Fold (Entity record) (Page record typ)
 -> [Entity record] -> Page record typ)
-> [Entity record]
-> Fold (Entity record) (Page record typ)
-> Page record typ
forall a b c. (a -> b -> c) -> b -> a -> c
flip Fold (Entity record) (Page record typ)
-> [Entity record] -> Page record typ
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
Foldl.fold (Entity record
recEntity record -> [Entity record] -> [Entity record]
forall a. a -> [a] -> [a]
:[Entity record]
recs) (Fold (Entity record) (Page record typ) -> Page record typ)
-> Fold (Entity record) (Page record typ) -> Page record typ
forall a b. (a -> b) -> a -> b
$ do
        let recs' :: [Entity record]
recs' = Entity record
rec Entity record -> [Entity record] -> [Entity record]
forall a. a -> [a] -> [a]
: [Entity record]
recs
            rangeDefault :: Range typ
rangeDefault = Entity record -> Range typ
initRange Entity record
rec
        Maybe (Max typ)
maxRange <- (Entity record -> Maybe (Max typ))
-> Fold (Maybe (Max typ)) (Maybe (Max typ))
-> Fold (Entity record) (Maybe (Max typ))
forall a b r. (a -> b) -> Fold b r -> Fold a r
Foldl.premap (Max typ -> Maybe (Max typ)
forall a. a -> Maybe a
Just (Max typ -> Maybe (Max typ))
-> (Entity record -> Max typ) -> Entity record -> Maybe (Max typ)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. typ -> Max typ
forall a. a -> Max a
Max (typ -> Max typ)
-> (Entity record -> typ) -> Entity record -> Max typ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entity record -> Getting typ (Entity record) typ -> typ
forall s a. s -> Getting a s a -> a
^. EntityField record typ
-> forall (f :: * -> *).
   Functor f =>
   (typ -> f typ) -> Entity record -> f (Entity record)
forall record field.
PersistEntity record =>
EntityField record field
-> forall (f :: * -> *).
   Functor f =>
   (field -> f field) -> Entity record -> f (Entity record)
fieldLens EntityField record typ
field)) Fold (Maybe (Max typ)) (Maybe (Max typ))
forall a. Monoid a => Fold a a
Foldl.mconcat
        Maybe (Min typ)
minRange <- (Entity record -> Maybe (Min typ))
-> Fold (Maybe (Min typ)) (Maybe (Min typ))
-> Fold (Entity record) (Maybe (Min typ))
forall a b r. (a -> b) -> Fold b r -> Fold a r
Foldl.premap (Min typ -> Maybe (Min typ)
forall a. a -> Maybe a
Just (Min typ -> Maybe (Min typ))
-> (Entity record -> Min typ) -> Entity record -> Maybe (Min typ)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. typ -> Min typ
forall a. a -> Min a
Min (typ -> Min typ)
-> (Entity record -> typ) -> Entity record -> Min typ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entity record -> Getting typ (Entity record) typ -> typ
forall s a. s -> Getting a s a -> a
^. EntityField record typ
-> forall (f :: * -> *).
   Functor f =>
   (typ -> f typ) -> Entity record -> f (Entity record)
forall record field.
PersistEntity record =>
EntityField record field
-> forall (f :: * -> *).
   Functor f =>
   (field -> f field) -> Entity record -> f (Entity record)
fieldLens EntityField record typ
field)) Fold (Maybe (Min typ)) (Maybe (Min typ))
forall a. Monoid a => Fold a a
Foldl.mconcat
        Int
len <- Fold (Entity record) Int
forall a. Fold a Int
Foldl.length
        pure Page :: forall record typ.
[Entity record]
-> Int
-> Range typ
-> DesiredRange typ
-> EntityField record typ
-> [Filter record]
-> PageSize
-> SortOrder
-> Page record typ
Page
            { pageRecords :: [Entity record]
pageRecords = [Entity record]
recs'
            , pageRange :: Range typ
pageRange = Range typ -> Maybe (Range typ) -> Range typ
forall a. a -> Maybe a -> a
fromMaybe Range typ
rangeDefault (Maybe (Range typ) -> Range typ) -> Maybe (Range typ) -> Range typ
forall a b. (a -> b) -> a -> b
$
                typ -> typ -> Range typ
forall t. t -> t -> Range t
Range (typ -> typ -> Range typ) -> Maybe typ -> Maybe (typ -> Range typ)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Min typ -> typ) -> Maybe (Min typ) -> Maybe typ
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Min typ -> typ
forall a. Min a -> a
getMin Maybe (Min typ)
minRange Maybe (typ -> Range typ) -> Maybe typ -> Maybe (Range typ)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Max typ -> typ) -> Maybe (Max typ) -> Maybe typ
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Max typ -> typ
forall a. Max a -> a
getMax Maybe (Max typ)
maxRange
            , pageDesiredRange :: DesiredRange typ
pageDesiredRange = DesiredRange typ
desiredRange
            , pageField :: EntityField record typ
pageField = EntityField record typ
field
            , pageFilters :: [Filter record]
pageFilters = [Filter record]
filts
            , pageSize :: PageSize
pageSize = PageSize
pageSize
            , pageRecordCount :: Int
pageRecordCount = Int
len
            , pageSortOrder :: SortOrder
pageSortOrder = SortOrder
sortOrder
            }
    initRange :: Entity record -> Range typ
    initRange :: Entity record -> Range typ
initRange Entity record
rec =
        Range :: forall t. t -> t -> Range t
Range
            { rangeMin :: typ
rangeMin = Entity record
rec Entity record -> Getting typ (Entity record) typ -> typ
forall s a. s -> Getting a s a -> a
^. EntityField record typ
-> forall (f :: * -> *).
   Functor f =>
   (typ -> f typ) -> Entity record -> f (Entity record)
forall record field.
PersistEntity record =>
EntityField record field
-> forall (f :: * -> *).
   Functor f =>
   (field -> f field) -> Entity record -> f (Entity record)
fieldLens EntityField record typ
field
            , rangeMax :: typ
rangeMax = Entity record
rec Entity record -> Getting typ (Entity record) typ -> typ
forall s a. s -> Getting a s a -> a
^. EntityField record typ
-> forall (f :: * -> *).
   Functor f =>
   (typ -> f typ) -> Entity record -> f (Entity record)
forall record field.
PersistEntity record =>
EntityField record field
-> forall (f :: * -> *).
   Functor f =>
   (field -> f field) -> Entity record -> f (Entity record)
fieldLens EntityField record typ
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 record typ -> ReaderT backend m (Maybe (Page record typ))
nextPage Page{Int
[Entity record]
[Filter record]
EntityField record typ
Range typ
DesiredRange typ
SortOrder
PageSize
pageSortOrder :: SortOrder
pageSize :: PageSize
pageFilters :: [Filter record]
pageField :: EntityField record typ
pageDesiredRange :: DesiredRange typ
pageRange :: Range typ
pageRecordCount :: Int
pageRecords :: [Entity record]
pageSortOrder :: forall record typ. Page record typ -> SortOrder
pageRecordCount :: forall record typ. Page record typ -> Int
pageSize :: forall record typ. Page record typ -> PageSize
pageFilters :: forall record typ. Page record typ -> [Filter record]
pageField :: forall record typ. Page record typ -> EntityField record typ
pageDesiredRange :: forall record typ. Page record typ -> DesiredRange typ
pageRange :: forall record typ. Page record typ -> Range typ
pageRecords :: forall record typ. Page record typ -> [Entity record]
..}
    | Int
pageRecordCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< PageSize -> Int
unPageSize PageSize
pageSize =
        Maybe (Page record typ)
-> ReaderT backend m (Maybe (Page record typ))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Page record typ)
forall a. Maybe a
Nothing
    | Bool
otherwise =
        [Filter record]
-> EntityField record typ
-> PageSize
-> SortOrder
-> DesiredRange typ
-> ReaderT backend m (Maybe (Page record typ))
forall record backend typ (m :: * -> *).
(PersistRecordBackend record backend, PersistQueryRead backend,
 Ord typ, PersistField typ, MonadIO m) =>
[Filter record]
-> EntityField record typ
-> PageSize
-> SortOrder
-> DesiredRange typ
-> ReaderT backend m (Maybe (Page record typ))
getPage
            [Filter record]
pageFilters
            EntityField record typ
pageField
            PageSize
pageSize
            SortOrder
pageSortOrder
            (SortOrder -> DesiredRange typ -> Range typ -> DesiredRange typ
forall typ.
Ord typ =>
SortOrder -> DesiredRange typ -> Range typ -> DesiredRange typ
bumpPageRange SortOrder
pageSortOrder DesiredRange typ
pageDesiredRange Range typ
pageRange)

-- | 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
    { Page record typ -> [Entity record]
pageRecords      :: [Entity record]
    -- ^ The collection of records.
    --
    -- @since 0.1.0.0
    , Page record typ -> Int
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
    , Page record typ -> Range typ
pageRange        :: Range typ
    -- ^ The minimum and maximum value of @typ@ in the list.
    --
    -- @since 0.1.0.0
    , Page record typ -> DesiredRange typ
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
    , Page record typ -> EntityField record typ
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
    , Page record typ -> [Filter record]
pageFilters      :: [Filter record]
    -- ^ The extra filters that are placed on the query.
    --
    -- @since 0.1.0.0
    , Page record typ -> PageSize
pageSize         :: PageSize
    -- ^ The desired size of the 'Page' for successive results.
    , Page record typ -> SortOrder
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
    }