yesod-pagination 0.5.1.0 → 1.0.0.0

raw patch · 3 files changed

+51/−98 lines, 3 filesdep −data-defaultdep −textdep ~shakespearePVP ok

version bump matches the API change (PVP)

Dependencies removed: data-default, text

Dependency ranges changed: shakespeare

API changes (from Hackage documentation)

Files

• src/Yesod/Paginate.hs +39/−86
• tests/main.hs +11/−7
• yesod-pagination.cabal +1/−5

@@ -2,122 +2,75 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-}  -- | Easy pagination for Yesod. module Yesod.Paginate (     -- *** Paginating-    paginate, paginateWith, paginateWithConfig,+    paginate, paginateWith,      -- *** Datatypes-    PageConfig(..), def,+    PageConfig(..),     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 Database.Esqueleto.Internal.Sql 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 }+-- | Metadata about how pagination should work.+data PageConfig app = PageConfig+    { pageSize :: Int+    , currentPage :: Int+    , firstPageRoute :: Route app+    , pageRoute :: Int -> Route app+    }  -- | Returned by 'paginate' and friends.-data Page r = Page-            { pageResults :: [r] -- ^ Returned entities.-            , firstPage :: Maybe Text -- ^ Link to first page.-            , 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 :: (From SqlQuery SqlExpr SqlBackend a, RenderRoute site,-             YesodPersist site, SqlSelect a r,-             YesodPersistBackend site ~ SqlPersistT)-         => HandlerT site IO (Page r) -- ^ Returned page.-paginate = paginateWith return---- | Paginate a model, given an esqueleto query.-paginateWith :: (From SqlQuery SqlExpr SqlBackend t, SqlSelect a r,-                 RenderRoute site, YesodPersist site,-                 YesodPersistBackend site ~ SqlPersistT)-             => (t -> SqlQuery a) -- ^ 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+data Page route r = Page+    { pageResults :: [r] -- ^ Returned entities.+    , firstPage :: Maybe route -- ^ Link to first page.+    , nextPage :: Maybe route -- ^ Link to next page.+    , previousPage :: Maybe route -- ^ Link to previous page.+    } deriving (Eq, Read, Show) -    paginateWithConfig def { pageSize, currentPage } sel+-- | Paginate a model, given a configuration. This just performs a @SELECT+-- *@.+paginate :: (YesodPersist site, SqlSelect a s,+             MonadResource (YesodPersistBackend site (HandlerT site IO)),+             From SqlQuery SqlExpr SqlBackend a,+             MonadSqlPersist (YesodPersistBackend site (HandlerT site IO)))+         => PageConfig site -- ^ Preferred config.+         -> HandlerT site IO (Page (Route site) s) -- ^ Returned page.+paginate c = paginateWith c return  -- | Paginate a model, given a configuration and an esqueleto query.-paginateWithConfig :: (From SqlQuery SqlExpr SqlBackend t, SqlSelect a r,-                       RenderRoute site, YesodPersist site,-                       YesodPersistBackend site ~ SqlPersistT)-                   => PageConfig -- ^ Preferred config.-                   -> (t -> SqlQuery a) -- ^ SQL query.-                   -> HandlerT site IO (Page r) -- ^ Returned page.-paginateWithConfig c sel = do-    let filterStmt u = limit (pageSize c) >> return u-        cp = max 1 $ currentPage c+paginateWith :: (YesodPersist site, SqlSelect a s,+                 MonadResource (YesodPersistBackend site (HandlerT site IO)),+                 From SqlQuery SqlExpr SqlBackend q,+                 MonadSqlPersist (YesodPersistBackend site (HandlerT site IO)))+             => PageConfig site -- ^ Preferred config.+             -> (q -> SqlQuery a) -- ^ SQL query.+             -> HandlerT site IO (Page (Route site) s) -- ^ Returned page.+paginateWith c sel = do+    let cp = max 1 $ fromIntegral (currentPage c)      es <- runDB $ select $ from $ \u -> do-        _ <- filterStmt u-        limit (pageSize c + 1)-        offset $ max 0 $ pageSize c * (cp - 1)+        limit (fromIntegral (pageSize c) + 1)+        offset $ max 0 $ fromIntegral (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-        fp = rend rt $ updateQs qs ("page", "1")-        np = rend rt $ updateQs qs ("page", [st|#{cp + 1}|])-        pp = rend rt $ updateQs qs ("page", [st|#{cp - 1}|])+    let route = pageRoute c . fromIntegral      return Page { pageResults = take (fromIntegral $ pageSize c) es-                , firstPage = if cp >= 2 then Just fp else Nothing+                , firstPage = if cp >= 2 then Just (firstPageRoute c) else Nothing                 , nextPage = if fromIntegral (length es) == pageSize c + 1-                                 then Just np+                                 then Just (route $ cp + 1)                                  else Nothing-                , previousPage = if cp == 1 then Nothing else Just pp+                , previousPage = if cp == 1 then Nothing else Just (route $ cp - 1)                 }-    where-        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

@@ -13,7 +13,6 @@ 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@@ -33,6 +32,7 @@  mkYesod "TestApp" [parseRoutes| /items ItemsR GET+/items/page/#Int ItemsPageR GET |]  instance YesodPersist TestApp where@@ -42,11 +42,15 @@         TestApp p <- getYesod         runSqlPool act p -getItemsR :: HandlerT TestApp IO TypedContent-getItemsR = do-    (items :: Page (Entity Item)) <- paginate+getItemsPageR :: Int -> HandlerT TestApp IO TypedContent+getItemsPageR i = do+    (items :: Page (Route TestApp) (Entity Item)) <-+        paginate $ PageConfig 10 i ItemsR ItemsPageR     selectRep . provideRep $ return [stext|#{show items}|] +getItemsR :: HandlerT TestApp IO TypedContent+getItemsR = getItemsPageR 1+ main :: IO () main = withSqlitePool ":memory:" 1 $ \pool -> do     runResourceT $ runStderrLoggingT $ flip runSqlPool pool $@@ -84,15 +88,15 @@                 clearOut pool                 liftIO $ runSqlPersistMPool (replicateM_ 5 $ insert $ Item "hello, world!") pool -                get ("/items?page=2" :: Text)+                get $ ItemsPageR 2                 cp <- getPage                 liftIO $ length (pageResults cp) `shouldBe` 0 -getPage :: YesodExample TestApp (Page (Entity Item))+getPage :: YesodExample TestApp (Page (Route TestApp) (Entity Item)) getPage = withResponse $ \SResponse { simpleBody } ->     return $ read (B.toString simpleBody) -wantPage :: Page (Entity Item) -> YesodExample TestApp ()+wantPage :: Page (Route TestApp) (Entity Item) -> YesodExample TestApp () wantPage p = do     pg <- getPage     liftIO $ pg `shouldBe` p

@@ -1,5 +1,5 @@ name:                yesod-pagination-version:             0.5.1.0+version:             1.0.0.0 synopsis:            Pagination in Yesod description:         Easy pagination for Yesod. homepage:            https://github.com/joelteon/yesod-pagination@@ -14,10 +14,7 @@ library   exposed-modules:     Yesod.Paginate   build-depends:       base >= 4.4 && < 5-                     , data-default                      , esqueleto-                     , shakespeare >= 2-                     , text                      , yesod   hs-source-dirs:      src   default-language:    Haskell2010@@ -34,7 +31,6 @@                      , resource-pool                      , resourcet                      , shakespeare-                     , text                      , utf8-string                      , wai-test                      , yesod