summaryrefslogtreecommitdiff
path: root/src/Hakyll/Web
diff options
context:
space:
mode:
authorJasper Van der Jeugt <m@jaspervdj.be>2014-06-06 13:47:59 +0200
committerJasper Van der Jeugt <m@jaspervdj.be>2014-06-06 13:47:59 +0200
commit74daa49cd532010421d7a35bb2f6fa5de3ad5cb8 (patch)
treeac7306efef83804e0d54ba698ee9fa59a53134e1 /src/Hakyll/Web
parent69a10204c515c6da447a6e1417301d80e17b20be (diff)
downloadhakyll-74daa49cd532010421d7a35bb2f6fa5de3ad5cb8.tar.gz
Draft pagination
Diffstat (limited to 'src/Hakyll/Web')
-rw-r--r--src/Hakyll/Web/Paginate.hs142
-rw-r--r--src/Hakyll/Web/Template/List.hs24
2 files changed, 89 insertions, 77 deletions
diff --git a/src/Hakyll/Web/Paginate.hs b/src/Hakyll/Web/Paginate.hs
index d31dde6..cd35a2d 100644
--- a/src/Hakyll/Web/Paginate.hs
+++ b/src/Hakyll/Web/Paginate.hs
@@ -3,8 +3,8 @@
module Hakyll.Web.Paginate
( PageNumber
, Paginate (..)
- , buildPaginate
, buildPaginateWith
+ , paginateEvery
, paginateRules
, paginateContext
) where
@@ -12,11 +12,9 @@ module Hakyll.Web.Paginate
--------------------------------------------------------------------------------
import Control.Monad (forM_)
-import Data.List (unfoldr)
import qualified Data.Map as M
import Data.Monoid (mconcat)
import qualified Data.Set as S
-import Text.Printf (printf)
--------------------------------------------------------------------------------
@@ -37,99 +35,93 @@ type PageNumber = Int
--------------------------------------------------------------------------------
-- | Data about paginators
data Paginate = Paginate
- { paginatePages :: M.Map PageNumber [Identifier]
- , paginatePlaces :: M.Map Identifier PageNumber
+ { paginateMap :: M.Map PageNumber [Identifier]
, 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 (S.fromList idents))
+paginateNumPages :: Paginate -> Int
+paginateNumPages = M.size . paginateMap
--------------------------------------------------------------------------------
-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 `recentFirst` 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 (S.fromList idents))
+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 $ paginatePages paginator) $ \(idx, identifiers) ->
+ forM_ (M.toList $ paginateMap paginator) $ \(idx, identifiers) ->
rulesExtraDependencies [paginateDependency paginator] $
create [paginateMakeId paginator idx] $
rules idx $ fromList identifiers
--------------------------------------------------------------------------------
--- | Takes first, current, last page and produces index of next page
-type RelPage = PageNumber -> PageNumber -> PageNumber -> Maybe PageNumber
+-- | 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
--------------------------------------------------------------------------------
-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)
+-- | A default paginate context which provides the following keys:
+--
+--
+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
]
+ 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
diff --git a/src/Hakyll/Web/Template/List.hs b/src/Hakyll/Web/Template/List.hs
index f9ccc08..1f2a570 100644
--- a/src/Hakyll/Web/Template/List.hs
+++ b/src/Hakyll/Web/Template/List.hs
@@ -13,6 +13,8 @@ module Hakyll.Web.Template.List
, applyJoinTemplateList
, chronological
, recentFirst
+ , sortChronological
+ , sortRecentFirst
) where
@@ -25,6 +27,7 @@ import System.Locale (defaultTimeLocale)
--------------------------------------------------------------------------------
import Hakyll.Core.Compiler
+import Hakyll.Core.Identifier
import Hakyll.Core.Item
import Hakyll.Core.Metadata
import Hakyll.Web.Template
@@ -65,7 +68,24 @@ chronological =
sortByM f xs = liftM (map fst . sortBy (comparing snd)) $
mapM (\x -> liftM (x,) (f x)) xs
+
--------------------------------------------------------------------------------
-- | The reverse of 'chronological'
-recentFirst :: (MonadMetadata m, Functor m) => [Item a] -> m [Item a]
-recentFirst = fmap reverse . chronological
+recentFirst :: MonadMetadata m => [Item a] -> m [Item a]
+recentFirst = liftM reverse . chronological
+
+
+--------------------------------------------------------------------------------
+-- | Version of 'chronological' which doesn't need the actual items.
+sortChronological
+ :: MonadMetadata m => [Identifier] -> m [Identifier]
+sortChronological ids =
+ liftM (map itemIdentifier) $ chronological [Item i () | i <- ids]
+
+
+--------------------------------------------------------------------------------
+-- | Version of 'recentFirst' which doesn't need the actual items.
+sortRecentFirst
+ :: MonadMetadata m => [Identifier] -> m [Identifier]
+sortRecentFirst ids =
+ liftM (map itemIdentifier) $ recentFirst [Item i () | i <- ids]