yesod-paginator 0.10.0 → 0.10.1

raw patch · 7 files changed

+370/−272 lines, 7 filesdep +data-defaultdep +hspecdep +wai-extradep ~basedep ~yesodnew-component:exe:yesod-paginator-examplePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: data-default, hspec, wai-extra, warp, yesod-core, yesod-paginator, yesod-test

Dependency ranges changed: base, yesod

API changes (from Hackage documentation)

Files

• Yesod/Paginator.hs +0/−104
• Yesod/Paginator/Widget.hs +0/−145
• example/Main.hs +56/−0
• src/Yesod/Paginator.hs +113/−0
• src/Yesod/Paginator/Widget.hs +145/−0
• test/Spec.hs +1/−0
• yesod-paginator.cabal +55/−23

@@ -1,104 +0,0 @@-{-# LANGUAGE QuasiQuotes       #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE FlexibleContexts  #-}-{-# LANGUAGE TypeFamilies      #-}----------------------------------------------------------------------------------- |------ 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:------ > getSomeRoute = do--- >     things' <- getAllThings--- >--- >     (things, widget) <- paginate 10 things'--- >--- >     defaultLayout $ do--- >         [whamlet|--- >             $forall thing <- things--- >                 ^{showThing thing}--- >--- >             <div .pagination>--- >                  ^{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}--- >--- >             <div .pagination>--- >                  ^{widget}--- >             |]------ Both functions return a tuple: the first element being the list of--- items (or Entities) to display on this page and the second being a--- widget showing the pagination navagation links.------------------------------------------------------------------------------------module Yesod.Paginator-    ( paginate-    , paginateWith-    , selectPaginated-    , selectPaginatedWith-    , module Yesod.Paginator.Widget-    ) where--import Yesod-import Yesod.Paginator.Widget--paginate :: Yesod m => Int -> [a] -> HandlerT m IO ([a], WidgetT m IO ())-paginate = paginateWith defaultWidget--paginateWith :: Yesod m-             => PageWidget m-             -> Int-             -> [a]-             -> HandlerT m IO ([a], WidgetT m IO ())-paginateWith widget per items = do-    p <- getCurrentPage--    let tot = length items-    let  xs = take per $ drop ((p - 1) * per) items--    return (xs, widget p per tot)--selectPaginated :: ( PersistEntity val-                   , PersistEntityBackend val ~ YesodPersistBackend m-                   , PersistQuery (YesodPersistBackend m)-                   , Yesod m-                   )-                => Int-                -> [Filter val]-                -> [SelectOpt val]-                -> YesodDB m ([Entity val], WidgetT m IO ())-selectPaginated = selectPaginatedWith defaultWidget--selectPaginatedWith :: ( PersistEntity val-                       , PersistEntityBackend val ~ YesodPersistBackend m-                       , PersistQuery (YesodPersistBackend m)-                       , Yesod m-                       )-                    => PageWidget m-                    -> Int-                    -> [Filter val]-                    -> [SelectOpt val]-                    -> YesodDB m ([Entity val], WidgetT m IO ())-selectPaginatedWith widget per filters selectOpts = do-    p   <- lift getCurrentPage-    tot <- count filters-    xs  <- selectList filters (selectOpts ++ [OffsetBy ((p-1)*per), LimitTo per])--    return (xs, widget p per tot)

@@ -1,145 +0,0 @@-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE QuasiQuotes       #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE FlexibleContexts #-}-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---- | currentPage, itemsPerPage, totalItems -> widget-type PageWidget m = Int -> Int -> Int -> WidgetT m IO ()--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-    , listClasses  :: [Text] -- ^ Additional classes for top level list-    }---- | 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 :: [(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}-        |]---- | Default widget config provided for easy overriding of only some fields.-defaultPageWidgetConfig :: PageWidgetConfig-defaultPageWidgetConfig = PageWidgetConfig { prevText     = "«"-                                           , nextText     = "»"-                                           , pageCount    = 9-                                           , ascending    = True-                                           , showEllipsis = True-                                           , listClasses  = ["pagination"]-                                           }--defaultWidget :: Yesod m => PageWidget m-defaultWidget = paginationWidget defaultPageWidgetConfig---- | A widget showing pagination links. Follows bootstrap principles.---   Utilizes a \"p\" GET param but leaves all other GET params intact.-paginationWidget :: Yesod m => PageWidgetConfig -> PageWidget 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-            <ul class="#{cls}">-                $forall link <- buildLinks page pages-                    ^{showLink curParams link}-            |]--    where-        -- | Concatenate all additional classes.-        cls = T.intercalate " " listClasses--        -- | Build up each component of the overall list of links. We'll-        --   use empty lists to denote ommissions along the way then-        --   concatenate.-        buildLinks :: Int -> Int -> [PageLink]-        buildLinks pg pgs =-            let prev = [1      .. pg - 1]-                next = [pg + 1 .. pgs   ]--                -- these always appear-                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 (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" | 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 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 (showT pg) "active"]--            in concat $ (if ascending then id else reverse) [ prevLink-                      , firstLink-                      , prevEllipsis-                      , prevLinks-                      , curLink-                      , nextLinks-                      , nextEllipsis-                      , lastLink-                      , nextLink-                      ]---- | looks up the \"p\" GET param and converts it to an Int. returns a---   default of 1 when conversion fails.-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

@@ -0,0 +1,56 @@+{-# LANGUAGE QuasiQuotes           #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TemplateHaskell       #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+module Main where++import Yesod+import Yesod.Paginator+import Network.Wai.Handler.Warp (run)++data App = App++mkYesod "App" [parseRoutes|+    / RootR GET+|]++instance Yesod App where+    approot = ApprootRelative+    defaultLayout widget = do+        pc <- widgetToPageContent widget+        withUrlRenderer [hamlet|$newline never+            $doctype 5+            <html lang="en">+                <head>+                    <meta charset="utf-8">+                    <title>#{pageTitle pc}+                    <!-- Get Boostrap from CDN -->+                    <link href="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.6/css/bootstrap.min.css" rel="stylesheet" integrity="sha256-7s5uDGW3AHqw6xtJmNNtr+OBRJUlgkNJEo78P4b0yRw= sha512-nNo+yCHEyn0smMxSswnf/OnX6/KwJuZTlNZBjauKhTK0c+zT+q5JOCx0UFhXQ6rJR9jg6Es8gPuD2uZcYDLqSw==" crossorigin="anonymous">+                    ^{pageHead pc}+                <body>+                    ^{pageBody pc}+            |]++getRootR :: Handler Html+getRootR = do+    -- unneeded return here to match README+    things' <- return [1..1142] :: Handler [Int]++    (things, widget) <- paginate 3 things'++    defaultLayout $ do+        setTitle "My title"+        [whamlet|$newline never+            <h1>Pagination+            <p>The things:+            <ul>+                $forall thing <- things+                    <li>Thing #{show thing}++            <div .pagination>+                ^{widget}+            |]++main :: IO ()+main = run 3000 =<< toWaiApp App

@@ -0,0 +1,113 @@+{-# LANGUAGE CPP               #-}+{-# LANGUAGE QuasiQuotes       #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE TypeFamilies      #-}+-------------------------------------------------------------------------------+-- |+--+-- 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:+--+-- > getSomeRoute = do+-- >     things' <- getAllThings+-- >+-- >     (things, widget) <- paginate 10 things'+-- >+-- >     defaultLayout $ do+-- >         [whamlet|+-- >             $forall thing <- things+-- >                 ^{showThing thing}+-- >+-- >             <div .pagination>+-- >                  ^{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}+-- >+-- >             <div .pagination>+-- >                  ^{widget}+-- >             |]+--+-- Both functions return a tuple: the first element being the list of+-- items (or Entities) to display on this page and the second being a+-- widget showing the pagination navagation links.+--+-------------------------------------------------------------------------------+module Yesod.Paginator+    ( paginate+    , paginateWith+    , selectPaginated+    , selectPaginatedWith+    , module Yesod.Paginator.Widget+    ) where++import Yesod+import Yesod.Paginator.Widget++paginate :: Yesod m => Int -> [a] -> HandlerT m IO ([a], WidgetT m IO ())+paginate = paginateWith defaultWidget++paginateWith :: Yesod m+             => PageWidget m+             -> Int+             -> [a]+             -> HandlerT m IO ([a], WidgetT m IO ())+paginateWith widget per items = do+    p <- getCurrentPage++    let tot = length items+    let  xs = take per $ drop ((p - 1) * per) items++    return (xs, widget p per tot)++selectPaginated :: ( PersistEntity val+#if MIN_VERSION_persistent(2, 5, 0)+                   , PersistEntityBackend val ~ BaseBackend (YesodPersistBackend m)+#else+                   , PersistEntityBackend val ~ YesodPersistBackend m+#endif+                   , PersistQuery (YesodPersistBackend m)+                   , Yesod m+                   )+                => Int+                -> [Filter val]+                -> [SelectOpt val]+                -> YesodDB m ([Entity val], WidgetT m IO ())+selectPaginated = selectPaginatedWith defaultWidget++selectPaginatedWith :: ( PersistEntity val+#if MIN_VERSION_persistent(2, 5, 0)+                       , PersistEntityBackend val ~ BaseBackend (YesodPersistBackend m)+#else+                       , PersistEntityBackend val ~ YesodPersistBackend m+#endif+                       , PersistQuery (YesodPersistBackend m)+                       , Yesod m+                       )+                    => PageWidget m+                    -> Int+                    -> [Filter val]+                    -> [SelectOpt val]+                    -> YesodDB m ([Entity val], WidgetT m IO ())+selectPaginatedWith widget per filters selectOpts = do+    p   <- lift getCurrentPage+    tot <- count filters+    xs  <- selectList filters (selectOpts ++ [OffsetBy ((p-1)*per), LimitTo per])++    return (xs, widget p per tot)

@@ -0,0 +1,145 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE QuasiQuotes       #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}+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++-- | currentPage, itemsPerPage, totalItems -> widget+type PageWidget m = Int -> Int -> Int -> WidgetT m IO ()++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+    , listClasses  :: [Text] -- ^ Additional classes for top level list+    }++-- | 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 :: [(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}+        |]++-- | Default widget config provided for easy overriding of only some fields.+defaultPageWidgetConfig :: PageWidgetConfig+defaultPageWidgetConfig = PageWidgetConfig { prevText     = "«"+                                           , nextText     = "»"+                                           , pageCount    = 9+                                           , ascending    = True+                                           , showEllipsis = True+                                           , listClasses  = ["pagination"]+                                           }++defaultWidget :: Yesod m => PageWidget m+defaultWidget = paginationWidget defaultPageWidgetConfig++-- | A widget showing pagination links. Follows bootstrap principles.+--   Utilizes a \"p\" GET param but leaves all other GET params intact.+paginationWidget :: Yesod m => PageWidgetConfig -> PageWidget 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+            <ul class="#{cls}">+                $forall link <- buildLinks page pages+                    ^{showLink curParams link}+            |]++    where+        -- | Concatenate all additional classes.+        cls = T.intercalate " " listClasses++        -- | Build up each component of the overall list of links. We'll+        --   use empty lists to denote ommissions along the way then+        --   concatenate.+        buildLinks :: Int -> Int -> [PageLink]+        buildLinks pg pgs =+            let prev = [1      .. pg - 1]+                next = [pg + 1 .. pgs   ]++                -- these always appear+                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 (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" | 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 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 (showT pg) "active"]++            in concat $ (if ascending then id else reverse) [ prevLink+                      , firstLink+                      , prevEllipsis+                      , prevLinks+                      , curLink+                      , nextLinks+                      , nextEllipsis+                      , lastLink+                      , nextLink+                      ]++-- | looks up the \"p\" GET param and converts it to an Int. returns a+--   default of 1 when conversion fails.+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

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

@@ -1,29 +1,61 @@-name:                yesod-paginator-version:             0.10.0-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-license:             BSD3-license-file:        LICENSE-author:              Patrick Brisbin-maintainer:          pbrisbin@gmail.com-category:            Web, Yesod-build-type:          Simple-cabal-version:       >=1.6+name:                   yesod-paginator+version:                0.10.1+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+license:                BSD3+license-file:           LICENSE+author:                 Patrick Brisbin+maintainer:             pbrisbin@gmail.com+category:               Web, Yesod+build-type:             Simple+cabal-version:          >=1.8 +flag example+  description: Build the example application+  default: False+ library-  exposed-modules: Yesod.Paginator-                   Yesod.Paginator.Widget+  hs-source-dirs:       src+  exposed-modules:      Yesod.Paginator+                        Yesod.Paginator.Widget -  build-depends: base       >= 4    && < 5-               , text       >= 0.11 && < 2.0-               , yesod      >= 1.4-               , persistent >= 2.0-               , resourcet  >= 0.4.4-               , transformers+  build-depends:        base       >= 4    && < 5+                      , text       >= 0.11 && < 2.0+                      , yesod      >= 1.4+                      , persistent >= 2.0+                      , resourcet  >= 0.4.4+                      , transformers    ghc-options: -Wall -source-repository head-  type:         git-  location:     git://github.com/pbrisbin/yesod-paginator.git+test-suite test+    type:               exitcode-stdio-1.0+    main-is:            Spec.hs+    hs-source-dirs:     test+    ghc-options:        -Wall+    build-depends:      base+                      , hspec+                      , yesod-paginator+                      , data-default+                      , wai-extra+                      , yesod-core+                      , yesod-test++executable yesod-paginator-example+  if flag(example)+    buildable: True+  else+    buildable: False++  main-is:              Main.hs+  hs-source-dirs:       example+  ghc-options:          -Wall+  build-depends:        base+                      , yesod+                      , yesod-paginator+                      , warp++source-repository       head+  type:                 git+  location:             git://github.com/pbrisbin/yesod-paginator.git