1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
|
--------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
module Hakyll.Web.Paginate
( PageNumber
, Paginate (..)
, buildPaginate
, buildPaginateWith
, paginateRules
, paginateContext
) where
--------------------------------------------------------------------------------
import Control.Monad (forM_)
import Data.List (unfoldr)
import qualified Data.Map as M
import Data.Monoid (mconcat)
import Text.Printf (printf)
--------------------------------------------------------------------------------
import Hakyll.Core.Compiler
import Hakyll.Core.Identifier
import Hakyll.Core.Identifier.Pattern
import Hakyll.Core.Item
import Hakyll.Core.Metadata
import Hakyll.Core.Rules
import Hakyll.Web.Html
import Hakyll.Web.Template.Context
--------------------------------------------------------------------------------
type PageNumber = Int
--------------------------------------------------------------------------------
-- | Data about paginators
data Paginate = Paginate
{ paginatePages :: M.Map PageNumber [Identifier]
, paginatePlaces :: M.Map Identifier PageNumber
, paginateMakeId :: PageNumber -> Identifier
, paginateDependency :: Dependency
} deriving (Show)
--------------------------------------------------------------------------------
buildPaginate :: MonadMetadata m
=> Pattern
-> m Paginate
buildPaginate pattern = do
idents <- getMatches pattern
let pagPages = M.fromList $ zip [1 ..] (map return idents)
pagPlaces = M.fromList $ zip idents [1 ..]
makeId pn = case M.lookup pn pagPages of
Just [id'] -> id'
_ -> error $
"Hakyll.Web.Paginate.buildPaginate: " ++
"invalid page number: " ++ show pn
return $ Paginate pagPages pagPlaces makeId
(PatternDependency pattern idents)
--------------------------------------------------------------------------------
buildPaginateWith :: MonadMetadata m
=> Int
-> (PageNumber -> Identifier)
-> Pattern
-> m Paginate
buildPaginateWith n makeId pattern = do
-- TODO: there is no sensible order for `ids` here, for now it's random;
-- but it should be `resectFirst` order because most recent posts should
-- correspond to 1st paginator page and oldest one to last page
idents <- getMatches pattern
let pages = flip unfoldr idents $ \xs ->
if null xs then Nothing else Just (splitAt n xs)
nPages = length pages
paginatePages' = zip [1..] pages
pagPlaces' =
[(ident, idx) | (idx,ids) <- paginatePages', ident <- ids] ++
[(makeId i, i) | i <- [1 .. nPages]]
return $ Paginate (M.fromList paginatePages') (M.fromList pagPlaces') makeId
(PatternDependency pattern idents)
--------------------------------------------------------------------------------
paginateRules :: Paginate -> (PageNumber -> Pattern -> Rules ()) -> Rules ()
paginateRules paginator rules =
forM_ (M.toList $ paginatePages paginator) $ \(idx, identifiers) ->
create [paginateMakeId paginator idx] $
rulesExtraDependencies [paginateDependency paginator] $
rules idx $ fromList identifiers
--------------------------------------------------------------------------------
-- | Takes first, current, last page and produces index of next page
type RelPage = PageNumber -> PageNumber -> PageNumber -> Maybe PageNumber
--------------------------------------------------------------------------------
paginateField :: Paginate -> String -> RelPage -> Context a
paginateField pag fieldName relPage = field fieldName $ \item ->
let identifier = itemIdentifier item
in case M.lookup identifier (paginatePlaces pag) of
Nothing -> fail $ printf
"Hakyll.Web.Paginate: there is no page %s in paginator map."
(show identifier)
Just pos -> case relPage 1 pos nPages of
Nothing -> fail "Hakyll.Web.Paginate: No page here."
Just pos' -> do
let nextId = paginateMakeId pag pos'
mroute <- getRoute nextId
case mroute of
Nothing -> fail $ printf
"Hakyll.Web.Paginate: unable to get route for %s."
(show nextId)
Just rt -> return $ toUrl rt
where
nPages = M.size (paginatePages pag)
--------------------------------------------------------------------------------
paginateContext :: Paginate -> Context a
paginateContext pag = mconcat
[ paginateField pag "firstPage"
(\f c _ -> if c <= f then Nothing else Just f)
, paginateField pag "previousPage"
(\f c _ -> if c <= f then Nothing else Just (c - 1))
, paginateField pag "nextPage"
(\_ c l -> if c >= l then Nothing else Just (c + 1))
, paginateField pag "lastPage"
(\_ c l -> if c >= l then Nothing else Just l)
]
|
