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 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153
|
--------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
module Hakyll.Web.Paginate
( PageNumber
, Paginate (..)
, buildPaginateWith
, paginateEvery
, paginateRules
, paginateContext
) where
--------------------------------------------------------------------------------
import Control.Applicative (empty)
import Control.Monad (forM_, forM)
import qualified Data.Map as M
import qualified Data.Set as S
--------------------------------------------------------------------------------
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
{ paginateMap :: M.Map PageNumber [Identifier]
, paginateMakeId :: PageNumber -> Identifier
, paginateDependency :: Dependency
}
--------------------------------------------------------------------------------
paginateNumPages :: Paginate -> Int
paginateNumPages = M.size . paginateMap
--------------------------------------------------------------------------------
paginateEvery :: Int -> [a] -> [[a]]
paginateEvery n = go
where
go [] = []
go xs = let (y, ys) = splitAt n xs in y : go ys
--------------------------------------------------------------------------------
buildPaginateWith
:: MonadMetadata m
=> ([Identifier] -> m [[Identifier]]) -- ^ Group items into pages
-> Pattern -- ^ Select items to paginate
-> (PageNumber -> Identifier) -- ^ Identifiers for the pages
-> m Paginate
buildPaginateWith grouper pattern makeId = do
ids <- getMatches pattern
idGroups <- grouper ids
let idsSet = S.fromList ids
return Paginate
{ paginateMap = M.fromList (zip [1 ..] idGroups)
, paginateMakeId = makeId
, paginateDependency = PatternDependency pattern idsSet
}
--------------------------------------------------------------------------------
paginateRules :: Paginate -> (PageNumber -> Pattern -> Rules ()) -> Rules ()
paginateRules paginator rules =
forM_ (M.toList $ paginateMap paginator) $ \(idx, identifiers) ->
rulesExtraDependencies [paginateDependency paginator] $
create [paginateMakeId paginator idx] $
rules idx $ fromList identifiers
--------------------------------------------------------------------------------
-- | Get the identifier for a certain page by passing in the page number.
paginatePage :: Paginate -> PageNumber -> Maybe Identifier
paginatePage pag pageNumber
| pageNumber < 1 = Nothing
| pageNumber > (paginateNumPages pag) = Nothing
| otherwise = Just $ paginateMakeId pag pageNumber
--------------------------------------------------------------------------------
-- | A default paginate context which provides the following keys:
--
--
-- * @firstPageNum@
-- * @firstPageUrl@
-- * @previousPageNum@
-- * @previousPageUrl@
-- * @nextPageNum@
-- * @nextPageUrl@
-- * @lastPageNum@
-- * @lastPageUrl@
-- * @currentPageNum@
-- * @currentPageUrl@
-- * @numPages@
-- * @allPages@
paginateContext :: Paginate -> PageNumber -> Context a
paginateContext pag currentPage = mconcat
[ field "firstPageNum" $ \_ -> otherPage 1 >>= num
, field "firstPageUrl" $ \_ -> otherPage 1 >>= url
, field "previousPageNum" $ \_ -> otherPage (currentPage - 1) >>= num
, field "previousPageUrl" $ \_ -> otherPage (currentPage - 1) >>= url
, field "nextPageNum" $ \_ -> otherPage (currentPage + 1) >>= num
, field "nextPageUrl" $ \_ -> otherPage (currentPage + 1) >>= url
, field "lastPageNum" $ \_ -> otherPage lastPage >>= num
, field "lastPageUrl" $ \_ -> otherPage lastPage >>= url
, field "currentPageNum" $ \i -> thisPage i >>= num
, field "currentPageUrl" $ \i -> thisPage i >>= url
, constField "numPages" $ show $ paginateNumPages pag
, Context $ \k _ i -> case k of
"allPages" -> do
let ctx =
field "isCurrent" (\n -> if fst (itemBody n) == currentPage then return "true" else empty) `mappend`
field "num" (num . itemBody) `mappend`
field "url" (url . itemBody)
list <- forM [1 .. lastPage] $
\n -> if n == currentPage then thisPage i else otherPage n
items <- mapM makeItem list
return $ ListField ctx items
_ -> do
empty
]
where
lastPage = paginateNumPages pag
thisPage i = return (currentPage, itemIdentifier i)
otherPage n
| n == currentPage = fail $ "This is the current page: " ++ show n
| otherwise = case paginatePage pag n of
Nothing -> fail $ "No such page: " ++ show n
Just i -> return (n, i)
num :: (Int, Identifier) -> Compiler String
num = return . show . fst
url :: (Int, Identifier) -> Compiler String
url (n, i) = getRoute i >>= \mbR -> case mbR of
Just r -> return $ toUrl r
Nothing -> fail $ "No URL for page: " ++ show n
|