git.iko.soy/hakyll
on master help sign in
Draft pagination
74daa49Jasper Van der Jeugt
hakyll.cabal+1−1
compare with master
unifiedsplit
@@ -1,5 +1,5 @@
1Name: hakyll
1Name: hakyll
2−Version: 4.5.3.0
2+Version: 4.6.0.0
3
3
4Synopsis: A static website compiler library
4Synopsis: A static website compiler library
5Description:
5Description:
src/Hakyll/Web/Paginate.hs+67−75
@@ -3,8 +3,8 @@
3module Hakyll.Web.Paginate
3module Hakyll.Web.Paginate
4 ( PageNumber
4 ( PageNumber
5 , Paginate (..)
5 , Paginate (..)
6− , buildPaginate
7 , buildPaginateWith
6 , buildPaginateWith
7+ , paginateEvery
8 , paginateRules
8 , paginateRules
9 , paginateContext
9 , paginateContext
10 ) where
10 ) where
@@ -12,11 +12,9 @@ module Hakyll.Web.Paginate
12
12
13--------------------------------------------------------------------------------
13--------------------------------------------------------------------------------
14import Control.Monad (forM_)
14import Control.Monad (forM_)
15−import Data.List (unfoldr)
16import qualified Data.Map as M
15import qualified Data.Map as M
17import Data.Monoid (mconcat)
16import Data.Monoid (mconcat)
18import qualified Data.Set as S
17import qualified Data.Set as S
19−import Text.Printf (printf)
20
18
21
19
22--------------------------------------------------------------------------------
20--------------------------------------------------------------------------------
@@ -37,99 +35,93 @@ type PageNumber = Int
37--------------------------------------------------------------------------------
35--------------------------------------------------------------------------------
38-- | Data about paginators
36-- | Data about paginators
39data Paginate = Paginate
37data Paginate = Paginate
40− { paginatePages :: M.Map PageNumber [Identifier]
38+ { paginateMap :: M.Map PageNumber [Identifier]
41− , paginatePlaces :: M.Map Identifier PageNumber
42 , paginateMakeId :: PageNumber -> Identifier
39 , paginateMakeId :: PageNumber -> Identifier
43 , paginateDependency :: Dependency
40 , paginateDependency :: Dependency
44 } deriving (Show)
41 } deriving (Show)
45
42
46
43
47--------------------------------------------------------------------------------
44--------------------------------------------------------------------------------
48−buildPaginate :: MonadMetadata m
49− => Pattern
50− -> m Paginate
45+paginateNumPages :: Paginate -> Int
51−buildPaginate pattern = do
46+paginateNumPages = M.size . paginateMap
52− idents <- getMatches pattern
53− let pagPages = M.fromList $ zip [1 ..] (map return idents)
54− pagPlaces = M.fromList $ zip idents [1 ..]
55− makeId pn = case M.lookup pn pagPages of
56− Just [id'] -> id'
57− _ -> error $
58− "Hakyll.Web.Paginate.buildPaginate: " ++
59− "invalid page number: " ++ show pn
60−
61− return $ Paginate pagPages pagPlaces makeId
62− (PatternDependency pattern (S.fromList idents))
63
47
64
48
65--------------------------------------------------------------------------------
49--------------------------------------------------------------------------------
50+paginateEvery :: Int -> [a] -> [[a]]
51+paginateEvery n = go
52+ where
53+ go [] = []
54+ go xs = let (y, ys) = splitAt n xs in y : go ys
55+
56+
57+--------------------------------------------------------------------------------
58+buildPaginateWith
66−buildPaginateWith :: MonadMetadata m
59+ :: MonadMetadata m
67− => Int
60+ => ([Identifier] -> m [[Identifier]]) -- ^ Group items into pages
68− -> (PageNumber -> Identifier)
69− -> Pattern
61+ -> Pattern -- ^ Select items to paginate
62+ -> (PageNumber -> Identifier) -- ^ Identifiers for the pages
70− -> m Paginate
63+ -> m Paginate
71−buildPaginateWith n makeId pattern = do
64+buildPaginateWith grouper pattern makeId = do
72− -- TODO: there is no sensible order for `ids` here, for now it's random;
73− -- but it should be `recentFirst` order because most recent posts should
74− -- correspond to 1st paginator page and oldest one to last page
75− idents <- getMatches pattern
65+ ids <- getMatches pattern
76− let pages = flip unfoldr idents $ \xs ->
66+ idGroups <- grouper ids
77− if null xs then Nothing else Just (splitAt n xs)
67+ let idsSet = S.fromList ids
78− nPages = length pages
68+ return Paginate
79− paginatePages' = zip [1..] pages
69+ { paginateMap = M.fromList (zip [1 ..] idGroups)
80− pagPlaces' =
70+ , paginateMakeId = makeId
81− [(ident, idx) | (idx,ids) <- paginatePages', ident <- ids] ++
82− [(makeId i, i) | i <- [1 .. nPages]]
83−
84− return $ Paginate (M.fromList paginatePages') (M.fromList pagPlaces') makeId
85− (PatternDependency pattern (S.fromList idents))
71+ , paginateDependency = PatternDependency pattern idsSet
72+ }
86
73
87
74
88--------------------------------------------------------------------------------
75--------------------------------------------------------------------------------
89paginateRules :: Paginate -> (PageNumber -> Pattern -> Rules ()) -> Rules ()
76paginateRules :: Paginate -> (PageNumber -> Pattern -> Rules ()) -> Rules ()
90paginateRules paginator rules =
77paginateRules paginator rules =
91− forM_ (M.toList $ paginatePages paginator) $ \(idx, identifiers) ->
78+ forM_ (M.toList $ paginateMap paginator) $ \(idx, identifiers) ->
92 rulesExtraDependencies [paginateDependency paginator] $
79 rulesExtraDependencies [paginateDependency paginator] $
93 create [paginateMakeId paginator idx] $
80 create [paginateMakeId paginator idx] $
94 rules idx $ fromList identifiers
81 rules idx $ fromList identifiers
95
82
96
83
97--------------------------------------------------------------------------------
84--------------------------------------------------------------------------------
98−-- | Takes first, current, last page and produces index of next page
85+-- | Get the identifier for a certain page by passing in the page number.
99−type RelPage = PageNumber -> PageNumber -> PageNumber -> Maybe PageNumber
86+paginatePage :: Paginate -> PageNumber -> Maybe Identifier
87+paginatePage pag pageNumber
88+ | pageNumber < 1 = Nothing
89+ | pageNumber > (paginateNumPages pag) = Nothing
90+ | otherwise = Just $ paginateMakeId pag pageNumber
100
91
101
92
102--------------------------------------------------------------------------------
93--------------------------------------------------------------------------------
103−paginateField :: Paginate -> String -> RelPage -> Context a
94+-- | A default paginate context which provides the following keys:
104−paginateField pag fieldName relPage = field fieldName $ \item ->
95+--
105− let identifier = itemIdentifier item
96+--
106− in case M.lookup identifier (paginatePlaces pag) of
97+paginateContext :: Paginate -> PageNumber -> Context a
107− Nothing -> fail $ printf
108− "Hakyll.Web.Paginate: there is no page %s in paginator map."
109− (show identifier)
110− Just pos -> case relPage 1 pos nPages of
111− Nothing -> fail "Hakyll.Web.Paginate: No page here."
112− Just pos' -> do
113− let nextId = paginateMakeId pag pos'
114− mroute <- getRoute nextId
115− case mroute of
116− Nothing -> fail $ printf
117− "Hakyll.Web.Paginate: unable to get route for %s."
118− (show nextId)
119− Just rt -> return $ toUrl rt
120− where
121− nPages = M.size (paginatePages pag)
122−
123−
124−--------------------------------------------------------------------------------
125−paginateContext :: Paginate -> Context a
126−paginateContext pag = mconcat
98+paginateContext pag currentPage = mconcat
127− [ paginateField pag "firstPage"
99+ [ field "firstPageNum" $ \_ -> otherPage 1 >>= num
128− (\f c _ -> if c <= f then Nothing else Just f)
100+ , field "firstPageUrl" $ \_ -> otherPage 1 >>= url
129− , paginateField pag "previousPage"
101+ , field "previousPageNum" $ \_ -> otherPage (currentPage - 1) >>= num
130− (\f c _ -> if c <= f then Nothing else Just (c - 1))
102+ , field "previousPageUrl" $ \_ -> otherPage (currentPage - 1) >>= url
131− , paginateField pag "nextPage"
103+ , field "nextPageNum" $ \_ -> otherPage (currentPage + 1) >>= num
132− (\_ c l -> if c >= l then Nothing else Just (c + 1))
104+ , field "nextPageUrl" $ \_ -> otherPage (currentPage + 1) >>= url
133− , paginateField pag "lastPage"
105+ , field "lastPageNum" $ \_ -> otherPage lastPage >>= num
134− (\_ c l -> if c >= l then Nothing else Just l)
106+ , field "lastPageUrl" $ \_ -> otherPage lastPage >>= url
107+ , field "currentPageNum" $ \i -> thisPage i >>= num
108+ , field "currentPageUrl" $ \i -> thisPage i >>= url
109+ , constField "numPages" $ show $ paginateNumPages pag
135 ]
110 ]
111+ where
112+ lastPage = paginateNumPages pag
113+
114+ thisPage i = return (currentPage, itemIdentifier i)
115+ otherPage n
116+ | n == currentPage = fail $ "This is the current page: " ++ show n
117+ | otherwise = case paginatePage pag n of
118+ Nothing -> fail $ "No such page: " ++ show n
119+ Just i -> return (n, i)
120+
121+ num :: (Int, Identifier) -> Compiler String
122+ num = return . show . fst
123+
124+ url :: (Int, Identifier) -> Compiler String
125+ url (n, i) = getRoute i >>= \mbR -> case mbR of
126+ Just r -> return $ toUrl r
127+ Nothing -> fail $ "No URL for page: " ++ show n
src/Hakyll/Web/Template/List.hs+22−2
@@ -13,6 +13,8 @@ module Hakyll.Web.Template.List
13 , applyJoinTemplateList
13 , applyJoinTemplateList
14 , chronological
14 , chronological
15 , recentFirst
15 , recentFirst
16+ , sortChronological
17+ , sortRecentFirst
16 ) where
18 ) where
17
19
18
20
@@ -25,6 +27,7 @@ import System.Locale (defaultTimeLocale)
25
27
26--------------------------------------------------------------------------------
28--------------------------------------------------------------------------------
27import Hakyll.Core.Compiler
29import Hakyll.Core.Compiler
30+import Hakyll.Core.Identifier
28import Hakyll.Core.Item
31import Hakyll.Core.Item
29import Hakyll.Core.Metadata
32import Hakyll.Core.Metadata
30import Hakyll.Web.Template
33import Hakyll.Web.Template
@@ -65,7 +68,24 @@ chronological =
65 sortByM f xs = liftM (map fst . sortBy (comparing snd)) $
68 sortByM f xs = liftM (map fst . sortBy (comparing snd)) $
66 mapM (\x -> liftM (x,) (f x)) xs
69 mapM (\x -> liftM (x,) (f x)) xs
67
70
71+
68--------------------------------------------------------------------------------
72--------------------------------------------------------------------------------
69-- | The reverse of 'chronological'
73-- | The reverse of 'chronological'
70−recentFirst :: (MonadMetadata m, Functor m) => [Item a] -> m [Item a]
74+recentFirst :: MonadMetadata m => [Item a] -> m [Item a]
71−recentFirst = fmap reverse . chronological
75+recentFirst = liftM reverse . chronological
76+
77+
78+--------------------------------------------------------------------------------
79+-- | Version of 'chronological' which doesn't need the actual items.
80+sortChronological
81+ :: MonadMetadata m => [Identifier] -> m [Identifier]
82+sortChronological ids =
83+ liftM (map itemIdentifier) $ chronological [Item i () | i <- ids]
84+
85+
86+--------------------------------------------------------------------------------
87+-- | Version of 'recentFirst' which doesn't need the actual items.
88+sortRecentFirst
89+ :: MonadMetadata m => [Identifier] -> m [Identifier]
90+sortRecentFirst ids =
91+ liftM (map itemIdentifier) $ recentFirst [Item i () | i <- ids]