{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}

module Yesod.Paginator.Paginate
    ( paginate
    , paginate'
    , paginateWith
    , selectPaginated
    , selectPaginated'
    , selectPaginatedWith
    , getCurrentPage
    , PaginationConfig(..)
    , PageParamName(..)
    , defaultPaginationConfig
    )
where

import Yesod.Paginator.Prelude

import Control.Monad.Trans.Reader (ReaderT)
import Database.Persist
import Yesod.Core
import Yesod.Paginator.Pages
import Yesod.Paginator.PaginationConfig

-- | Paginate a list of items
paginate :: MonadHandler m => PerPage -> [a] -> m (Pages a)
paginate :: PerPage -> [a] -> m (Pages a)
paginate PerPage
per =
    PaginationConfig -> [a] -> m (Pages a)
forall (m :: * -> *) a.
MonadHandler m =>
PaginationConfig -> [a] -> m (Pages a)
paginateWith PaginationConfig
defaultPaginationConfig { paginationConfigPerPage :: PerPage
paginationConfigPerPage = PerPage
per }

-- | Paginate a list of items given a pagination config
paginateWith :: MonadHandler m => PaginationConfig -> [a] -> m (Pages a)
paginateWith :: PaginationConfig -> [a] -> m (Pages a)
paginateWith PaginationConfig
config [a]
items = PerPage -> [a] -> PageNumber -> Pages a
forall a. PerPage -> [a] -> PageNumber -> Pages a
paginate' (PaginationConfig -> PerPage
paginationConfigPerPage PaginationConfig
config) [a]
items
    (PageNumber -> Pages a) -> m PageNumber -> m (Pages a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PageParamName -> m PageNumber
forall (m :: * -> *).
MonadHandler m =>
PageParamName -> m PageNumber
getCurrentPageWith (PageParamName -> m PageNumber)
-> (PaginationConfig -> PageParamName)
-> PaginationConfig
-> m PageNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PaginationConfig -> PageParamName
paginationConfigPageParamName) PaginationConfig
config

-- | A version where the current page is given
--
-- This can be used to avoid the monadic context altogether.
--
-- >>> paginate' 3 ([1..10] :: [Int]) 1
-- Pages {pagesCurrent = Page {pageItems = [1,2,3], pageNumber = 1}, pagesPrevious = [], pagesNext = [2,3,4], pagesLast = 4}
--
-- >>> paginate' 3 ([1..10] :: [Int]) 2
-- Pages {pagesCurrent = Page {pageItems = [4,5,6], pageNumber = 2}, pagesPrevious = [1], pagesNext = [3,4], pagesLast = 4}
--
-- >>> paginate' 3 ([1..10] :: [Int]) 3
-- Pages {pagesCurrent = Page {pageItems = [7,8,9], pageNumber = 3}, pagesPrevious = [1,2], pagesNext = [4], pagesLast = 4}
--
-- >>> paginate' 3 ([1..10] :: [Int]) 4
-- Pages {pagesCurrent = Page {pageItems = [10], pageNumber = 4}, pagesPrevious = [1,2,3], pagesNext = [], pagesLast = 4}
--
-- >>> paginate' 3 ([1..10] :: [Int]) 5
-- Pages {pagesCurrent = Page {pageItems = [], pageNumber = 5}, pagesPrevious = [1,2,3,4], pagesNext = [], pagesLast = 4}
--
paginate' :: PerPage -> [a] -> PageNumber -> Pages a
paginate' :: PerPage -> [a] -> PageNumber -> Pages a
paginate' PerPage
per [a]
items PageNumber
p =
    PageNumber -> PerPage -> ItemsCount -> [a] -> Pages a
forall a. PageNumber -> PerPage -> ItemsCount -> [a] -> Pages a
toPages PageNumber
p PerPage
per ([a] -> ItemsCount
forall i a. Num i => [a] -> i
genericLength [a]
items) ([a] -> Pages a) -> [a] -> Pages a
forall a b. (a -> b) -> a -> b
$ PerPage -> [a] -> [a]
forall i a. Integral i => i -> [a] -> [a]
genericTake PerPage
per ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ ItemsCount -> [a] -> [a]
forall i a. Integral i => i -> [a] -> [a]
genericDrop
        (PageNumber -> PerPage -> ItemsCount
pageOffset PageNumber
p PerPage
per)
        [a]
items

-- | Paginate out of a persistent database
selectPaginated
    :: ( MonadHandler m
       , PersistEntity record
       , PersistEntityBackend record ~ BaseBackend backend
       , PersistQueryRead backend
       )
    => PerPage
    -> [Filter record]
    -> [SelectOpt record]
    -> ReaderT backend m (Pages (Entity record))
selectPaginated :: PerPage
-> [Filter record]
-> [SelectOpt record]
-> ReaderT backend m (Pages (Entity record))
selectPaginated PerPage
per = PaginationConfig
-> [Filter record]
-> [SelectOpt record]
-> ReaderT backend m (Pages (Entity record))
forall (m :: * -> *) record backend.
(MonadHandler m, PersistEntity record,
 PersistEntityBackend record ~ BaseBackend backend,
 PersistQueryRead backend) =>
PaginationConfig
-> [Filter record]
-> [SelectOpt record]
-> ReaderT backend m (Pages (Entity record))
selectPaginatedWith PaginationConfig
defaultPaginationConfig
    { paginationConfigPerPage :: PerPage
paginationConfigPerPage = PerPage
per
    }

