Permalink
Browse files

bring files over from goodies repo

  • Loading branch information...
0 parents commit f16b218c3263341858dcfe219ab10fcbabbc68a4 @pbrisbin committed Feb 6, 2012
Showing with 259 additions and 0 deletions.
  1. +30 −0 LICENSE
  2. +44 −0 README.md
  3. +2 −0 Setup.hs
  4. +157 −0 Yesod/Paginator.hs
  5. +26 −0 yesod-paginator.cabal
30 LICENSE
@@ -0,0 +1,30 @@
+Copyright (c)2010, Patrick Brisbin
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ * Neither the name of Patrick Brisbin nor the names of other
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
@@ -0,0 +1,44 @@
+# Yesod paginator
+
+~~~ { .haskell }
+import Yesod.Paginator
+~~~
+
+Do you have some `[Thing]` that you've already selected out of your DB,
+maybe composed from multiple tables, and you just want to paginate this
+big list?
+
+~~~ { .haskell }
+getPageR :: Handler RepHtml
+getPageR = do
+ things' <- getAllThings
+
+ -- note: things will be the same type as things'
+ (things, widget) <- paginate 10 things'
+
+ defaultLayout $ do
+ [whamlet|
+ $forall thing <- things
+ ^{showThing thing}
+
+ ^{widget}
+ |]
+~~~
+
+Do you have a single table of records and you want to paginate them,
+selecting only the records needed to display the current page?
+
+~~~ { .haskell }
+getPageR :: Handler RepHtml
+getPageR = do
+ -- note: things is [Entity a] just like selectList returns
+ (things, widget) <- selectPaginated 10 [] []
+
+ defaultLayout $ do
+ [whamlet|
+ $forall thing <- things
+ ^{showThing $ snd thing}
+
+ ^{widget}
+ |]
+~~~
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
@@ -0,0 +1,157 @@
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-}
+-------------------------------------------------------------------------------
+-- |
+--
+-- Inspiration from a concept by ajdunlap:
+-- <http://hackage.haskell.org/package/yesod-paginate>
+--
+-- 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@.
+--
+-- 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.
+--
+-------------------------------------------------------------------------------
+module Yesod.Paginator
+ ( paginate
+ , selectPaginated
+ , paginationWidget
+ ) where
+
+import Yesod
+import Database.Persist.Store (Entity)
+import Data.Text (Text)
+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}
+-- >
+-- > <div .pagination>
+-- > ^{widget}
+-- > |]
+--
+paginate :: Int -- ^ items per page
+ -> [a] -- ^ complete list of items
+ -> GHandler s m ([a], GWidget s m ())
+paginate per items = do
+ let tot = length items
+
+ p <- getCurrentPage tot
+
+ let xs = take per $ drop ((p - 1) * per) items
+
+ 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) <- selectPaginated 10 [SomeThing ==. something] []
+-- >
+-- > defaultLayout $ do
+-- > [whamlet|
+-- > $forall thing <- things
+-- > ^{showThing $ entityVal thing}
+-- >
+-- > <div .pagination>
+-- > ^{widget}
+-- > |]
+--
+selectPaginated :: (YesodPersist m, PersistEntity v,
+ PersistQuery (YesodPersistBackend m) (GHandler s m))
+ => Int -> [Filter v] -> [SelectOpt v]
+ -> GHandler s m ([Entity (YesodPersistBackend m) v], GWidget s m ())
+selectPaginated per filters selectOpts = do
+ tot <- runDB $ count filters
+ p <- getCurrentPage tot
+ xs <- runDB $ 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
+ let pages = (\(n, r) -> n + (min r 1)) $ tot `divMod` per
+
+ if pages <= 1
+ then return ()
+ else 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|
+ <ul>
+ <li .prev :null prev:.disabled>
+ ^{linkTo curParams (page - 1) "← Previous"}
+
+ $if (/=) prev prev'
+ <li>^{linkTo curParams 1 "1"}
+ <li>...
+
+ $forall p <- prev'
+ <li>^{linkTo curParams p (show p)}
+
+ <li .active>
+ <a href="#">#{show page}
+
+ $forall n <- next'
+ <li>^{linkTo curParams n (show n)}
+
+ $if (/=) next next'
+ <li>...
+ <li>^{linkTo curParams tot (show tot)}
+
+ <li .next :null next:.disabled>
+ ^{linkTo curParams (page + 1) "Next →"}
+ |]
+
+getCurrentPage :: Int -> GHandler s m Int
+getCurrentPage tot = do
+ mp <- lookupGetParam "p"
+ return $
+ case mp of
+ Nothing -> 1
+ Just "" -> 1
+ Just p ->
+ case readIntegral $ T.unpack p of
+ Just i -> if i > tot then tot else i
+ _ -> 1
+
+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
+
+linkTo :: [(Text,Text)] -> Int -> String -> GWidget s m ()
+linkTo params pg txt = do
+ let param = ("p", T.pack $ show pg)
+
+ [whamlet|
+ <a href="#{updateGetParam params param}">#{txt}
+ |]
@@ -0,0 +1,26 @@
+name: yesod-paginator
+version: 0.1.1
+description: A pagination approach for yesod
+synopsis: Paginate a list showing a per-item widget and links to other pages
+homepage: http://github.com/pbrisbin/yesod-paginator
+license: BSD3
+license-file: LICENSE
+author: Patrick Brisbin
+maintainer: pbrisbin@gmail.com
+category: Web, Yesod
+build-type: Simple
+cabal-version: >=1.6
+
+library
+ exposed-modules: Yesod.Paginator
+
+ build-depends: base >= 4 && < 5
+ , text >= 0.11 && < 0.12
+ , yesod >= 0.10 && < 0.11
+ , persistent >= 0.7 && < 0.8
+
+ ghc-options: -Wall
+
+source-repository head
+ type: git
+ location: git://github.com/pbrisbin/yesod-paginator.git

0 comments on commit f16b218

Please sign in to comment.