ihp-1.5.0: IHP/Pagination/ViewFunctions.hs
module IHP.Pagination.ViewFunctions (
module IHP.Pagination.Types,
renderPagination,
renderFilter,
) where
import IHP.Prelude
import IHP.Pagination.Types
import IHP.Pagination.Helpers
import IHP.ControllerSupport
import Text.Blaze.Html (Html)
import IHP.HSX.QQ (hsx)
import IHP.Controller.Param (paramOrNothing)
import Network.Wai
import qualified Network.HTTP.Types.URI as Query
import IHP.ViewSupport (theRequest, theCSSFramework)
import qualified Data.Containers.ListUtils as List
import IHP.View.Types (PaginationView(..), styledPagination, styledPaginationPageLink, styledPaginationDotDot, styledPaginationItemsPerPageSelector, styledPaginationLinkPrevious, styledPaginationLinkNext)
-- | Render a navigation for your pagination. This is to be used in your view whenever
-- to allow users to change pages, including "Next" and "Previous".
-- If there is only one page, this will not render anything.
renderPagination :: (?context :: ControllerContext, ?request :: Request) => Pagination -> Html
renderPagination pagination@Pagination {currentPage, window, pageSize} =
when (showPagination pagination) $ styledPagination theCSSFramework theCSSFramework paginationView
where
paginationView = PaginationView
{ cssFramework = theCSSFramework
, pagination = pagination
, pageUrl = pageUrl
, linkPrevious = linkPrevious
, linkNext = linkNext
, pageDotDotItems = pageDotDotItems
, itemsPerPageSelector = itemsPerPageSelector
}
linkPrevious =
styledPaginationLinkPrevious theCSSFramework theCSSFramework pagination (pageUrl $ currentPage - 1)
linkNext =
styledPaginationLinkNext theCSSFramework theCSSFramework pagination (pageUrl $ currentPage + 1)
itemsPerPageSelector =
styledPaginationItemsPerPageSelector theCSSFramework theCSSFramework pagination itemsPerPageUrl
pageDotDotItems = [hsx|{forEach (processedPages pages) pageDotDotItem}|]
pageDotDotItem pg =
case pg of
Page n ->
styledPaginationPageLink theCSSFramework theCSSFramework pagination (pageUrl n) n
DotDot n ->
styledPaginationDotDot theCSSFramework theCSSFramework pagination
pageUrl n = path <> Query.renderQuery True newQueryString
where
-- "?page=" ++ show n ++ maybeFilter ++ maybeMaxItems
path = theRequest.rawPathInfo
queryString = theRequest.queryString
newQueryString = queryString
|> setQueryValue "page" (cs $ show n)
|> maybeFilter
|> maybeMaxItems
itemsPerPageUrl n = path <> Query.renderQuery True newQueryString
where
path = theRequest.rawPathInfo
queryString = theRequest.queryString
newQueryString = queryString
|> setQueryValue "maxItems" (cs $ tshow n)
-- If we change the number of items, we should jump back to the first page
-- so we are not out of the items bound.
|> setQueryValue "page" (cs $ show 1)
maybeFilter queryString =
case paramOrNothing @Text "filter" of
Nothing -> queryString
Just "" -> queryString
Just filterValue -> queryString |> setQueryValue "filter" (cs filterValue)
maybeMaxItems queryString =
case paramOrNothing @Int "maxItems" of
Nothing -> queryString
Just m -> queryString |> setQueryValue "maxItems" (cs $ tshow m)
processedPages (pg0:pg1:rest) =
if pg1 == pg0 + 1 then
Page pg0 : processedPages (pg1:rest)
else
Page pg0 : DotDot ((pg1+pg0) `div` 2) : processedPages (pg1:rest)
processedPages [pg] =
[Page pg]
processedPages [] = []
pages =
let
totalPages = getLastPage pagination
lowerBound
| currentPage - window < 1 =
1
| currentPage + window > totalPages =
totalPages - window * 2 + 1
| otherwise =
currentPage - window
upperBound
| currentPage + window > totalPages =
totalPages
| currentPage - window < 1 =
window * 2
| otherwise =
currentPage + window
in
if window > totalPages then
[1..getLastPage pagination]
else
List.nubInt $ 1 : [max 1 lowerBound..min (getLastPage pagination) upperBound] ++ [totalPages]
-- | Render a filtering box in your view. Allows the user to type in a query and filter
-- results according to what they type.
--
-- Below is an example of how this might be used in your index. Replace the existing <h1> with:
-- <div class="container">
-- <div class="row justify-content-between">
-- <div class="col-7">
-- <h1>Users<a href={pathTo NewUserAction} class="btn btn-primary ms-4">+ New</a></h1>
-- </div>
-- <div class="col-5">
-- {renderFilter "Username"}
-- </div>
-- </div>
-- </div>
renderFilter :: (?context::ControllerContext, ?request :: Request) =>
Text -- ^ Placeholder text for the text box
-> Html
renderFilter placeholder =
[hsx|
<form method="GET" action="" class="mt-2 float-end">
<div class="row">
<div class="col-auto">
<label class="visually-hidden" for="inlineFormInput">Name</label>
<input type="hidden" name="page" value="1"/>
<input name="filter" type="text" class="form-control mb-2" id="inlineFormInput" placeholder={placeholder} value={boxValue}>
</div>
<div class="col-auto">
<button type="submit" class="btn btn-primary mb-2 me-2">Filter</button>
<a class="btn btn-primary mb-2" href={clearFilterUrl}>Clear</a>
</div>
</div>
</form>
|]
where
boxValue = fromMaybe "" (paramOrNothing "filter") :: Text
clearFilterUrl = path <> Query.renderQuery True newQueryString
where
path = theRequest.rawPathInfo
queryString = theRequest.queryString
newQueryString = queryString
|> removeQueryItem "filter"
-- | Set or replace a query string item
--
-- >>> setQueryValue "page" "1" []
-- [("page", Just "1")]
--
-- >>> setQueryValue "page" "2" [("page", Just "1")]
-- [("page", Just "2")]
--
setQueryValue :: ByteString -> ByteString -> Query.Query -> Query.Query
setQueryValue name value queryString =
case lookup name queryString of
Just existingPage -> queryString
|> map (\(queryItem@(queryItemName, _)) -> if queryItemName == name
then (name, Just value)
else queryItem
)
Nothing -> queryString <> [(name, Just value)]
-- | Removes a query item, specified by the name
--
-- >>> removeQueryItem "filter" [("filter", Just "test")]
-- []
--
removeQueryItem :: ByteString -> Query.Query -> Query.Query
removeQueryItem name queryString = queryString |> filter (\(queryItemName, _) -> queryItemName /= name)
{-| Determine if a Pagination needs to be shown.
If there is only a single page, we shouldn't show a pager.
-}
showPagination :: Pagination -> Bool
showPagination pagination@Pagination {currentPage} =
currentPage /= 1 || hasNextPage pagination || hasPreviousPage pagination