module Yesod.Paginator.Widget
( getCurrentPage
, paginationWidget
) where
import Yesod
import Control.Monad (when)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
data PageLink = Enabled Int String String
| Disabled String String
showLink :: [(Text, Text)] -> PageLink -> GWidget s m ()
showLink params (Enabled pg cnt cls) = do
let param = ("p", T.pack . show $ pg)
[whamlet|
<li .#{cls}>
<a href="#{updateGetParam params param}">#{cnt}
|]
where
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
showLink _ (Disabled cnt cls) =
[whamlet|
<li .#{cls} .disabled>
<a>#{cnt}
|]
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
curParams <- lift $ fmap reqGetParams getRequest
[whamlet|
<ul>
$forall link <- buildLinks page pages
^{showLink curParams link}
|]
where
buildLinks :: Int -> Int -> [PageLink]
buildLinks pg pgs =
let prev = [1 .. pg 1]
next = [pg + 1 .. pgs ]
prevLink = [(if null prev then Disabled else Enabled (pg 1)) "«" "prev"]
nextLink = [(if null next then Disabled else Enabled (pg + 1)) "»" "next"]
firstLink = [ Enabled 1 "1" "prev" | pg > 1 ]
lastLink = [ Enabled pgs (show pgs) "next" | pg < pgs ]
lim = 9
prevEllipsis = [ Disabled "..." "prev" | length prev > lim + 1 ]
nextEllipsis = [ Disabled "..." "next" | length next > lim + 1 ]
prevLinks = reverse . take lim . reverse . drop 1 $ map (\p -> Enabled p (show p) "prev") prev
nextLinks = take lim . reverse . drop 1 . reverse $ map (\p -> Enabled p (show p) "next") next
curLink = [Disabled (show pg) "active"]
in concat [ prevLink
, firstLink
, prevEllipsis
, prevLinks
, curLink
, nextLinks
, nextEllipsis
, lastLink
, nextLink
]
getCurrentPage :: GHandler s m Int
getCurrentPage = fmap (fromMaybe 1 . go) $ lookupGetParam "p"
where
go :: Maybe Text -> Maybe Int
go mp = readIntegral . T.unpack =<< mp