Basic pagination for Vervis

This commit is contained in:
fr33domlover 2016-05-11 14:42:41 +00:00
parent 117034a8fa
commit 17c4ff3d23
5 changed files with 131 additions and 16 deletions

32
src/Data/Functor/Local.hs Normal file
View file

@ -0,0 +1,32 @@
{- 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 Data.Functor.Local
( fwith
, (<&>)
)
where
import Prelude
-- | Flipped 'fmap'.
fwith :: Functor f => f a -> (a -> b) -> f b
fwith = flip fmap
-- | Flipped '<$>'.
(<&>) :: Functor f => f a -> (a -> b) -> f b
(<&>) = flip (<$>)
infixr 4 <&>

View file

@ -98,10 +98,10 @@ data PaginateSettings m f i = PaginateSettings
, psPer :: Int
}
instance Monad m => Default (PaginateSettings m f i) where
instance Default (PaginateSettings m f i) where
def = PaginateSettings
{ psSelect = \ _ _ -> error "You didn't implement psSelect"
, psCurrent = return 1
{ psSelect = error "You didn't implement psSelect"
, psCurrent = error "You didn't implement psCurrent"
, psPer = 30
}

74
src/Vervis/Paginate.hs Normal file
View file

@ -0,0 +1,74 @@
{- 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
( getPaginated
)
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
getPaginated
:: MonadHandler m
=> (Int -> Int -> m (Int, f i))
-- ^ Given offset and limit, get total number of items and chosen subset
-> m (f i, WidgetT (HandlerSite m) IO ())
getPaginated select = do
(items, nm) <- paginate (paginateSettings select) navSettings
route <-
fromMaybe (error "Pagination in invalid response content") <$>
getCurrentRoute
let url n = (route, "?page=" <> T.pack (show n))
widget = pageNavWidget nm navWidgetSettings url
return (items, widget)

View file

@ -30,6 +30,7 @@ import Prelude
import Data.Default.Class
import Data.Text (Text)
import Text.Blaze (ToMarkup)
import Yesod.Core (RenderRoute (..))
import Yesod.Core.Widget (WidgetT, whamlet)
@ -65,18 +66,24 @@ instance Default NavWidgetSettings where
}
pageNavWidget
:: NavModel
:: ToMarkup t
=> NavModel
-> NavWidgetSettings
-> (Int -> Route site)
-> (Int -> (Route site, t))
-> WidgetT site IO ()
pageNavWidget nm nws route =
[whamlet|
pageNavWidget nm nws mklink =
let link n label =
let (route, suffix) = mklink n
in [whamlet|
<a href=@{route}#{suffix}>#{label}
|]
in [whamlet|
<ul>
$if nmFirst nm
<li>
<a href=@{route 1}>#{nwsFirst nws}
^{link 1 $ nwsFirst nws}
<li>#{nwsCurrent nws (nmCurrent nm) (nmTotal nm)}
$if nmLast nm
<li>
<a href=@{route $ nmTotal nm}>#{nwsLast nws $ nmTotal nm}
^{link (nmTotal nm) (nwsLast nws $ nmTotal nm)}
|]

View file

@ -43,6 +43,7 @@ library
Data.ByteString.Local
Data.Char.Local
Data.EventTime.Local
Data.Functor.Local
Data.Git.Local
Data.Hourglass.Local
Data.List.Local
@ -86,6 +87,7 @@ library
Vervis.MediaType
Vervis.Model
Vervis.Model.Repo
Vervis.Paginate
Vervis.Path
Vervis.Readme
Vervis.Render