@@ -3,8 +3,8 @@
33module Hakyll.Web.Paginate
44 ( PageNumber
55 , Paginate (..)
6− , buildPaginate
76 , buildPaginateWith
7+ , paginateEvery
88 , paginateRules
99 , paginateContext
1010 ) where
@@ -12,11 +12,9 @@ module Hakyll.Web.Paginate
1212
1313--------------------------------------------------------------------------------
1414import Control.Monad (forM_)
15−import Data.List (unfoldr)
1615import qualified Data.Map as M
1716import Data.Monoid (mconcat)
1817import qualified Data.Set as S
19−import Text.Printf (printf)
2018
2119
2220--------------------------------------------------------------------------------
@@ -37,99 +35,93 @@ type PageNumber = Int
3735--------------------------------------------------------------------------------
3836-- | Data about paginators
3937data Paginate = Paginate
40− { paginatePages :: M.Map PageNumber [Identifier]
41− , paginatePlaces :: M.Map Identifier PageNumber
38+ { paginateMap :: M.Map PageNumber [Identifier]
4239 , paginateMakeId :: PageNumber -> Identifier
4340 , paginateDependency :: Dependency
4441 } deriving (Show)
4542
4643
4744--------------------------------------------------------------------------------
48−buildPaginate :: MonadMetadata m
49− => Pattern
50− -> m Paginate
51−buildPaginate pattern = do
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))
45+paginateNumPages :: Paginate -> Int
46+paginateNumPages = M.size . paginateMap
6347
6448
6549--------------------------------------------------------------------------------
66−buildPaginateWith :: MonadMetadata m
67− => Int
68− -> (PageNumber -> Identifier)
69− -> Pattern
70− -> m Paginate
71−buildPaginateWith n makeId pattern = 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
76− let pages = flip unfoldr idents $ \xs ->
77− if null xs then Nothing else Just (splitAt n xs)
78− nPages = length pages
79− paginatePages' = zip [1..] pages
80− pagPlaces' =
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))
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
59+ :: MonadMetadata m
60+ => ([Identifier] -> m [[Identifier]]) -- ^ Group items into pages
61+ -> Pattern -- ^ Select items to paginate
62+ -> (PageNumber -> Identifier) -- ^ Identifiers for the pages
63+ -> m Paginate
64+buildPaginateWith grouper pattern makeId = do
65+ ids <- getMatches pattern
66+ idGroups <- grouper ids
67+ let idsSet = S.fromList ids
68+ return Paginate
69+ { paginateMap = M.fromList (zip [1 ..] idGroups)
70+ , paginateMakeId = makeId
71+ , paginateDependency = PatternDependency pattern idsSet
72+ }
8673
8774
8875--------------------------------------------------------------------------------
8976paginateRules :: Paginate -> (PageNumber -> Pattern -> Rules ()) -> Rules ()
9077paginateRules paginator rules =
91− forM_ (M.toList $ paginatePages paginator) $ \(idx, identifiers) ->
78+ forM_ (M.toList $ paginateMap paginator) $ \(idx, identifiers) ->
9279 rulesExtraDependencies [paginateDependency paginator] $
9380 create [paginateMakeId paginator idx] $
9481 rules idx $ fromList identifiers
9582
9683
9784--------------------------------------------------------------------------------
98−-- | Takes first, current, last page and produces index of next page
99−type RelPage = PageNumber -> PageNumber -> PageNumber -> Maybe PageNumber
85+-- | Get the identifier for a certain page by passing in the page number.
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
10091
10192
10293--------------------------------------------------------------------------------
103−paginateField :: Paginate -> String -> RelPage -> Context a
104−paginateField pag fieldName relPage = field fieldName $ \item ->
105− let identifier = itemIdentifier item
106− in case M.lookup identifier (paginatePlaces pag) of
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
127− [ paginateField pag "firstPage"
128− (\f c _ -> if c <= f then Nothing else Just f)
129− , paginateField pag "previousPage"
130− (\f c _ -> if c <= f then Nothing else Just (c - 1))
131− , paginateField pag "nextPage"
132− (\_ c l -> if c >= l then Nothing else Just (c + 1))
133− , paginateField pag "lastPage"
134− (\_ c l -> if c >= l then Nothing else Just l)
94+-- | A default paginate context which provides the following keys:
95+--
96+--
97+paginateContext :: Paginate -> PageNumber -> Context a
98+paginateContext pag currentPage = mconcat
99+ [ field "firstPageNum" $ \_ -> otherPage 1 >>= num
100+ , field "firstPageUrl" $ \_ -> otherPage 1 >>= url
101+ , field "previousPageNum" $ \_ -> otherPage (currentPage - 1) >>= num
102+ , field "previousPageUrl" $ \_ -> otherPage (currentPage - 1) >>= url
103+ , field "nextPageNum" $ \_ -> otherPage (currentPage + 1) >>= num
104+ , field "nextPageUrl" $ \_ -> otherPage (currentPage + 1) >>= url
105+ , field "lastPageNum" $ \_ -> otherPage lastPage >>= num
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
135110 ]
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