yesod-page-cursor 1.0.0.1 → 2.0.0.0

raw patch · 6 files changed

+73/−51 lines, 6 filesnew-uploaderPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• README.md +6/−4
• src/Yesod/Page.hs +54/−42
• test/Spec.hs +1/−1
• test/TestApp.hs +5/−2
• yesod-page-cursor.cabal +2/−2

@@ -4,6 +4,11 @@  None. +## [v2.0.0.0](https://github.com/freckle/yesod-page-cursor/compare/v1.0.0.1...v2.0.0.0)++- Add `defaultLimit :: Int` argument to `withPage` and `withPageLink`++ ## [v1.0.0.1](https://github.com/freckle/yesod-page-cursor/compare/v1.0.0.0...v1.0.0.1)  - Fix missing `previous` link in all but last page

@@ -10,7 +10,7 @@   let     parseParams =       (,) <$> Param.required "teacherId" <*> Param.optional "courseId"-  page <- withPage entityPage parseParams $ \Cursor {..} -> do+  page <- withPage 100 entityPage parseParams $ \Cursor {..} -> do     let (teacherId, mCourseId) = cursorParams     fmap (sort cursorPosition) . runDB $ selectList       (catMaybes@@ -39,7 +39,8 @@     Last -> reverse ``` -`cursorLastPosition` is configurable. A page sorted by `created_at` may look like:+`cursorLastPosition` is configurable. A page sorted by `created_at` may look+like:  ```hs createdAtPage = PageConfig@@ -51,7 +52,7 @@ getSortedSomeR :: Handler Value getSortedSomeR = do   let parseParams = pure ()-  page <- withPage createdAtPage parseParams $ \Cursor {..} -> do+  page <- withPage 100 createdAtPage parseParams $ \Cursor {..} -> do     fmap (sort cursorPosition) . runDB $ selectList       (whereClause cursorPosition)       [ LimitTo $ fromMaybe 100 cursorLimit@@ -84,7 +85,8 @@  ## Usage -Paginated requests return a single page and a link with a cursor token to retrieve the next page.+Paginated requests return a single page and a link with a cursor token to+retrieve the next page.  ```sh $ curl 'some-rest.com/endpoint?limit=3'

@@ -1,4 +1,5 @@ {-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-}@@ -21,7 +22,7 @@ import Data.Aeson import qualified Data.ByteString.Lazy as BSL import Data.Foldable (asum)-import Data.Maybe (catMaybes, fromMaybe)+import Data.Maybe (catMaybes) import Data.Text (Text, pack, unpack) import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Network.HTTP.Link (writeLinkHeader)@@ -43,11 +44,21 @@      , FromJSON position      , RenderRoute (HandlerSite m)      )-  => (a -> position)+  => Int+  -- ^ Default limit if not specified in the @'Cursor'@+  --+  -- Must be a positive natural number.+  --+  -> (a -> position)+  -- ^ How to get an item's position+  --+  -- For example, this would be @'entityKey'@ for paginated @'Entity'@ values.+  --   -> (Cursor position -> m [a])+  -- ^ How to fetch one page of data at the given @'Cursor'@   -> m [a]-withPageLink makePosition fetchItems = do-  page <- withPage makePosition fetchItems+withPageLink defaultLimit makePosition fetchItems = do+  page <- withPage defaultLimit makePosition fetchItems    let     link = writeLinkHeader $ catMaybes@@ -65,7 +76,12 @@      , FromJSON position      , RenderRoute (HandlerSite m)      )-  => (a -> position)+  => Int+  -- ^ Default limit if not specified in the @'Cursor'@+  --+  -- Must be a positive natural number.+  --+  -> (a -> position)   -- ^ How to get an item's position   --   -- For example, this would be @'entityKey'@ for paginated @'Entity'@ values.@@ -73,8 +89,8 @@   -> (Cursor position -> m [a])   -- ^ How to fetch one page of data at the given @'Cursor'@   -> m (Page a)-withPage makePosition fetchItems = do-  cursor <- parseCursorParams+withPage defaultLimit makePosition fetchItems = do+  cursor <- parseCursorParams defaultLimit    -- We have to fetch page-size+1 items to know if there is a next page or not   let (Limit realLimit) = cursorLimit cursor@@ -107,17 +123,11 @@     , pageNext = do       guard hasNextLink       item <- lastMay page-      pure-        $ cursorRouteAtPosition cursor-        $ Next-        $ makePosition item+      pure $ cursorRouteAtPosition cursor $ Next $ makePosition item     , pagePrevious = do       guard hasPreviousLink       item <- headMay page-      pure-        $ cursorRouteAtPosition cursor-        $ Previous-        $ makePosition item+      pure $ cursorRouteAtPosition cursor $ Previous $ makePosition item     , pageLast = cursorRouteAtPosition cursor Last     } @@ -159,7 +169,7 @@ instance ToJSON position => ToJSON (Position position) where   toJSON = \case     First -> String "first"-    Next p -> object ["next" .= p ]+    Next p -> object ["next" .= p]     Previous p -> object ["previous" .= p]     Last -> String "last" @@ -167,16 +177,13 @@   parseJSON = \case     Null -> pure First     String t -> case t of-        "first" -> pure First-        "last" -> pure Last-        _ -> invalidPosition+      "first" -> pure First+      "last" -> pure Last+      _ -> invalidPosition     Object o -> do-        mNext <- o .:? "next"-        mPrevious <- o .:? "previous"-        maybe invalidPosition pure $ asum-         [ Next <$> mNext-         , Previous <$> mPrevious-         ]+      mNext <- o .:? "next"+      mPrevious <- o .:? "previous"+      maybe invalidPosition pure $ asum [Next <$> mNext, Previous <$> mPrevious]      _ -> invalidPosition    where@@ -187,23 +194,28 @@  newtype Limit = Limit { unLimit :: Int } +validateLimit :: Int -> Either String Limit+validateLimit limit+  | limit <= 0 = badLimit limit+  | otherwise = Right $ Limit limit+ readLimit :: Text -> Either String Limit-readLimit t = case readMaybe @Int $ unpack t of-    Nothing -> limitMustBe "an integer"-    Just limit | limit <= 0 -> limitMustBe "positive and non-zero"-    Just limit -> Right $ Limit limit-  where-    limitMustBe msg = Left $ "Limit must be " <> msg <> ": " <> show t+readLimit t = maybe (badLimit t) validateLimit $ readMaybe @Int $ unpack t +badLimit :: Show a => a -> Either String x+badLimit a = Left $ "Limit must be a positive natural number: " <> show a+ cursorRouteAtPosition   :: ToJSON position => Cursor position -> Position position -> RenderedRoute cursorRouteAtPosition cursor position =-  updateQueryParameter "position" (Just $ encodeText position) $ cursorRoute cursor+  updateQueryParameter "position" (Just $ encodeText position)+    $ cursorRoute cursor  parseCursorParams   :: (MonadHandler m, FromJSON position, RenderRoute (HandlerSite m))-  => m (Cursor position)-parseCursorParams = do+  => Int+  -> m (Cursor position)+parseCursorParams defaultLimit = do   mePosition <- fmap eitherDecodeText <$> lookupGetParam "position"   position <- case mePosition of     Nothing -> pure First@@ -211,10 +223,9 @@     Just (Right p) -> pure p    limit <--    either (\e -> invalidArgs [pack e]) pure-        . readLimit-        . fromMaybe "100"-        =<< lookupGetParam "limit"+    either (invalidArgs . pure . pack) pure+    . maybe (validateLimit defaultLimit) readLimit+    =<< lookupGetParam "limit"    renderedRoute <- getRenderedRoute   pure $ Cursor renderedRoute position limit@@ -227,14 +238,15 @@  headMay :: [a] -> Maybe a headMay [] = Nothing-headMay (x:_) = Just x+headMay (x : _) = Just x  lastMay :: [a] -> Maybe a lastMay [] = Nothing lastMay [x] = Just x-lastMay (_:xs) = lastMay xs+lastMay (_ : xs) = lastMay xs  takeEnd :: Int -> [a] -> [a] takeEnd i xs = f xs (drop i xs)-    where f (_:xs') (_:ys) = f xs' ys-          f xs' _ = xs'+ where+  f (_ : xs') (_ : ys) = f xs' ys+  f xs' _ = xs'

@@ -41,7 +41,7 @@       getPaginated SomeR [("teacherId", "1"), ("limit", "-1")]        statusIs 400-      bodyContains "must be positive and non-zero"+      bodyContains "must be a positive natural number"      it "returns no cursor when there are no items" $ do       getPaginated SomeR [("teacherId", "1")]

@@ -97,7 +97,10 @@ getSomeLinkR = makePaginationRoute withPageLink  type Pagination m f a-  = (Entity a -> Key a) -> (Cursor (Key a) -> m [Entity a]) -> m (f (Entity a))+  = Int+  -> (Entity a -> Key a)+  -> (Cursor (Key a) -> m [Entity a])+  -> m (f (Entity a))  makePaginationRoute   :: (Functor f, ToJSON (f Value))@@ -107,7 +110,7 @@   teacherId <- requireParam "teacherId"   mCourseId <- optionalParam "courseId" -  items <- withPage' entityKey $ \Cursor {..} ->+  items <- withPage' 100 entityKey $ \Cursor {..} ->     runDB $ sort cursorPosition <$> selectList       (catMaybes         [ Just $ SomeAssignmentTeacherId ==. teacherId

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: b4c5d8ba1fe208184ea08c81eabd470f9b93ba740986c4eb430c742098ddbde4+-- hash: 8dc3f8214e380e14ac9e103fd4cdff50f3186e9497536d2f654257e1e1d1072f  name:           yesod-page-cursor-version:        1.0.0.1+version:        2.0.0.0 description:    Cursor based pagination for Yesod homepage:       https://github.com/freckle/yesod-page-cursor#readme bug-reports:    https://github.com/freckle/yesod-page-cursor/issues