mirror of
https://code.sup39.dev/repos/Wqawg
synced 2024-12-29 16:04:51 +09:00
76 lines
2.1 KiB
Haskell
76 lines
2.1 KiB
Haskell
{- This file is part of Vervis.
|
|
-
|
|
- Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
|
|
-
|
|
- ♡ Copying is an act of love. Please copy, reuse and share.
|
|
-
|
|
- The author(s) have dedicated all copyright and related and neighboring
|
|
- rights to this software to the public domain worldwide. This software is
|
|
- distributed without any warranty.
|
|
-
|
|
- You should have received a copy of the CC0 Public Domain Dedication along
|
|
- with this software. If not, see
|
|
- <http://creativecommons.org/publicdomain/zero/1.0/>.
|
|
-}
|
|
|
|
module Vervis.Paginate
|
|
( getPageAndNav
|
|
, navWidget
|
|
)
|
|
where
|
|
|
|
import Prelude
|
|
|
|
import Control.Arrow (second)
|
|
import Data.Default.Class (def)
|
|
import Data.Maybe (fromMaybe)
|
|
import Data.Monoid ((<>))
|
|
import Yesod.Core (MonadHandler (HandlerSite))
|
|
import Yesod.Core.Handler (getCurrentRoute, lookupGetParam)
|
|
import Yesod.Core.Widget (WidgetT)
|
|
|
|
import qualified Data.Text as T (null, pack)
|
|
import qualified Data.Text.Read as TR (decimal)
|
|
|
|
import Data.Functor.Local
|
|
import Data.Paginate.Local
|
|
import Yesod.Paginate.Local
|
|
|
|
navSettings :: NavSettings
|
|
navSettings = def
|
|
|
|
getCurrentPage :: MonadHandler m => m Int
|
|
getCurrentPage = lookupGetParam "page" <&> \ mpage ->
|
|
case mpage of
|
|
Nothing -> 1
|
|
Just page ->
|
|
case second T.null <$> TR.decimal page of
|
|
Right (p, True) -> p
|
|
_ -> 1
|
|
|
|
paginateSettings
|
|
:: MonadHandler m
|
|
=> (Int -> Int -> m (Int, f i))
|
|
-> PaginateSettings m f i
|
|
paginateSettings select = def
|
|
{ psSelect = select
|
|
, psCurrent = getCurrentPage
|
|
}
|
|
|
|
navWidgetSettings :: NavWidgetSettings
|
|
navWidgetSettings = def
|
|
|
|
getPageAndNav
|
|
:: MonadHandler m
|
|
=> (Int -> Int -> m (Int, f i))
|
|
-- ^ Given offset and limit, get total number of items and chosen subset
|
|
-> m (f i, NavModel)
|
|
getPageAndNav select = paginate (paginateSettings select) navSettings
|
|
|
|
navWidget :: NavModel -> WidgetT site IO ()
|
|
navWidget nm = do
|
|
route <-
|
|
fromMaybe (error "Pagination in invalid response content") <$>
|
|
getCurrentRoute
|
|
let url n = (route, "?page=" <> T.pack (show n))
|
|
pageNavWidget nm navWidgetSettings url
|