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