module Yesod.Paginator
( paginate
, selectPaginated
, paginationWidget
) where
import Yesod
import Control.Monad (when)
import Control.Monad.Trans.Class (MonadTrans)
import Data.Text (Text)
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
paginate :: Int
-> [a]
-> GHandler s m ([a], GWidget s m ())
paginate per items = do
p <- getCurrentPage
let tot = length items
let xs = take per $ drop ((p 1) * per) items
return (xs, paginationWidget p per tot)
selectPaginated :: ( MonadTrans (PersistEntityBackend v)
, PersistEntity v
, PersistQuery (PersistEntityBackend v) (GHandler s m))
=> Int-> [Filter v] -> [SelectOpt v]
-> PersistEntityBackend v (GHandler s m) ([Entity v], GWidget s1 m1 ())
selectPaginated per filters selectOpts = do
p <- lift getCurrentPage
tot <- count filters
xs <- selectList filters (selectOpts ++ [OffsetBy ((p1)*per), LimitTo per])
return (xs, paginationWidget p per tot)
paginationWidget :: Int
-> Int
-> Int
-> GWidget s m ()
paginationWidget page per tot = do
let pages = (\(n, r) -> n + (min r 1)) $ tot `divMod` per
when (pages > 1) $ do
let prev = [1 ..(page1)]
let next = [(page+1)..pages ]
let lim = 9
let prev' = if length prev > lim then drop ((length prev) lim) prev else prev
let next' = if length next > lim then take lim next else next
curParams <- lift $ fmap reqGetParams getRequest
[whamlet|
<ul>
^{linkToDisabled (null prev) curParams (page 1) "← Previous"}
$if (/=) prev prev'
<li>^{linkTo curParams 1 "1"}
<li>...
$forall p <- prev'
<li>^{linkTo curParams p (show p)}
<li .active>
<a>#{show page}
$forall n <- next'
<li>^{linkTo curParams n (show n)}
$if (/=) next next'
<li>...
<li>^{linkTo curParams tot (show tot)}
^{linkToDisabled (null next) curParams (page + 1) "Next →"}
|]
getCurrentPage :: GHandler s m Int
getCurrentPage = fmap (fromMaybe 1 . go) $ lookupGetParam "p"
where
go :: Maybe Text -> Maybe Int
go mp = readIntegral . T.unpack =<< mp
updateGetParam :: [(Text,Text)] -> (Text,Text) -> Text
updateGetParam getParams (p, n) = (T.cons '?') . T.intercalate "&"
. map (\(k,v) -> k `T.append` "=" `T.append` v)
. (++ [(p, n)]) . filter ((/= p) . fst) $ getParams
linkTo :: [(Text,Text)] -> Int -> String -> GWidget s m ()
linkTo params pg txt = do
let param = ("p", T.pack $ show pg)
[whamlet|
<a href="#{updateGetParam params param}">#{txt}
|]
linkToDisabled :: Bool
-> [(Text,Text)] -> Int -> String -> GWidget s m ()
linkToDisabled True _ _ txt = [whamlet|
<li .prev .disabled>
<a>#{txt}
|]
linkToDisabled _ params pg txt = [whamlet|
<li .prev>
^{linkTo params pg txt}
|]