diff --git a/Yesod/Paginator.hs b/Yesod/Paginator.hs --- a/Yesod/Paginator.hs +++ b/Yesod/Paginator.hs @@ -5,7 +5,7 @@ ------------------------------------------------------------------------------- -- | -- --- Inspiration from a concept by ajdunlap: +-- Inspiration from a concept by ajdunlap: -- -- -- But uses an entirely different approach. @@ -50,8 +50,10 @@ ------------------------------------------------------------------------------- module Yesod.Paginator ( paginate + , paginateWith , selectPaginated - , paginationWidget + , selectPaginatedWith + , module Yesod.Paginator.Widget ) where import Yesod @@ -59,22 +61,39 @@ import Control.Monad.Trans.Class (MonadTrans) paginate :: Int -> [a] -> GHandler s m ([a], GWidget s m ()) -paginate per items = do +paginate = paginateWith defaultWidget + +paginateWith :: PageWidget s m -> Int -> [a] -> GHandler s m ([a], GWidget s m ()) +paginateWith widget per items = do p <- getCurrentPage let tot = length items let xs = take per $ drop ((p - 1) * per) items - return (xs, paginationWidget p per tot) + return (xs, widget p per tot) -selectPaginated :: ( MonadTrans (PersistEntityBackend v) - , PersistEntity v - , PersistQuery (PersistEntityBackend v) (GHandler s m)) - => Int -> [Filter v] -> [SelectOpt v] - -> PersistEntityBackend v (GHandler s m) ([Entity v], GWidget s1 m1 ()) -selectPaginated per filters selectOpts = do +selectPaginated :: ( PersistEntity val + , PersistQuery (PersistEntityBackend val) (GHandler s m) + , MonadTrans (PersistEntityBackend val) + ) + => Int + -> [Filter val] + -> [SelectOpt val] + -> PersistEntityBackend val (GHandler s m) ([Entity val], GWidget s m ()) +selectPaginated = selectPaginatedWith defaultWidget + +selectPaginatedWith :: ( PersistEntity val + , PersistQuery (PersistEntityBackend val) (GHandler s m) + , MonadTrans (PersistEntityBackend val) + ) + => PageWidget s m + -> Int + -> [Filter val] + -> [SelectOpt val] + -> PersistEntityBackend val (GHandler s m) ([Entity val], GWidget s m ()) +selectPaginatedWith widget per filters selectOpts = do p <- lift getCurrentPage tot <- count filters xs <- selectList filters (selectOpts ++ [OffsetBy ((p-1)*per), LimitTo per]) - return (xs, paginationWidget p per tot) + return (xs, widget p per tot) diff --git a/Yesod/Paginator/Widget.hs b/Yesod/Paginator/Widget.hs --- a/Yesod/Paginator/Widget.hs +++ b/Yesod/Paginator/Widget.hs @@ -1,27 +1,41 @@ +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE OverloadedStrings #-} module Yesod.Paginator.Widget - ( getCurrentPage + ( getCurrentPage , paginationWidget + , defaultWidget + , PageWidget + , PageWidgetConfig(..) ) where import Yesod - import Control.Monad (when) import Data.Maybe (fromMaybe) -import Data.Text (Text) +import Data.Text (Text) + import qualified Data.Text as T +type PageWidget s m = Int -> Int -> Int -> GWidget 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 String String -- ^ page, content, class - | Disabled String String -- ^ content, class +data PageLink = Enabled Int Text Text -- ^ page, content, class + | Disabled Text Text -- ^ content, class -- | Correctly show one of the constructed links showLink :: [(Text, Text)] -> PageLink -> GWidget s m () showLink params (Enabled pg cnt cls) = do - let param = ("p", T.pack . show $ pg) + let param = ("p", showT pg) [whamlet|
  • @@ -40,13 +54,18 @@ #{cnt} |] +defaultWidget :: 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 :: Int -- ^ current page - -> Int -- ^ items per page - -> Int -- ^ total number of items - -> GWidget s m () -paginationWidget page per tot = do +paginationWidget :: PageWidgetConfig -> PageWidget s m +paginationWidget (PageWidgetConfig {..}) page per tot = do -- total / per + 1 for any remainder let pages = (\(n, r) -> n + (min r 1)) $ tot `divMod` per @@ -69,29 +88,27 @@ next = [pg + 1 .. pgs ] -- these always appear - prevLink = [(if null prev then Disabled else Enabled (pg - 1)) "«" "prev"] - nextLink = [(if null next then Disabled else Enabled (pg + 1)) "»" "next"] + prevLink = [(if null prev then Disabled else Enabled (pg - 1)) prevText "prev"] + nextLink = [(if null next then Disabled else Enabled (pg + 1)) nextText "next"] -- show first/last unless we're on it firstLink = [ Enabled 1 "1" "prev" | pg > 1 ] - lastLink = [ Enabled pgs (show pgs) "next" | pg < pgs ] - - lim = 9 + lastLink = [ Enabled pgs (showT pgs) "next" | pg < pgs ] -- we'll show ellipsis if there are enough links that some will -- be ommitted from the list - prevEllipsis = [ Disabled "..." "prev" | length prev > lim + 1 ] - nextEllipsis = [ Disabled "..." "next" | length next > lim + 1 ] + prevEllipsis = [ Disabled "..." "prev" | showEllipsis && length prev > pageCount + 1 ] + nextEllipsis = [ Disabled "..." "next" | showEllipsis && length next > pageCount + 1 ] -- the middle lists, strip the first/last pages and -- correctly take up to limit away from current - 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 + 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 -- finally, this page itself - curLink = [Disabled (show pg) "active"] + curLink = [Disabled (showT pg) "active"] - in concat [ prevLink + in concat $ (if ascending then id else reverse) [ prevLink , firstLink , prevEllipsis , prevLinks @@ -110,3 +127,6 @@ where go :: Maybe Text -> Maybe Int go mp = readIntegral . T.unpack =<< mp + +showT :: (Show a) => a -> Text +showT = T.pack . show diff --git a/yesod-paginator.cabal b/yesod-paginator.cabal --- a/yesod-paginator.cabal +++ b/yesod-paginator.cabal @@ -1,5 +1,5 @@ name: yesod-paginator -version: 0.2.3 +version: 0.3 synopsis: A pagination approach for yesod description: Paginate a list showing a per-item widget and links to other pages homepage: http://github.com/pbrisbin/yesod-paginator @@ -17,8 +17,8 @@ build-depends: base >= 4 && < 5 , text >= 0.11 && < 0.12 - , yesod >= 1.0 && < 1.2 - , persistent >= 0.9 && < 0.10 + , yesod >= 0.10 && < 1.1 + , persistent >= 0.8 && < 0.10 , transformers ghc-options: -Wall