Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Merge branch 'master' into SCP-1751-keep-simulation-state
- Loading branch information
Showing
128 changed files
with
12,857 additions
and
8,947 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
107 changes: 107 additions & 0 deletions
107
freer-extras/src/Control/Monad/Freer/Extras/Pagination.hs
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,107 @@ | ||
| {-# LANGUAGE DeriveAnyClass #-} | ||
| {-# LANGUAGE DerivingStrategies #-} | ||
| {-# LANGUAGE FlexibleContexts #-} | ||
| {-# LANGUAGE FlexibleInstances #-} | ||
| {-# LANGUAGE GADTs #-} | ||
| {-# LANGUAGE NamedFieldPuns #-} | ||
| {-# LANGUAGE QuantifiedConstraints #-} | ||
| {-# LANGUAGE RankNTypes #-} | ||
| {-# LANGUAGE UndecidableInstances #-} | ||
| {- | ||
| Pagination allows to return a subset of results through pages. Once the first | ||
| page was requested, we can request the next ones until we get empty results. | ||
| There are multiple strategies for implementation pagination, such as Offset | ||
| Pagination and Seek Pagination. Offset Pagination is the easiest to implement | ||
| and use. However, it is not performant for large offset values and it is not | ||
| consistent if new items are inserted in the database while we are querying. | ||
| For these reasons, we decided to use Seek Pagination which doesn't suffer from | ||
| those drawbacks. Seek Pagination works as follows. For a given page request, we | ||
| need to provide the number of items per page and last element we queried (can | ||
| be Nothing). We suppose the elements are ordered in ascending order. | ||
| Here's a simple illustrative example: | ||
| * Suppose we have the following items in the database [1..100]. | ||
| * We first request the 50 first items. | ||
| * We obtain the first page containing [1..50]. | ||
| * To request the next page, we request 50 items after the last item of the | ||
| previous page (which is 50). | ||
| * We obtain the second page containing [51..100]. | ||
| * Since we don't know this was the last page, we would request the next 50 | ||
| items after the last item (which is 100). | ||
| * We obtain a page with no elements, thus we don't need to query for more pages. | ||
| -} | ||
| module Control.Monad.Freer.Extras.Pagination | ||
| ( PageQuery(..) | ||
| , Page(..) | ||
| , PageSize(..) | ||
| , pageOf | ||
| ) where | ||
|
|
||
| import Control.Monad (guard) | ||
| import Data.Aeson (FromJSON, ToJSON) | ||
| import Data.Default (Default (..)) | ||
| import qualified Data.List.NonEmpty as L | ||
| import Data.Maybe (isJust, listToMaybe) | ||
| import qualified Data.OpenApi as OpenApi | ||
| import Data.Set (Set) | ||
| import qualified Data.Set as Set | ||
| import GHC.Generics (Generic) | ||
| import Numeric.Natural (Natural) | ||
|
|
||
| -- | Query parameters for pagination. | ||
| data PageQuery a = PageQuery | ||
| { pageQuerySize :: PageSize -- ^ Number of items per page. | ||
| , pageQueryLastItem :: Maybe a -- ^ Last item of the queried page. | ||
| } | ||
| deriving stock (Eq, Ord, Show, Generic, Functor) | ||
| deriving anyclass (ToJSON, FromJSON, OpenApi.ToSchema) | ||
|
|
||
| instance Default (PageQuery a) where | ||
| def = PageQuery def Nothing | ||
|
|
||
| newtype PageSize = PageSize { getPageSize :: Natural } | ||
| deriving stock (Eq, Ord, Show, Generic) | ||
| deriving anyclass (ToJSON, FromJSON, OpenApi.ToSchema) | ||
| deriving newtype (Num) | ||
|
|
||
| instance Default PageSize where | ||
| def = PageSize 50 | ||
|
|
||
| -- | Part of a collection. | ||
| data Page a = Page | ||
| { currentPageQuery :: PageQuery a | ||
| -- ^ The 'PageQuery' which was used to request this 'Page'. | ||
| , nextPageQuery :: Maybe (PageQuery a) | ||
| -- ^ The 'PageQuery' to use to request the next 'Page'. Nothing if we requested the last page. | ||
| , pageItems :: [a] | ||
| -- ^ Items in the current 'Page'. | ||
| } | ||
| deriving stock (Eq, Ord, Show, Generic, Functor) | ||
| deriving anyclass (ToJSON, FromJSON) | ||
|
|
||
| -- | Given a 'Set', request the 'Page' with the given 'PageQuery'. | ||
| pageOf | ||
| :: (Eq a) | ||
| => PageQuery a -- ^ Pagination query parameters. | ||
| -> Set a | ||
| -> Page a | ||
| pageOf pageQuery@PageQuery { pageQuerySize = PageSize ps, pageQueryLastItem } items = | ||
| let ps' = fromIntegral ps | ||
| -- The extract the @PageSize + 1@ next elements after the last query | ||
| -- element. The @+1@ allows to now if there is a next page or not. | ||
| pageItems = case pageQueryLastItem of | ||
| Nothing -> take (ps' + 1) $ Set.toList items | ||
| Just i -> take (ps' + 1) $ drop 1 $ dropWhile ((/=) i) $ Set.toList items | ||
|
|
||
| nextLastItem = guard (length items > fromIntegral ps) | ||
| >> L.nonEmpty pageItems | ||
| >>= listToMaybe . L.tail . L.reverse | ||
| in Page | ||
| { currentPageQuery = pageQuery | ||
| , nextPageQuery = fmap (PageQuery (PageSize ps) . Just) nextLastItem | ||
| , pageItems = if isJust nextLastItem then init pageItems else pageItems | ||
| } | ||
|
|
Oops, something went wrong.