@@ -1,206 +0,0 @@
1−{-# LANGUAGE OverloadedStrings #-}
3−module Hakyll.Web.Paginator
6− , NavigationLinkType(..)
11− , renderPaginatorWith
16−--------------------------------------------------------------------------------
17−import Control.Monad (forM, forM_)
18−import Data.List (intercalate, unfoldr)
19−import Data.Monoid ((<>))
20−import Data.Maybe (fromMaybe)
21−import qualified Data.Map as M
22−import Text.Blaze.Html (toHtml, toValue, (!))
23−import Text.Printf (printf)
24−import Text.Blaze.Html.Renderer.String (renderHtml)
25−import qualified Text.Blaze.Html5 as H
26−import qualified Text.Blaze.Html5.Attributes as A
29−--------------------------------------------------------------------------------
30−import Hakyll.Core.Compiler
31−import Hakyll.Core.Identifier
32−import Hakyll.Core.Identifier.Pattern
33−import Hakyll.Core.Metadata
34−import Hakyll.Core.Rules
35−import Hakyll.Web.Template.Context
36−import Hakyll.Core.Item
37−import Hakyll.Web.Html
39−-- | Data about paginators
40−data Paginator = Paginator
41− { pagPages :: M.Map Int [Identifier]
42− , pagPlaces :: M.Map Identifier Int
43− , pagMakeId :: PagState -> Identifier
44− , pagDependency :: Dependency
47−data PagState = PagState { pagPos :: Int
50−buildPaginatorWith :: MonadMetadata m
52− -> (PagState -> Identifier)
55−buildPaginatorWith n makeId pattern = do
56− -- TODO: there is no sensible order for `ids` here, for now it's random;
57− -- but it should be `resectFirst` order because most recent posts should
58− -- correspond to 1st paginator page and oldest one to last page
59− idents <- getMatches pattern
60− let pages = unfoldr f idents
63− f x = Just $ splitAt n x
64− nPages = length pages
65− pagPages' = zip [1..] pages
66− pagPlaces' = [(ident, idx) | (idx,ids) <- pagPages', ident <- ids] ++
67− [(makeId (PagState i nPages), i) | i <- [1 .. nPages]]
68− return $ Paginator (M.fromList pagPages') (M.fromList pagPlaces') makeId
69− (PatternDependency pattern idents)
71−--------------------------------------------------------------------------------
73−buildPaginator :: MonadMetadata m => Pattern -> m Paginator
74−buildPaginator = buildPaginatorWith 5 makeId
76− makeId (PagState pos n) = fromFilePath $ "index" ++ makeIndex pos n ++ ".html"
77− makeIndex i n = let nils = replicate (length (show n) - length (show i)) '0'
80−--------------------------------------------------------------------------------
82−paginatorRules :: Paginator -> (PagState -> Pattern -> Rules ()) -> Rules ()
83−paginatorRules paginator rules =
84− forM_ (M.toList $ pagPages paginator) $ \(idx, identifiers) ->
85− let pagState = PagState idx (M.size $ pagPages paginator)
86− in create [pagMakeId paginator pagState] $
87− rulesExtraDependencies [pagDependency paginator] $
88− rules pagState $ fromList identifiers
90−--------------------------------------------------------------------------------
92−data NavigationLinkType = NFirst | NPrev | NNext | NLast
94−instance Show NavigationLinkType where
95− show NFirst = "first"
100−renderPaginatorWith :: (String -> Int -> Int -> Int -> String)
101− -- ^ Produce a paginator menu item: url, index of menu element,
102− -- index of current page, amount of pages
103− -> (String -> NavigationLinkType -> Int -> String)
104− -- ^ Produce fast navigation links: url, type of navigation
105− -- element (e.g. last, prev...), index of corresponding page
106− -> ([String] -> String)
111−renderPaginatorWith makeHtml navigationHtml concatHtml paginator (PagState i n) = do
112− pags' <- forM (M.toList $ pagPages paginator) $ \(idx,_) -> do
113− let pagState = PagState idx (M.size $ pagPages paginator)
115− url <- getRoute $ pagMakeId paginator pagState
118− let -- Create a link for one item
119− makeHtml' (url, idx) =
120− makeHtml (toUrl $ fromMaybe "/" url) idx i n
122− -- Fast-travel links logic: first, prev, next, last (<< < > >>)
123− navIdxs = [1, max 1 (i-1), min (i+1) n, n]
124− navIds = [NFirst, NPrev, NNext, NLast]
125− navUrls = map (\idx -> toFilePath $ pagMakeId paginator (PagState idx n))
127− navHtmlCode = zipWith3 navigationHtml navUrls navIds navIdxs
130− else take 2 navHtmlCode
133− else drop 2 navHtmlCode
135− return $ concatHtml $ navLefts ++ map makeHtml' pags' ++ navRights
137−renderPaginator :: Paginator -> PagState -> Compiler String
139− renderPaginatorWith makeHtml navigationHtml concatHtml
141− navigationHtml url navType _idx =
142− let (caption, alt) = arrow navType
143− in renderHtml $ H.a ! (A.href (toValue url) <>
144− A.title (toValue alt))
147− arrow :: NavigationLinkType -> (String, String)
148− arrow NPrev = ("<" , "prev")
149− arrow NNext = (">" , "next")
150− arrow NFirst = ("<<", "first")
151− arrow NLast = (">>", "last")
152− concatHtml = intercalate " " . filter (not . null)
153− makeHtml url menuItemIdx pageIdx nPages
154− | menuItemIdx == pageIdx = show menuItemIdx
155− | not shouldBeDisplayed = ""
157− let caption = show menuItemIdx
158− in renderHtml $ H.a ! (A.href (toValue url) <>
159− A.title (toValue caption))
165− in abs (menuItemIdx - pageIdx) <= leg
166− || pageIdx - leg <= 0 && menuItemIdx - width <= 0
167− || pageIdx + leg >= nPages && menuItemIdx + width >= nPages
170−paginatorField :: Paginator -> String -> NavigationLinkType -> Context a
171−paginatorField pag fieldName arrowType = field fieldName $ \item -> do
172− let identifier = itemIdentifier item
173− nPages = M.size (pagPages pag)
175− neededPage NNext pos | pos+1 > nPages = Nothing
176− neededPage NNext pos = Just (pos + 1)
178− neededPage NPrev pos | pos-1 < 1 = Nothing
179− neededPage NPrev pos = Just (pos - 1)
181− neededPage NFirst pos | pos == 1 = Nothing
182− neededPage NFirst _ = Just 1
184− neededPage NLast pos | pos == nPages = Nothing
185− neededPage NLast _ = Just nPages
187− case M.lookup identifier (pagPlaces pag) of
188− Nothing -> error $ printf "Hakyll.Web.Paginator: there is no page %s in paginator map."
190− Just pos -> case neededPage arrowType pos of
191− Nothing -> fail $ printf "There is no %s page for page %s in position %s."
192− (show arrowType) (show identifier) (show pos)
194− let nextId = pagMakeId pag (PagState pos' nPages)
195− mroute <- getRoute nextId
197− Nothing -> error $ printf "Hakyll.Web.Paginator: unable to get route of identifier %s."
199− Just rt -> return $ toUrl rt
201−paginatorFields :: Paginator -> Context a
202−paginatorFields pag = paginatorField pag "firstPage" NFirst
203− <> paginatorField pag "prevPage" NPrev
204− <> paginatorField pag "nextPage" NNext
205− <> paginatorField pag "lastPage" NLast