diff --git a/Yesod/Paginator.hs b/Yesod/Paginator.hs --- a/Yesod/Paginator.hs +++ b/Yesod/Paginator.hs @@ -11,13 +11,41 @@ -- But uses an entirely different approach. -- -- There are two pagination functions. One for arbitrary items where you --- provide the list of things to be paginated, and one for paginating --- directly out of the database, you provide the same filters as you --- would to @selectList@. +-- provide the list of things to be paginated: -- +-- > getSomeRoute = do +-- > things' <- getAllThings +-- > +-- > (things, widget) <- paginate 10 things' +-- > +-- > defaultLayout $ do +-- > [whamlet| +-- > $forall thing <- things +-- > ^{showThing thing} +-- > +-- >
+-- > ^{widget} +-- > |] +-- +-- And another for paginating directly out of the database, you provide +-- the same filters as you would to @selectList@. +-- +-- > getSomeRoute something = do +-- > -- note: things is [Entity val] just like selectList returns +-- > (things, widget) <- runDB $ selectPaginated 10 [SomeThing ==. something] [] +-- > +-- > defaultLayout $ do +-- > [whamlet| +-- > $forall thing <- things +-- > ^{showThing $ entityVal thing} +-- > +-- >
+-- > ^{widget} +-- > |] +-- -- Both functions return a tuple: the first element being the list of --- items to display on this page and the second being a widget showing --- the pagination navagation links. +-- items (or Entities) to display on this page and the second being a +-- widget showing the pagination navagation links. -- ------------------------------------------------------------------------------- module Yesod.Paginator @@ -26,32 +54,11 @@ , paginationWidget ) where -import Yesod -- TODO: minimal deps -import Control.Monad (when) +import Yesod +import Yesod.Paginator.Widget import Control.Monad.Trans.Class (MonadTrans) -import Data.Text (Text) -import Data.Maybe (fromMaybe) -import qualified Data.Text as T --- | Paginate an existing list of items. --- --- > getSomeRoute = do --- > things' <- getAllThings --- > --- > (things, widget) <- paginate 10 things' --- > --- > defaultLayout $ do --- > [whamlet| --- > $forall thing <- things --- > ^{showThing thing} --- > --- >
--- > ^{widget} --- > |] --- -paginate :: Int -- ^ items per page - -> [a] -- ^ complete list of items - -> GHandler s m ([a], GWidget s m ()) +paginate :: Int -> [a] -> GHandler s m ([a], GWidget s m ()) paginate per items = do p <- getCurrentPage @@ -60,25 +67,10 @@ return (xs, paginationWidget p per tot) --- | Paginate directly out of the database. --- --- > getSomeRoute something = do --- > -- note: things is [Entity val] just like selectList returns --- > (things, widget) <- runDB $ selectPaginated 10 [SomeThing ==. something] [] --- > --- > defaultLayout $ do --- > [whamlet| --- > $forall thing <- things --- > ^{showThing $ entityVal thing} --- > --- >
--- > ^{widget} --- > |] --- selectPaginated :: ( MonadTrans (PersistEntityBackend v) , PersistEntity v , PersistQuery (PersistEntityBackend v) (GHandler s m)) - => Int-> [Filter v] -> [SelectOpt v] + => Int -> [Filter v] -> [SelectOpt v] -> PersistEntityBackend v (GHandler s m) ([Entity v], GWidget s1 m1 ()) selectPaginated per filters selectOpts = do p <- lift getCurrentPage @@ -86,85 +78,3 @@ xs <- selectList filters (selectOpts ++ [OffsetBy ((p-1)*per), LimitTo per]) return (xs, paginationWidget p per tot) - --- | 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 - -- total / per + 1 for any remainder - let pages = (\(n, r) -> n + (min r 1)) $ tot `divMod` per - - when (pages > 1) $ do - let prev = [1 ..(page-1)] - let next = [(page+1)..pages ] - - let lim = 9 -- don't show more than nine links on either side - let prev' = if length prev > lim then drop ((length prev) - lim) prev else prev - let next' = if length next > lim then take lim next else next - - curParams <- lift $ fmap reqGetParams getRequest - - [whamlet| -