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 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
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
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)
]