{-# 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 Paginate = Paginate
{ Paginate -> Map PageNumber [Identifier]
paginateMap :: M.Map PageNumber [Identifier]
, Paginate -> PageNumber -> Identifier
paginateMakeId :: PageNumber -> Identifier
, Paginate -> Dependency
paginateDependency :: Dependency
}
paginateNumPages :: Paginate -> Int
paginateNumPages :: Paginate -> PageNumber
paginateNumPages = forall k a. Map k a -> PageNumber
M.size forall b c a. (b -> c) -> (a -> b) -> a -> c
. Paginate -> Map PageNumber [Identifier]
paginateMap
paginateEvery :: Int -> [a] -> [[a]]
paginateEvery :: forall a. PageNumber -> [a] -> [[a]]
paginateEvery PageNumber
n = forall {a}. [a] -> [[a]]
go
where
go :: [a] -> [[a]]
go [] = []
go [a]
xs = let ([a]
y, [a]
ys) = forall a. PageNumber -> [a] -> ([a], [a])
splitAt PageNumber
n [a]
xs in [a]
y forall a. a -> [a] -> [a]
: [a] -> [[a]]
go [a]
ys
buildPaginateWith
:: MonadMetadata m
=> ([Identifier] -> m [[Identifier]])
-> Pattern
-> (PageNumber -> Identifier)
-> m Paginate
buildPaginateWith :: forall (m :: * -> *).
MonadMetadata m =>
([Identifier] -> m [[Identifier]])
-> Pattern -> (PageNumber -> Identifier) -> m Paginate
buildPaginateWith [Identifier] -> m [[Identifier]]
grouper Pattern
pattern PageNumber -> Identifier
makeId = do
[Identifier]
ids <- forall (m :: * -> *). MonadMetadata m => Pattern -> m [Identifier]
getMatches Pattern
pattern
[[Identifier]]
idGroups <- [Identifier] -> m [[Identifier]]
grouper [Identifier]
ids
let idsSet :: Set Identifier
idsSet = forall a. Ord a => [a] -> Set a
S.fromList [Identifier]
ids
forall (m :: * -> *) a. Monad m => a -> m a
return Paginate
{ paginateMap :: Map PageNumber [Identifier]
paginateMap = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (forall a b. [a] -> [b] -> [(a, b)]
zip [PageNumber
1 ..] [[Identifier]]
idGroups)
, paginateMakeId :: PageNumber -> Identifier
paginateMakeId = PageNumber -> Identifier
makeId
, paginateDependency :: Dependency
paginateDependency = Pattern -> Set Identifier -> Dependency
PatternDependency Pattern
pattern Set Identifier
idsSet
}
paginateRules :: Paginate -> (PageNumber -> Pattern -> Rules ()) -> Rules ()
paginateRules :: Paginate -> (PageNumber -> Pattern -> Rules ()) -> Rules ()
paginateRules Paginate
paginator PageNumber -> Pattern -> Rules ()
rules =
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k a. Map k a -> [(k, a)]
M.toList forall a b. (a -> b) -> a -> b
$ Paginate -> Map PageNumber [Identifier]
paginateMap Paginate
paginator) forall a b. (a -> b) -> a -> b
$ \(PageNumber
idx, [Identifier]
identifiers) ->
forall a. [Dependency] -> Rules a -> Rules a
rulesExtraDependencies [Paginate -> Dependency
paginateDependency Paginate
paginator] forall a b. (a -> b) -> a -> b
$
[Identifier] -> Rules () -> Rules ()
create [Paginate -> PageNumber -> Identifier
paginateMakeId Paginate
paginator PageNumber
idx] forall a b. (a -> b) -> a -> b
$
PageNumber -> Pattern -> Rules ()
rules PageNumber
idx forall a b. (a -> b) -> a -> b
$ [Identifier] -> Pattern
fromList [Identifier]
identifiers
paginatePage :: Paginate -> PageNumber -> Maybe Identifier
paginatePage :: Paginate -> PageNumber -> Maybe Identifier
paginatePage Paginate
pag PageNumber
pageNumber
| PageNumber
pageNumber forall a. Ord a => a -> a -> Bool
< PageNumber
1 = forall a. Maybe a
Nothing
| PageNumber
pageNumber forall a. Ord a => a -> a -> Bool
> (Paginate -> PageNumber
paginateNumPages Paginate
pag) = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Paginate -> PageNumber -> Identifier
paginateMakeId Paginate
pag PageNumber
pageNumber
paginateContext :: Paginate -> PageNumber -> Context a
paginateContext :: forall a. Paginate -> PageNumber -> Context a
paginateContext Paginate
pag PageNumber
currentPage = forall a. Monoid a => [a] -> a
mconcat
[ forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
"firstPageNum" forall a b. (a -> b) -> a -> b
$ \Item a
_ -> forall {m :: * -> *}.
MonadFail m =>
PageNumber -> m (PageNumber, Identifier)
otherPage PageNumber
1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (PageNumber, Identifier) -> Compiler [Char]
num
, forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
"firstPageUrl" forall a b. (a -> b) -> a -> b
$ \Item a
_ -> forall {m :: * -> *}.
MonadFail m =>
PageNumber -> m (PageNumber, Identifier)
otherPage PageNumber
1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (PageNumber, Identifier) -> Compiler [Char]
url
, forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
"previousPageNum" forall a b. (a -> b) -> a -> b
$ \Item a
_ -> forall {m :: * -> *}.
MonadFail m =>
PageNumber -> m (PageNumber, Identifier)
otherPage (PageNumber
currentPage forall a. Num a => a -> a -> a
- PageNumber
1) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (PageNumber, Identifier) -> Compiler [Char]
num
, forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
"previousPageUrl" forall a b. (a -> b) -> a -> b
$ \Item a
_ -> forall {m :: * -> *}.
MonadFail m =>
PageNumber -> m (PageNumber, Identifier)
otherPage (PageNumber
currentPage forall a. Num a => a -> a -> a
- PageNumber
1) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (PageNumber, Identifier) -> Compiler [Char]
url
, forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
"nextPageNum" forall a b. (a -> b) -> a -> b
$ \Item a
_ -> forall {m :: * -> *}.
MonadFail m =>
PageNumber -> m (PageNumber, Identifier)
otherPage (PageNumber
currentPage forall a. Num a => a -> a -> a
+ PageNumber
1) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (PageNumber, Identifier) -> Compiler [Char]
num
, forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
"nextPageUrl" forall a b. (a -> b) -> a -> b
$ \Item a
_ -> forall {m :: * -> *}.
MonadFail m =>
PageNumber -> m (PageNumber, Identifier)
otherPage (PageNumber
currentPage forall a. Num a => a -> a -> a
+ PageNumber
1) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (PageNumber, Identifier) -> Compiler [Char]
url
, forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
"lastPageNum" forall a b. (a -> b) -> a -> b
$ \Item a
_ -> forall {m :: * -> *}.
MonadFail m =>
PageNumber -> m (PageNumber, Identifier)
otherPage PageNumber
lastPage forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (PageNumber, Identifier) -> Compiler [Char]
num
, forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
"lastPageUrl" forall a b. (a -> b) -> a -> b
$ \Item a
_ -> forall {m :: * -> *}.
MonadFail m =>
PageNumber -> m (PageNumber, Identifier)
otherPage PageNumber
lastPage forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (PageNumber, Identifier) -> Compiler [Char]
url
, forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
"currentPageNum" forall a b. (a -> b) -> a -> b
$ \Item a
i -> forall {m :: * -> *} {a}.
Monad m =>
Item a -> m (PageNumber, Identifier)
thisPage Item a
i forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (PageNumber, Identifier) -> Compiler [Char]
num
, forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
"currentPageUrl" forall a b. (a -> b) -> a -> b
$ \Item a
i -> forall {m :: * -> *} {a}.
Monad m =>
Item a -> m (PageNumber, Identifier)
thisPage Item a
i forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (PageNumber, Identifier) -> Compiler [Char]
url
, forall a. [Char] -> [Char] -> Context a
constField [Char]
"numPages" forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ Paginate -> PageNumber
paginateNumPages Paginate
pag
, forall a.
([Char] -> [[Char]] -> Item a -> Compiler ContextField)
-> Context a
Context forall a b. (a -> b) -> a -> b
$ \[Char]
k [[Char]]
_ Item a
i -> case [Char]
k of
[Char]
"allPages" -> do
let ctx :: Context (PageNumber, Identifier)
ctx =
forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
"isCurrent" (\Item (PageNumber, Identifier)
n -> if forall a b. (a, b) -> a
fst (forall a. Item a -> a
itemBody Item (PageNumber, Identifier)
n) forall a. Eq a => a -> a -> Bool
== PageNumber
currentPage then forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
"true" else forall (f :: * -> *) a. Alternative f => f a
empty) forall a. Monoid a => a -> a -> a
`mappend`
forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
"num" ((PageNumber, Identifier) -> Compiler [Char]
num forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Item a -> a
itemBody) forall a. Monoid a => a -> a -> a
`mappend`
forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
"url" ((PageNumber, Identifier) -> Compiler [Char]
url forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Item a -> a
itemBody)
[(PageNumber, Identifier)]
list <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [PageNumber
1 .. PageNumber
lastPage] forall a b. (a -> b) -> a -> b
$
\PageNumber
n -> if PageNumber
n forall a. Eq a => a -> a -> Bool
== PageNumber
currentPage then forall {m :: * -> *} {a}.
Monad m =>
Item a -> m (PageNumber, Identifier)
thisPage Item a
i else forall {m :: * -> *}.
MonadFail m =>
PageNumber -> m (PageNumber, Identifier)
otherPage PageNumber
n
[Item (PageNumber, Identifier)]
items <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. a -> Compiler (Item a)
makeItem [(PageNumber, Identifier)]
list
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Context a -> [Item a] -> ContextField
ListField Context (PageNumber, Identifier)
ctx [Item (PageNumber, Identifier)]
items
[Char]
_ -> do
forall (f :: * -> *) a. Alternative f => f a
empty
]
where
lastPage :: PageNumber
lastPage = Paginate -> PageNumber
paginateNumPages Paginate
pag
thisPage :: Item a -> m (PageNumber, Identifier)
thisPage Item a
i = forall (m :: * -> *) a. Monad m => a -> m a
return (PageNumber
currentPage, forall a. Item a -> Identifier
itemIdentifier Item a
i)
otherPage :: PageNumber -> m (PageNumber, Identifier)
otherPage PageNumber
n
| PageNumber
n forall a. Eq a => a -> a -> Bool
== PageNumber
currentPage = forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"This is the current page: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show PageNumber
n
| Bool
otherwise = case Paginate -> PageNumber -> Maybe Identifier
paginatePage Paginate
pag PageNumber
n of
Maybe Identifier
Nothing -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"No such page: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show PageNumber
n
Just Identifier
i -> forall (m :: * -> *) a. Monad m => a -> m a
return (PageNumber
n, Identifier
i)
num :: (Int, Identifier) -> Compiler String
num :: (PageNumber, Identifier) -> Compiler [Char]
num = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst
url :: (Int, Identifier) -> Compiler String
url :: (PageNumber, Identifier) -> Compiler [Char]
url (PageNumber
n, Identifier
i) = Identifier -> Compiler (Maybe [Char])
getRoute Identifier
i forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe [Char]
mbR -> case Maybe [Char]
mbR of
Just [Char]
r -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
toUrl [Char]
r
Maybe [Char]
Nothing -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"No URL for page: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show PageNumber
n