{- This file is part of Vervis. - - Written in 2016 by fr33domlover . - - ♡ 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 - . -} 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