module Yesod.Paginator.Widget
( getCurrentPage
, paginationWidget
, defaultWidget
, defaultPageWidgetConfig
, PageWidget
, PageWidgetConfig(..)
) where
import Yesod
import Control.Monad (when, liftM)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
type PageWidget m = Int -> Int -> Int -> WidgetT m IO ()
data PageWidgetConfig = PageWidgetConfig
{ prevText :: Text
, nextText :: Text
, pageCount :: Int
, ascending :: Bool
, showEllipsis :: Bool
, listClasses :: [Text]
}
data PageLink = Enabled Int Text Text
| Disabled Text Text
showLink :: [(Text, Text)] -> PageLink -> WidgetT m IO ()
showLink params (Enabled pg cnt cls) = do
let param = ("p", showT pg)
[whamlet|$newline never
<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|$newline never
<li .#{cls} .disabled>
<a>#{cnt}
|]
defaultPageWidgetConfig :: PageWidgetConfig
defaultPageWidgetConfig = PageWidgetConfig { prevText = "«"
, nextText = "»"
, pageCount = 9
, ascending = True
, showEllipsis = True
, listClasses = ["pagination"]
}
defaultWidget :: Yesod m => PageWidget m
defaultWidget = paginationWidget defaultPageWidgetConfig
paginationWidget :: Yesod m => PageWidgetConfig -> PageWidget m
paginationWidget (PageWidgetConfig {..}) page per tot = do
let pages = (\(n, r) -> n + (min r 1)) $ tot `divMod` per
when (pages > 1) $ do
curParams <- handlerToWidget $ liftM reqGetParams getRequest
[whamlet|$newline never
<ul class="#{cls}">
$forall link <- buildLinks page pages
^{showLink curParams link}
|]
where
cls = T.intercalate " " listClasses
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)) prevText "prev"]
nextLink = [(if null next then Disabled else Enabled (pg + 1)) nextText "next"]
firstLink = [ Enabled 1 "1" "prev" | pg > 1 ]
lastLink = [ Enabled pgs (showT pgs) "next" | pg < pgs ]
prevEllipsis = [ Disabled "..." "prev" | showEllipsis && length prev > pageCount + 1 ]
nextEllipsis = [ Disabled "..." "next" | showEllipsis && length next > pageCount + 1 ]
prevLinks = reverse . take pageCount . reverse . drop 1 $ map (\p -> Enabled p (showT p) "prev") prev
nextLinks = take pageCount . reverse . drop 1 . reverse $ map (\p -> Enabled p (showT p) "next") next
curLink = [Disabled (showT pg) "active"]
in concat $ (if ascending then id else reverse) [ prevLink
, firstLink
, prevEllipsis
, prevLinks
, curLink
, nextLinks
, nextEllipsis
, lastLink
, nextLink
]
getCurrentPage :: Yesod m => HandlerT m IO Int
getCurrentPage = liftM (fromMaybe 1 . go) $ lookupGetParam "p"
where
go :: Maybe Text -> Maybe Int
go mp = readIntegral . T.unpack =<< mp
showT :: (Show a) => a -> Text
showT = T.pack . show