-- | Paginate out of a persistent database given a pagination config
selectPaginatedWith
    :: ( MonadHandler m
       , PersistEntity record
       , PersistEntityBackend record ~ BaseBackend backend
       , PersistQueryRead backend
       )
    => PaginationConfig
    -> [Filter record]
    -> [SelectOpt record]
    -> ReaderT backend m (Pages (Entity record))
selectPaginatedWith :: PaginationConfig
-> [Filter record]
-> [SelectOpt record]
-> ReaderT backend m (Pages (Entity record))
selectPaginatedWith PaginationConfig
config [Filter record]
filters [SelectOpt record]
options =
    PerPage
-> [Filter record]
-> [SelectOpt record]
-> PageNumber
-> ReaderT backend m (Pages (Entity record))
forall (m :: * -> *) record backend.
(MonadIO m, PersistEntity record,
 PersistEntityBackend record ~ BaseBackend backend,
 PersistQueryRead backend) =>
PerPage
-> [Filter record]
-> [SelectOpt record]
-> PageNumber
-> ReaderT backend m (Pages (Entity record))
selectPaginated' (PaginationConfig -> PerPage
paginationConfigPerPage PaginationConfig
config) [Filter record]
filters [SelectOpt record]
options
        (PageNumber -> ReaderT backend m (Pages (Entity record)))
-> ReaderT backend m PageNumber
-> ReaderT backend m (Pages (Entity record))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m PageNumber -> ReaderT backend m PageNumber
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((PageParamName -> m PageNumber
forall (m :: * -> *).
MonadHandler m =>
PageParamName -> m PageNumber
getCurrentPageWith (PageParamName -> m PageNumber)
-> (PaginationConfig -> PageParamName)
-> PaginationConfig
-> m PageNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PaginationConfig -> PageParamName
paginationConfigPageParamName) PaginationConfig
config)

-- | A version where the current page is given
--
-- This can be used to avoid the @'MonadHandler'@ context.
--
selectPaginated'
    :: ( MonadIO m
       , PersistEntity record
       , PersistEntityBackend record ~ BaseBackend backend
       , PersistQueryRead backend
       )
    => PerPage
    -> [Filter record]
    -> [SelectOpt record]
    -> PageNumber
    -> ReaderT backend m (Pages (Entity record))
selectPaginated' :: PerPage
-> [Filter record]
-> [SelectOpt record]
-> PageNumber
-> ReaderT backend m (Pages (Entity record))
selectPaginated' PerPage
per [Filter record]
filters [SelectOpt record]
options PageNumber
p =
    PageNumber
-> PerPage
-> ItemsCount
-> [Entity record]
-> Pages (Entity record)
forall a. PageNumber -> PerPage -> ItemsCount -> [a] -> Pages a
toPages PageNumber
p PerPage
per (ItemsCount -> [Entity record] -> Pages (Entity record))
-> ReaderT backend m ItemsCount
-> ReaderT backend m ([Entity record] -> Pages (Entity record))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> ItemsCount
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> ItemsCount)
-> ReaderT backend m Int -> ReaderT backend m ItemsCount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Filter record] -> ReaderT backend m Int
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m Int
count [Filter record]
filters) ReaderT backend m ([Entity record] -> Pages (Entity record))
-> ReaderT backend m [Entity record]
-> ReaderT backend m (Pages (Entity record))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [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]
options
        [SelectOpt record] -> [SelectOpt record] -> [SelectOpt record]
forall a. Semigroup a => a -> a -> a
<> [ Int -> SelectOpt record
forall record. Int -> SelectOpt record
OffsetBy (Int -> SelectOpt record) -> Int -> SelectOpt record
forall a b. (a -> b) -> a -> b
$ ItemsCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ItemsCount -> Int) -> ItemsCount -> Int
forall a b. (a -> b) -> a -> b
$ PageNumber -> PerPage -> ItemsCount
pageOffset PageNumber
p PerPage
per
           , Int -> SelectOpt record
forall record. Int -> SelectOpt record
LimitTo (Int -> SelectOpt record) -> Int -> SelectOpt record
forall a b. (a -> b) -> a -> b
$ PerPage -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral PerPage
per
           ]
        )

getCurrentPage :: MonadHandler m => m PageNumber
getCurrentPage :: m PageNumber
getCurrentPage =
    PageParamName -> m PageNumber
forall (m :: * -> *).
MonadHandler m =>
PageParamName -> m PageNumber
getCurrentPageWith (PaginationConfig -> PageParamName
paginationConfigPageParamName PaginationConfig
defaultPaginationConfig)

getCurrentPageWith :: MonadHandler m => PageParamName -> m PageNumber
getCurrentPageWith :: PageParamName -> m PageNumber
getCurrentPageWith PageParamName
pageParamName = PageNumber -> Maybe PageNumber -> PageNumber
forall a. a -> Maybe a -> a
fromMaybe PageNumber
1 (Maybe PageNumber -> PageNumber)
-> (Maybe Text -> Maybe PageNumber) -> Maybe Text -> PageNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text -> Maybe PageNumber
go (Maybe Text -> PageNumber) -> m (Maybe Text) -> m PageNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m (Maybe Text)
forall (m :: * -> *). MonadHandler m => Text -> m (Maybe Text)
lookupGetParam
    (PageParamName -> Text
unPageParamName PageParamName
pageParamName)
  where
    go :: Maybe Text -> Maybe PageNumber
    go :: Maybe Text -> Maybe PageNumber
go Maybe Text
mp = String -> Maybe PageNumber
forall a. Num a => String -> Maybe a
readIntegral (String -> Maybe PageNumber)
-> (Text -> String) -> Text -> Maybe PageNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack (Text -> Maybe PageNumber) -> Maybe Text -> Maybe PageNumber
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Text
mp