{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Yesod.Paginator.Widgets
( PaginationWidget
, simple
, ellipsed
)
where
import Yesod.Paginator.Prelude
import qualified Data.Text as T
import Network.URI.Encode (encodeText)
import Yesod.Core
import Yesod.Paginator.Pages
type PaginationWidget site a = Pages a -> WidgetFor site ()
simple :: Natural -> PaginationWidget m a
simple elements pages = do
updateGetParams <- getUpdateGetParams
let (prevPages, nextPages) = getBalancedPages elements pages
mPrevPage = getPreviousPage pages
mNextPage = getNextPage 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 elements pages = do
updateGetParams <- getUpdateGetParams
let (prevPages, nextPages) = getBalancedPages elements pages
mPrevPage = getPreviousPage pages
mNextPage = getNextPage pages
(mFirstPage, firstEllipses)
| pageNumber (pagesCurrent pages) == 1 = (Nothing, False)
| headMay prevPages == Just 1 = (Nothing, False)
| headMay prevPages == Just 2 = (Just 1, False)
| otherwise = (Just 1, True)
(mLastPage, lastEllipses)
| pageNumber (pagesCurrent pages) == pagesLast pages = (Nothing, False)
| lastMay nextPages == Just (pagesLast pages) = (Nothing, False)
| lastMay nextPages == Just (pagesLast pages - 1) = (Just $ pagesLast pages, False)
| otherwise = (Just $ pagesLast pages, 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 elements pages =
if genericLength nextPages >= (elements `div` 2)
then (prevPagesNaive, nextPages)
else (prevPagesCalcd, nextPages)
where
nextPages = takeNextPages (elements - genericLength prevPagesNaive - 1) pages
prevPagesNaive = takePreviousPages (elements `div` 2) pages
prevPagesCalcd = takePreviousPages (elements - genericLength nextPages - 1) pages
getUpdateGetParams :: WidgetFor site (PageNumber -> [(Text, Text)])
getUpdateGetParams = do
params <- handlerToWidget $ reqGetParams <$> getRequest
pure $ \number -> nubOn fst $ [("p", tshow number)] <> params
renderGetParams :: [(Text, Text)] -> Text
renderGetParams [] = ""
renderGetParams ps = "?" <> T.intercalate "&" (map renderGetParam ps)
where renderGetParam (k, v) = encodeText k <> "=" <> encodeText v