{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} module Yesod.Paginator.Widget ( getCurrentPage , paginationWidget , defaultWidget , PageWidget , PageWidgetConfig(..) ) where import Yesod import Control.Monad (when, liftM) import Control.Monad.Trans.Resource import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as T type PageWidget s m = Int -> Int -> Int -> WidgetT s m () data PageWidgetConfig = PageWidgetConfig { prevText :: Text -- ^ The text for the 'previous page' link. , nextText :: Text -- ^ The text for the 'next page' link. , pageCount :: Int -- ^ The number of page links to show , ascending :: Bool -- ^ Whether to list pages in ascending order. , showEllipsis :: Bool -- ^ Whether to show an ellipsis if there are } -- more pages than pageCount -- | Individual links to pages need to follow strict (but sane) markup -- to be styled correctly by bootstrap. This type allows construction -- of such links in both enabled and disabled states. data PageLink = Enabled Int Text Text -- ^ page, content, class | Disabled Text Text -- ^ content, class -- | Correctly show one of the constructed links showLink :: (MonadIO m, MonadThrow m, MonadUnsafeIO m, MonadBaseControl IO m) => [(Text, Text)] -> PageLink -> WidgetT s m () showLink params (Enabled pg cnt cls) = do let param = ("p", showT pg) [whamlet|$newline never
  • #{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
  • #{cnt} |] defaultWidget :: (MonadIO m, MonadUnsafeIO m, MonadThrow m, MonadBaseControl IO m) => PageWidget s m defaultWidget = paginationWidget $ PageWidgetConfig { prevText = "«" , nextText = "»" , pageCount = 9 , ascending = True , showEllipsis = True } -- | A widget showing pagination links. Follows bootstrap principles. -- Utilizes a \"p\" GET param but leaves all other GET params intact. paginationWidget :: (MonadIO m, MonadUnsafeIO m, MonadThrow m, MonadBaseControl IO m) => PageWidgetConfig -> Int -> Int -> Int -> WidgetT site m () paginationWidget (PageWidgetConfig {..}) page per tot = do -- total / per + 1 for any remainder let pages = (\(n, r) -> n + (min r 1)) $ tot `divMod` per when (pages > 1) $ do curParams <- handlerToWidget $ liftM reqGetParams getRequest [whamlet|$newline never