Initial incomplete pagination model

src/Data/Paginate/Local.hs

@@ -0,0 +1,159 @@
+{- 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.Paginate.Local
+    ( -- * Settings
+      -- ** Jump settings
+      JumpSettings ()
+    , jumpMin
+    , jumpFactor
+    , jumpRound
+      -- ** Navigation settings
+    , NavSettings ()
+    , navEdges
+    , navJump
+    , navNext
+      -- ** Pagination settings
+    , PaginateSettings ()
+    , psSelect
+    , psCurrent
+    , psPer
+      -- * Results
+      -- ** Navigation controls
+    , NavModel ()
+    , nmFirst
+    , nmPrevJumps
+    , nmPrev
+    , nmCurrent
+    , nmTotal
+    , nmNext
+    , nmNextJumps
+    , nmLast
+      -- ** Paginate
+    , paginate
+    )
+where
+
+import Prelude
+
+import Data.Default.Class
+import Data.Ratio
+
+data JumpSettings = JumpSettings
+    { -- | Minimal jump size to display. Smaller jumps will be discarded.
+      jumpMin    :: Int
+      -- | Ratio of size of consecutive jumps.
+    , jumpFactor :: Ratio Int
+      -- | Round jump page numbers to be multiples of this number. 1 means no
+      -- rounding. 10 means all jumps will be to page numbers that are
+      -- multiples of 10. And so on.
+    , jumpRound  :: Int
+    }
+
+instance Default JumpSettings where
+    def = JumpSettings
+        { jumpMin    = 10
+        , jumpFactor = 2 % 3
+        , jumpRound  = 10
+        }
+
+data NavSettings = NavSettings
+    { -- | Whether to always show links to first and last pages
+      navEdges :: Bool
+      -- | Whether and how to show jump links
+    , navJump  :: Maybe JumpSettings
+      -- | Number of next\/prev page links to show on each side of the current
+      -- page.
+    , navNext  :: Int
+    }
+
+instance Default NavSettings where
+    def = NavSettings
+        { navEdges = True
+        , navJump  = Just def
+        , navNext  = 3
+        }
+
+data PaginateSettings m f i = PaginateSettings
+    { -- | Get the total number of items being paginated, and given an offset
+      -- and a limit, get the specified subset of the items. The offset tells
+      -- you how many items to skip from the beginning of the list, and then
+      -- the limit says how many items you should take after skipping.
+      psSelect  :: Int -> Int -> m (Int, f i)
+      -- | Get the current page
+    , psCurrent :: m Int
+      -- | How many items to list in one page
+    , psPer     :: Int
+    }
+
+instance Monad m => Default (PaginateSettings m f i) where
+    def = PaginateSettings
+        { psSelect  = \ _ _ -> error "You didn't implement psSelect"
+        , psCurrent = return 1
+        , psPer     = 30
+        }
+
+data NavModel = NavModel
+    {
+      nmFirst     :: Bool
+    , nmPrevJumps :: [Int]
+    , nmPrev      :: [Int]
+    , nmCurrent   :: Int
+    , nmTotal     :: Int
+    , nmNext      :: [Int]
+    , nmNextJumps :: [Int]
+    , nmLast      :: Bool
+    }
+
+-- | Given the number of items per page and the current page number, determine
+-- the offset and limit.
+subseq :: Int -> Int -> (Int, Int)
+subseq per curr =
+    let offset = (curr - 1) * per
+        limit = per
+    in  (offset, limit)
+
+navModel :: NavSettings -> Int -> Int -> NavModel
+navModel ns curr total = NavModel
+    { nmFirst     = navEdges ns
+    , nmPrevJumps = [] --TODO
+    , nmPrev      =
+        if curr == 1 || navNext ns < 1
+            then []
+            else [max 1 (curr - navNext ns) .. curr - 1]
+    , nmCurrent   = curr
+    , nmTotal     = total
+    , nmNext      =
+        if curr >= total || navNext ns < 1
+            then []
+            else [curr + 1 .. min total (curr + navNext ns)]
+    , nmNextJumps = [] --TODO
+    , nmLast      = navEdges ns
+    }
+
+-- | Get a page's contents and its navigation controls.
+paginate
+    :: Monad m
+    => PaginateSettings m f i
+    -- ^ How to get the page contents and split them into pages
+    -> NavSettings
+    -- ^ How to build page navigation controls for the user interface
+    -> m (f i, NavModel)
+    -- ^ The items in the current page, and the navigation controls
+paginate ps ns = do
+    curr <- psCurrent ps
+    let (offset, limit) = subseq (psPer ps) curr
+    (total, items) <- psSelect ps offset limit
+    return (items, navModel ns curr total)

src/Yesod/Paginate/Local.hs

@@ -0,0 +1,82 @@
+{- 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 Yesod.Paginate.Local
+    ( -- * Settings
+      NavWidgetSettings ()
+    , nwsFirst
+    , nwsLast
+    , nwsPrev
+    , nwsNext
+    , nwsCurrent
+      -- * Widget
+    , pageNavWidget
+    )
+where
+
+import Prelude
+
+import Data.Default.Class
+import Data.Text (Text)
+import Yesod.Core (RenderRoute (..))
+import Yesod.Core.Widget (WidgetT, whamlet)
+
+import qualified Formatting as F
+
+import Data.Paginate.Local
+
+-- | Settings for building a UI page navigation widget.
+data NavWidgetSettings = NavWidgetSettings
+    { -- | Label for the first page link. Examples: 1, First, ≪, ⋘.
+      nwsFirst   :: Text
+      -- | Label for the last page link. The parameter is the number of the
+      -- last page. Examples: The page number, Last, ≫, ⋙.
+    , nwsLast    :: Int -> Text
+      -- | Label for the previous page link. The parameter is the page number.
+      -- Examples: The page number, Previous, <, ≪.
+    , nwsPrev    :: Int -> Text
+      -- | Label for the next page link. The parameter is the page number.
+      -- Examples: The page number, Next, >, ≫.
+    , nwsNext    :: Int -> Text
+      -- | Label for the current page. The parameters are the current page
+      -- number, and the total number of pages. Example: /Page 3 of 8/.
+    , nwsCurrent :: Int -> Int -> Text
+    }
+
+instance Default NavWidgetSettings where
+    def = NavWidgetSettings
+        { nwsFirst   = "≪"
+        , nwsLast    = \ _ -> "≫"
+        , nwsPrev    = \ _ -> "<"
+        , nwsNext    = \ _ -> ">"
+        , nwsCurrent = F.sformat (F.int F.% " / " F.% F.int)
+        }
+
+pageNavWidget
+    :: NavModel
+    -> NavWidgetSettings
+    -> (Int -> Route site)
+    -> WidgetT site IO ()
+pageNavWidget nm nws route =
+    [whamlet|
+        <ul>
+          $if nmFirst nm
+            <li>
+              <a href=@{route 1}>#{nwsFirst nws}
+          <li>#{nwsCurrent nws (nmCurrent nm) (nmTotal nm)}
+          $if nmLast nm
+            <li>
+              <a href=@{route $ nmTotal nm}>#{nwsLast nws $ nmTotal nm}
+    |]

vervis.cabal

@@ -46,12 +46,15 @@ library
                        Data.Git.Local
                        Data.Hourglass.Local
                        Data.List.Local
+                       Data.Paginate.Local
                        Data.Text.UTF8.Local
                        Data.Text.Lazy.UTF8.Local
                        Data.Time.Clock.Local
                        Network.SSH.Local
                        Text.FilePath.Local
                        Text.Jasmine.Local
+                       Yesod.Paginate.Local
+
                        Vervis.Application
                        Vervis.BinaryBody
                        Vervis.Changes
@@ -136,6 +139,8 @@ library
                        -- unmaintained and darcs has its own copy
                      , darcs
                      , data-default
+                       -- for Data.Paginate.Local
+                     , data-default-class
                      , directory
                        -- for Data.Git.Local
                      , directory-tree