summaryrefslogtreecommitdiff
path: root/src/Hakyll/Web
diff options
context:
space:
mode:
Diffstat (limited to 'src/Hakyll/Web')
-rw-r--r--src/Hakyll/Web/Html.hs1
-rw-r--r--src/Hakyll/Web/Paginate.hs147
-rw-r--r--src/Hakyll/Web/Pandoc.hs1
-rw-r--r--src/Hakyll/Web/Tags.hs8
-rw-r--r--src/Hakyll/Web/Template/List.hs24
5 files changed, 99 insertions, 82 deletions
diff --git a/src/Hakyll/Web/Html.hs b/src/Hakyll/Web/Html.hs
index ba62eb8..1abd742 100644
--- a/src/Hakyll/Web/Html.hs
+++ b/src/Hakyll/Web/Html.hs
@@ -125,6 +125,7 @@ toSiteRoot = emptyException . joinPath . map parent
emptyException x = x
relevant "." = False
relevant "/" = False
+ relevant "./" = False
relevant _ = True
diff --git a/src/Hakyll/Web/Paginate.hs b/src/Hakyll/Web/Paginate.hs
index eafd3a9..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,10 +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 Text.Printf (printf)
+import qualified Data.Set as S
--------------------------------------------------------------------------------
@@ -36,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 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 `resectFirst` 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 idents)
+paginateEvery :: Int -> [a] -> [[a]]
+paginateEvery n = go
+ where
+ go [] = []
+ go xs = let (y, ys) = splitAt n xs in y : go ys
--------------------------------------------------------------------------------
-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
+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
+ }
--------------------------------------------------------------------------------
--- | Takes first, current, last page and produces index of next page
-type RelPage = PageNumber -> PageNumber -> PageNumber -> Maybe PageNumber
+paginateRules :: Paginate -> (PageNumber -> Pattern -> Rules ()) -> Rules ()
+paginateRules paginator rules =
+ forM_ (M.toList $ paginateMap paginator) $ \(idx, identifiers) ->
+ rulesExtraDependencies [paginateDependency paginator] $
+ create [paginateMakeId paginator idx] $
+ rules idx $ fromList identifiers
--------------------------------------------------------------------------------
-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)
+-- | 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
--------------------------------------------------------------------------------
-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/Pandoc.hs b/src/Hakyll/Web/Pandoc.hs
index 1615167..78df1df 100644
--- a/src/Hakyll/Web/Pandoc.hs
+++ b/src/Hakyll/Web/Pandoc.hs
@@ -53,6 +53,7 @@ readPandocWith ropt item = fmap (reader ropt (itemFileType item)) item
LaTeX -> readLaTeX ro
LiterateHaskell t' -> reader (addExt ro Ext_literate_haskell) t'
Markdown -> readMarkdown ro
+ OrgMode -> readOrg ro
Rst -> readRST ro
Textile -> readTextile ro
_ -> error $
diff --git a/src/Hakyll/Web/Tags.hs b/src/Hakyll/Web/Tags.hs
index 0fa182c..0887856 100644
--- a/src/Hakyll/Web/Tags.hs
+++ b/src/Hakyll/Web/Tags.hs
@@ -71,6 +71,7 @@ import qualified Data.Map as M
import Data.Maybe (catMaybes, fromMaybe)
import Data.Monoid (mconcat)
import Data.Ord (comparing)
+import qualified Data.Set as S
import System.FilePath (takeBaseName, takeDirectory)
import Text.Blaze.Html (toHtml, toValue, (!))
import Text.Blaze.Html.Renderer.String (renderHtml)
@@ -124,7 +125,8 @@ buildTagsWith :: MonadMetadata m
buildTagsWith f pattern makeId = do
ids <- getMatches pattern
tagMap <- foldM addTags M.empty ids
- return $ Tags (M.toList tagMap) makeId (PatternDependency pattern ids)
+ let set' = S.fromList ids
+ return $ Tags (M.toList tagMap) makeId (PatternDependency pattern set')
where
-- Create a tag map for one page
addTags tagMap id' = do
@@ -148,8 +150,8 @@ buildCategories = buildTagsWith getCategory
tagsRules :: Tags -> (String -> Pattern -> Rules ()) -> Rules ()
tagsRules tags rules =
forM_ (tagsMap tags) $ \(tag, identifiers) ->
- create [tagsMakeId tags tag] $
- rulesExtraDependencies [tagsDependency tags] $
+ rulesExtraDependencies [tagsDependency tags] $
+ create [tagsMakeId tags tag] $
rules tag $ fromList identifiers
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]
generated by cgit v1.2.3 (git 2.39.1) at 2025-01-06 11:56:47 +0000