yesod-pagination (empty) → 0.1.0.0
raw patch · 5 files changed
+292/−0 lines, 5 filesdep +basedep +data-defaultdep +esqueletosetup-changed
Dependencies added: base, data-default, esqueleto, hspec, monad-logger, persistent, persistent-sqlite, resource-pool, resourcet, shakespeare-text, text, utf8-string, wai-test, yesod, yesod-pagination, yesod-test
Files
- LICENSE +21/−0
- Setup.hs +2/−0
- src/Yesod/Paginate.hs +125/−0
- tests/main.hs +101/−0
- yesod-pagination.cabal +43/−0
+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2013 Joel Taylor++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Yesod/Paginate.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Easy pagination for Yesod.+module Yesod.Paginate (+ -- *** Paginating+ paginate, paginateWith, paginateWithConfig,++ -- *** Datatypes+ PageConfig(..), def,+ Page(..)+) where++import Control.Monad+import Data.Default+import Data.Int+import Data.Maybe+import Data.Text (Text)+import qualified Data.Text.Read as R+import Database.Esqueleto+import Database.Esqueleto.Internal.Language+import Prelude+import Text.Shakespeare.Text+import Yesod hiding (Value)++-- | Which page we're on, and how big it is.+--+-- 'paginate' and 'paginateWith' build this datatype based on the current+-- query string parameters. Use 'paginateWithConfig' to provide your own.+data PageConfig = PageConfig+ { pageSize :: Int64+ , currentPage :: Int64+ } deriving Show++instance Default PageConfig where+ def = PageConfig { pageSize = 10, currentPage = 1 }++-- | Returned by 'paginate' and friends.+data Page r = Page+ { pageResults :: [Entity r] -- ^ Returned entities.+ , pageCount :: Int64 -- ^ Total number of pages. This will be at minimum 1, even for an empty result set.+ , nextPage :: Maybe Text -- ^ Link to next page, pre-rendered.+ , previousPage :: Maybe Text -- ^ Link to previous page, pre-rendered.+ } deriving (Eq, Read, Show)++-- | Paginate a model using default options - nothing special.+paginate :: (PersistEntity r, RenderRoute site, YesodPersist site,+ YesodPersistBackend site ~ SqlPersistT,+ PersistEntityBackend r ~ SqlBackend)+ => HandlerT site IO (Page r) -- ^ Returned page.+paginate = paginateWith return++-- | Paginate a model, given an esqueleto query.+paginateWith :: (PersistEntity r, From SqlQuery SqlExpr SqlBackend t,+ RenderRoute site, YesodPersist site,+ YesodPersistBackend site ~ SqlPersistT)+ => (t -> SqlQuery (SqlExpr (Entity r))) -- ^ SQL query.+ -> HandlerT site IO (Page r) -- ^ Returned page.+paginateWith sel = do+ params <- liftM2 (\a b -> fst a ++ reqGetParams b)+ runRequestBody getRequest++ let currentPage = maybe 1 (fromMaybe 1 . decimalM)+ $ lookup "page" params+ pageSize = within (5, 50)+ . maybe 10 (fromMaybe 10 . decimalM)+ $ lookup "count" params++ paginateWithConfig def { pageSize, currentPage } sel++-- | Paginate a model, given a configuration and an esqueleto query.+paginateWithConfig :: (PersistEntity r, From SqlQuery SqlExpr SqlBackend t,+ RenderRoute site, YesodPersist site,+ YesodPersistBackend site ~ SqlPersistT)+ => PageConfig -- ^ Preferred config.+ -> (t -> SqlQuery (SqlExpr (Entity r))) -- ^ SQL query.+ -> HandlerT site IO (Page r) -- ^ Returned page.+paginateWithConfig c sel = do+ let filterStmt u = limit (pageSize c) >> return u++ [ct] <- runDB $ select $ from $ \u -> do+ _ <- filterStmt u -- does nothing, used for type constraint+ return (countRows :: SqlExpr (Value Int64))++ let maxPage = max 1 $ (unValue ct + pageSize c - 1) `div` pageSize c+ cp = within (1, maxPage) $ currentPage c++ es <- runDB $ select $ from $ \u -> do+ _ <- filterStmt u+ offset $ within (0, max 0 $ unValue ct - 1) $ pageSize c * (cp - 1)+ sel u++ rt' <- getCurrentRoute+ rend <- getUrlRenderParams++ let rt = fromMaybe (error "Attempting to use paginate on a server error page.") rt'+ qs = snd $ renderRoute rt+ np = rend rt $ updateQs qs ("page", [st|#{cp + 1}|])+ pp = rend rt $ updateQs qs ("page", [st|#{cp - 1}|])++ return Page { pageResults = es+ , pageCount = maxPage+ , nextPage = if cp == maxPage then Nothing else Just np+ , previousPage = if cp == 1 then Nothing else Just pp+ }+ where+ unValue (Value a) = a+ updateQs ((a,b):as) (k,v) | k == a = (k,v):as+ | otherwise = (a,b):updateQs as (k,v)+ updateQs [] (k,v) = [(k,v)]++decimalM :: Integral a => Text -> Maybe a+decimalM t = case R.decimal t of+ Right (i, _) -> Just i+ Left _ -> Nothing++within :: Ord a => (a,a) -> a -> a+within (a,b) _ | b < a = error "within error"+within (a,b) q | q <= a = a+ | q >= b = b+ | otherwise = q
+ tests/main.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++import Control.Monad+import Control.Monad.Logger+import Control.Monad.Trans.Resource+import qualified Data.ByteString.Lazy.UTF8 as B+import Data.Maybe+import Data.Pool+import Data.Text (Text)+import Database.Persist.Sqlite hiding (get)+import Network.Wai.Test+import Test.Hspec+import Text.Shakespeare.Text+import Yesod hiding (get)+import Yesod.Paginate+import Yesod.Test++share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|+Item+ name String+ deriving Eq Read Show+|]++data TestApp = TestApp ConnectionPool+instance Yesod TestApp++mkYesod "TestApp" [parseRoutes|+/items ItemsR GET+|]++instance YesodPersist TestApp where+ type YesodPersistBackend TestApp = SqlPersistT++ runDB act = do+ TestApp p <- getYesod+ runSqlPool act p++getItemsR :: HandlerT TestApp IO TypedContent+getItemsR = do+ (items :: Page Item) <- paginate+ selectRep . provideRep $ return [stext|#{show items}|]++main :: IO ()+main = withSqlitePool ":memory:" 1 $ \pool -> do+ runResourceT $ runStderrLoggingT $ flip runSqlPool pool $+ runMigration migrateAll+ hspec $ yesodSpec (TestApp pool) $+ ydescribe "pages" $ do+ yit "with nothing" $ do+ clearOut pool++ get ItemsR+ wantPage $ Page [] 1 Nothing Nothing++ yit "with some items" $ do+ clearOut pool+ k <- liftIO $ runSqlPersistMPool (insert $ Item "hello, world!") pool++ get ItemsR+ wantPage $ Page [Entity k (Item "hello, world!")] 1 Nothing Nothing++ yit "with two pages" $ do+ clearOut pool+ liftIO $ runSqlPersistMPool (replicateM_ 18 $ insert $ Item "hello, world!") pool++ get ItemsR+ cp <- getPage+ liftIO $ length (pageResults cp) `shouldBe` 10+ liftIO $ previousPage cp `shouldBe` Nothing++ get $ fromJust (nextPage cp)+ cp' <- getPage+ liftIO $ length (pageResults cp') `shouldBe` 8+ liftIO $ nextPage cp' `shouldBe` Nothing++ yit "caps at the maximum page" $ do+ clearOut pool+ liftIO $ runSqlPersistMPool (replicateM_ 5 $ insert $ Item "hello, world!") pool++ get ("/items?page=2" :: Text)+ cp <- getPage+ liftIO $ length (pageResults cp) `shouldBe` 5++getPage :: YesodExample TestApp (Page Item)+getPage = withResponse $ \SResponse { simpleBody } ->+ return $ read (B.toString simpleBody)++wantPage :: Page Item -> YesodExample TestApp ()+wantPage p = do+ pg <- getPage+ liftIO $ pg `shouldBe` p++clearOut :: MonadIO m => Pool Connection -> m ()+clearOut pool = liftIO $ runSqlPersistMPool (deleteWhere ([] :: [Filter Item])) pool
+ yesod-pagination.cabal view
@@ -0,0 +1,43 @@+name: yesod-pagination+version: 0.1.0.0+synopsis: Pagination in Yesod+description: Easy pagination for Yesod.+homepage: https://github.com/joelteon/yesod-pagination+license: MIT+license-file: LICENSE+author: Joel Taylor+maintainer: me@joelt.io+category: Web+build-type: Simple+cabal-version: >=1.10++library+ exposed-modules: Yesod.Paginate+ build-depends: base >= 4.4 && < 4.7+ , data-default+ , esqueleto+ , shakespeare-text+ , text+ , yesod+ hs-source-dirs: src+ default-language: Haskell2010++test-suite test+ type: exitcode-stdio-1.0+ main-is: main.hs+ hs-source-dirs: tests+ build-depends: base+ , hspec+ , monad-logger+ , persistent+ , persistent-sqlite+ , resource-pool+ , resourcet+ , shakespeare-text+ , text+ , utf8-string+ , wai-test+ , yesod+ , yesod-pagination+ , yesod-test+ default-language: Haskell2010