{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}

module Yesod.Paginator.Widgets
    ( PaginationWidget
    , simple
    , simpleWith
    , ellipsed
    , ellipsedWith

    -- * Exported for testing
    , 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 PaginationWidget site a = Pages a -> WidgetFor site ()

-- | Simple widget, limited to show the given number of total page elements
--
-- Pseudo-HTML for @'simple' 5@, on page 1:
--
-- @
--   \<ul .pagination>
--     \<li .prev .disabled>\<a>«
--     \<li .active .disabled>\<a>1
--     \<li .next>\<a href=\"?p=2\">2
--     \<li .next>\<a href=\"?p=3\">3
--     \<li .next>\<a href=\"?p=4\">4
--     \<li .next>\<a href=\"?p=5\">5
--     \<li .next>\<a href=\"?p=2\">»
-- @
--
-- And page 7:
--
-- @
--   \<ul .pagination>
--     \<li .prev>\<a href=\"?p=6\">«
--     \<li .prev>\<a href=\"?p=5\">5
--     \<li .prev>\<a href=\"?p=6\">6
--     \<li .active .disabled>\<a>7
--     \<li .next>\<a href=\"?p=8\">8
--     \<li .next>\<a href=\"?p=9\">9
--     \<li .next>\<a href=\"?p=8\">»
-- @
--
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>»
        |]

-- | Show pages before and after, ellipsis, and first/last
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>»
        |]

-- | Calculate previous and next pages to produce an overall number of elements
--
-- >>> let page n = toPages n 2 20 [] :: Pages Int
-- >>> getBalancedPages 6 $ page 1
-- ([],[2,3,4,5,6])
--
-- >>> getBalancedPages 6 $ page 6
-- ([3,4,5],[7,8])
--
-- >>> getBalancedPages 6 $ page 10
-- ([5,6,7,8,9],[])
--
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