{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
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
streamEntities
:: forall record backend typ m a.
( PersistRecordBackend record backend
, PersistQueryRead backend
, Ord typ
, PersistField typ
, MonadIO m
)
=> [Filter record]
-> EntityField record typ
-> PageSize
-> SortOrder
-> DesiredRange typ
-> 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
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))
getPage
:: 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]
-> 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
}
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)
data Page record typ
= Page
{ :: [Entity record]
, :: Int
, :: Range typ
, Page record typ -> DesiredRange typ
pageDesiredRange :: DesiredRange typ
, Page record typ -> EntityField record typ
pageField :: EntityField record typ
, Page record typ -> [Filter record]
pageFilters :: [Filter record]
, Page record typ -> PageSize
pageSize :: PageSize
, Page record typ -> SortOrder
pageSortOrder :: SortOrder
}