{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Yesod.Paginator.Widgets
( PaginationWidget
, simple
, simpleWith
, ellipsed
, ellipsedWith
, setPageParameters
) where
import Yesod.Paginator.Prelude
import qualified Data.Text as T
import Network.URI.Encode (encodeText)
import Yesod.Core
import Yesod.Paginator.Pages
import Yesod.Paginator.Paginate
type site a = Pages a -> WidgetFor site ()
simple :: Natural -> PaginationWidget m a
simple :: Natural -> PaginationWidget m a
simple = PaginationConfig -> Natural -> PaginationWidget m a
forall m a. PaginationConfig -> Natural -> PaginationWidget m a
simpleWith PaginationConfig
defaultPaginationConfig
simpleWith :: PaginationConfig -> Natural -> PaginationWidget m a
simpleWith :: PaginationConfig -> Natural -> PaginationWidget m a
simpleWith PaginationConfig
config Natural
elements Pages a
pages = do
PageNumber -> [(Text, Text)]
updateGetParams <- PageParamName -> WidgetFor m (PageNumber -> [(Text, Text)])
forall site.
PageParamName -> WidgetFor site (PageNumber -> [(Text, Text)])
getUpdateGetParams (PaginationConfig -> PageParamName
paginationConfigPageParamName PaginationConfig
config)
let ([PageNumber]
prevPages, [PageNumber]
nextPages) = Natural -> Pages a -> ([PageNumber], [PageNumber])
forall a. Natural -> Pages a -> ([PageNumber], [PageNumber])
getBalancedPages Natural
elements Pages a
pages
mPrevPage :: Maybe PageNumber
mPrevPage = Pages a -> Maybe PageNumber
forall a. Pages a -> Maybe PageNumber
getPreviousPage Pages a
pages
mNextPage :: Maybe PageNumber
mNextPage = Pages a -> Maybe PageNumber
forall a. Pages a -> Maybe PageNumber
getNextPage Pages a
pages
[whamlet|$newline never
<ul .pagination>
$maybe prevPage <- mPrevPage
<li .prev>
<a href=#{renderGetParams $ updateGetParams prevPage}>«
$nothing
<li .prev .disabled>
<a>«
$forall number <- prevPages
<li .prev >
<a href=#{renderGetParams $ updateGetParams number}>#{number}
$with number <- pageNumber $ pagesCurrent pages
<li .active .disabled>
<a>#{number}
$forall number <- nextPages
<li .next>
<a href=#{renderGetParams $ updateGetParams number}>#{number}
$maybe nextPage <- mNextPage
<li .next>
<a href=#{renderGetParams $ updateGetParams nextPage}>»
$nothing
<li .next .disabled>
<a>»
|]
ellipsed :: Natural -> PaginationWidget m a
ellipsed :: Natural -> PaginationWidget m a
ellipsed = PaginationConfig -> Natural -> PaginationWidget m a
forall m a. PaginationConfig -> Natural -> PaginationWidget m a
ellipsedWith PaginationConfig
defaultPaginationConfig
ellipsedWith :: PaginationConfig -> Natural -> PaginationWidget m a
ellipsedWith :: PaginationConfig -> Natural -> PaginationWidget m a
ellipsedWith PaginationConfig
config Natural
elements Pages a
pages = do
PageNumber -> [(Text, Text)]
updateGetParams <- PageParamName -> WidgetFor m (PageNumber -> [(Text, Text)])
forall site.
PageParamName -> WidgetFor site (PageNumber -> [(Text, Text)])
getUpdateGetParams (PaginationConfig -> PageParamName
paginationConfigPageParamName PaginationConfig
config)
let ([PageNumber]
prevPages, [PageNumber]
nextPages) = Natural -> Pages a -> ([PageNumber], [PageNumber])
forall a. Natural -> Pages a -> ([PageNumber], [PageNumber])
getBalancedPages Natural
elements Pages a
pages
mPrevPage :: Maybe PageNumber
mPrevPage = Pages a -> Maybe PageNumber
forall a. Pages a -> Maybe PageNumber
getPreviousPage Pages a
pages
mNextPage :: Maybe PageNumber
mNextPage = Pages a -> Maybe PageNumber
forall a. Pages a -> Maybe PageNumber
getNextPage Pages a
pages
(Maybe PageNumber
mFirstPage, Bool
firstEllipses)
| Page a -> PageNumber
forall a. Page a -> PageNumber
pageNumber (Pages a -> Page a
forall a. Pages a -> Page a
pagesCurrent Pages a
pages) PageNumber -> PageNumber -> Bool
forall a. Eq a => a -> a -> Bool
== PageNumber
1 = (Maybe PageNumber
forall a. Maybe a
Nothing, Bool
False)
| [PageNumber] -> Maybe PageNumber
forall a. [a] -> Maybe a
headMay [PageNumber]
prevPages Maybe PageNumber -> Maybe PageNumber -> Bool
forall a. Eq a => a -> a -> Bool
== PageNumber -> Maybe PageNumber
forall a. a -> Maybe a
Just PageNumber
1 = (Maybe PageNumber
forall a. Maybe a
Nothing, Bool
False)
| [PageNumber] -> Maybe PageNumber
forall a. [a] -> Maybe a
headMay [PageNumber]
prevPages Maybe PageNumber -> Maybe PageNumber -> Bool
forall a. Eq a => a -> a -> Bool
== PageNumber -> Maybe PageNumber
forall a. a -> Maybe a
Just PageNumber
2 = (PageNumber -> Maybe PageNumber
forall a. a -> Maybe a
Just (PageNumber
1 :: PageNumber), Bool
False)
| Bool
otherwise = (PageNumber -> Maybe PageNumber
forall a. a -> Maybe a
Just PageNumber
1, Bool
True)
(Maybe PageNumber
mLastPage, Bool
lastEllipses)
| Page a -> PageNumber
forall a. Page a -> PageNumber
pageNumber (Pages a -> Page a
forall a. Pages a -> Page a
pagesCurrent Pages a
pages) PageNumber -> PageNumber -> Bool
forall a. Eq a => a -> a -> Bool
== Pages a -> PageNumber
forall a. Pages a -> PageNumber
pagesLast Pages a
pages
= (Maybe PageNumber
forall a. Maybe a
Nothing, Bool
False)
| [PageNumber] -> Maybe PageNumber
forall a. [a] -> Maybe a
lastMay [PageNumber]
nextPages Maybe PageNumber -> Maybe PageNumber -> Bool
forall a. Eq a => a -> a -> Bool
== PageNumber -> Maybe PageNumber
forall a. a -> Maybe a
Just (Pages a -> PageNumber
forall a. Pages a -> PageNumber
pagesLast Pages a
pages)
= (Maybe PageNumber
forall a. Maybe a
Nothing, Bool
False)
| [PageNumber] -> Maybe PageNumber
forall a. [a] -> Maybe a
lastMay [PageNumber]
nextPages Maybe PageNumber -> Maybe PageNumber -> Bool
forall a. Eq a => a -> a -> Bool
== PageNumber -> Maybe PageNumber
forall a. a -> Maybe a
Just (Pages a -> PageNumber
forall a. Pages a -> PageNumber
pagesLast Pages a
pages PageNumber -> PageNumber -> PageNumber
forall a. Num a => a -> a -> a
- PageNumber
1)
= (PageNumber -> Maybe PageNumber
forall a. a -> Maybe a
Just (PageNumber -> Maybe PageNumber) -> PageNumber -> Maybe PageNumber
forall a b. (a -> b) -> a -> b
$ Pages a -> PageNumber
forall a. Pages a -> PageNumber
pagesLast Pages a
pages, Bool
False)
| Bool
otherwise
= (PageNumber -> Maybe PageNumber
forall a. a -> Maybe a
Just (PageNumber -> Maybe PageNumber) -> PageNumber -> Maybe PageNumber
forall a b. (a -> b) -> a -> b
$ Pages a -> PageNumber
forall a. Pages a -> PageNumber
pagesLast Pages a
pages, Bool
True)
[whamlet|$newline never
<ul .pagination>
$maybe prevPage <- mPrevPage
<li .prev>
<a href=#{renderGetParams $ updateGetParams prevPage}>«
$nothing
<li .prev .disabled>
<a>«
$maybe firstPage <- mFirstPage
<li .prev>
<a href=#{renderGetParams $ updateGetParams firstPage}>#{firstPage}
$if firstEllipses
<li .prev .disabled>
<a>…
$forall number <- prevPages
<li .prev >
<a href=#{renderGetParams $ updateGetParams number}>#{number}
$with number <- pageNumber $ pagesCurrent pages
<li .active .disabled>
<a>#{number}
$forall number <- nextPages
<li .next>
<a href=#{renderGetParams $ updateGetParams number}>#{number}
$maybe lastPage <- mLastPage
$if lastEllipses
<li .next .disabled>
<a>…
<li .next>
<a href=#{renderGetParams $ updateGetParams lastPage}>#{lastPage}
$maybe nextPage <- mNextPage
<li .next>
<a href=#{renderGetParams $ updateGetParams nextPage}>»
$nothing
<li .next .disabled>
<a>»
|]
getBalancedPages :: Natural -> Pages a -> ([PageNumber], [PageNumber])
getBalancedPages :: Natural -> Pages a -> ([PageNumber], [PageNumber])
getBalancedPages Natural
elements Pages a
pages =
if [PageNumber] -> Natural
forall i a. Num i => [a] -> i
genericLength [PageNumber]
nextPages Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
>= (Natural
elements Natural -> Natural -> Natural
forall a. Integral a => a -> a -> a
`div` Natural
2)
then ([PageNumber]
prevPagesNaive, [PageNumber]
nextPages)
else ([PageNumber]
prevPagesCalcd, [PageNumber]
nextPages)
where
nextPages :: [PageNumber]
nextPages =
Natural -> Pages a -> [PageNumber]
forall a. Natural -> Pages a -> [PageNumber]
takeNextPages (Natural
elements Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- [PageNumber] -> Natural
forall i a. Num i => [a] -> i
genericLength [PageNumber]
prevPagesNaive Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
1) Pages a
pages
prevPagesNaive :: [PageNumber]
prevPagesNaive = Natural -> Pages a -> [PageNumber]
forall a. Natural -> Pages a -> [PageNumber]
takePreviousPages (Natural
elements Natural -> Natural -> Natural
forall a. Integral a => a -> a -> a
`div` Natural
2) Pages a
pages
prevPagesCalcd :: [PageNumber]
prevPagesCalcd =
Natural -> Pages a -> [PageNumber]
forall a. Natural -> Pages a -> [PageNumber]
takePreviousPages (Natural
elements Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- [PageNumber] -> Natural
forall i a. Num i => [a] -> i
genericLength [PageNumber]
nextPages Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
1) Pages a
pages
getUpdateGetParams
:: PageParamName -> WidgetFor site (PageNumber -> [(Text, Text)])
getUpdateGetParams :: PageParamName -> WidgetFor site (PageNumber -> [(Text, Text)])
getUpdateGetParams PageParamName
pageParamName = do
[(Text, Text)]
params <- HandlerFor site [(Text, Text)] -> WidgetFor site [(Text, Text)]
forall site a. HandlerFor site a -> WidgetFor site a
handlerToWidget (HandlerFor site [(Text, Text)] -> WidgetFor site [(Text, Text)])
-> HandlerFor site [(Text, Text)] -> WidgetFor site [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ YesodRequest -> [(Text, Text)]
reqGetParams (YesodRequest -> [(Text, Text)])
-> HandlerFor site YesodRequest -> HandlerFor site [(Text, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HandlerFor site YesodRequest
forall (m :: * -> *). MonadHandler m => m YesodRequest
getRequest
(PageNumber -> [(Text, Text)])
-> WidgetFor site (PageNumber -> [(Text, Text)])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((PageNumber -> [(Text, Text)])
-> WidgetFor site (PageNumber -> [(Text, Text)]))
-> (PageNumber -> [(Text, Text)])
-> WidgetFor site (PageNumber -> [(Text, Text)])
forall a b. (a -> b) -> a -> b
$ \PageNumber
number -> PageParamName -> PageNumber -> [(Text, Text)] -> [(Text, Text)]
forall a.
Show a =>
PageParamName -> a -> [(Text, Text)] -> [(Text, Text)]
setPageParameters PageParamName
pageParamName PageNumber
number [(Text, Text)]
params
renderGetParams :: [(Text, Text)] -> Text
renderGetParams :: [(Text, Text)] -> Text
renderGetParams [] = Text
""
renderGetParams [(Text, Text)]
ps = Text
"?" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"&" (((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
renderGetParam [(Text, Text)]
ps)
where renderGetParam :: (Text, Text) -> Text
renderGetParam (Text
k, Text
v) = Text -> Text
encodeText Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
encodeText Text
v
setPageParameters
:: Show a => PageParamName -> a -> [(Text, Text)] -> [(Text, Text)]
setPageParameters :: PageParamName -> a -> [(Text, Text)] -> [(Text, Text)]
setPageParameters PageParamName
pageParamName a
number [(Text, Text)]
params =
let name :: Text
name = PageParamName -> Text
unPageParamName PageParamName
pageParamName
in [(Text
name, a -> Text
forall a. Show a => a -> Text
tshow a
number)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> ((Text, Text) -> Bool) -> [(Text, Text)] -> [(Text, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(/=) Text
name (Text -> Bool) -> ((Text, Text) -> Text) -> (Text, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> Text
forall a b. (a, b) -> a
fst) [(Text, Text)]
params