From 7f7494cd1448ea4c05756abdf2d6dd4d8430cd31 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Sun, 29 May 2011 19:46:29 +0200 Subject: Some prototype work on the Page.List module --- src/Hakyll.hs | 2 ++ src/Hakyll/Core/Compiler.hs | 2 +- src/Hakyll/Web/Page.hs | 10 ------ src/Hakyll/Web/Page/List.hs | 82 +++++++++++++++++++++++++++++++++++++++++++++ src/Hakyll/Web/Tags.hs | 16 +++++---- 5 files changed, 95 insertions(+), 17 deletions(-) create mode 100644 src/Hakyll/Web/Page/List.hs (limited to 'src') diff --git a/src/Hakyll.hs b/src/Hakyll.hs index 341bb53..a91ea73 100644 --- a/src/Hakyll.hs +++ b/src/Hakyll.hs @@ -21,6 +21,7 @@ module Hakyll , module Hakyll.Web.CompressCss , module Hakyll.Web.Feed , module Hakyll.Web.Page + , module Hakyll.Web.Page.List , module Hakyll.Web.Page.Metadata , module Hakyll.Web.Page.Read , module Hakyll.Web.Pandoc @@ -51,6 +52,7 @@ import Hakyll.Web.Blaze import Hakyll.Web.CompressCss import Hakyll.Web.Feed import Hakyll.Web.Page +import Hakyll.Web.Page.List import Hakyll.Web.Page.Metadata import Hakyll.Web.Page.Read import Hakyll.Web.Pandoc diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs index 909f945..28d466c 100644 --- a/src/Hakyll/Core/Compiler.hs +++ b/src/Hakyll/Core/Compiler.hs @@ -230,7 +230,7 @@ getDependency id' = CompilerM $ do Found x -> return x where notFound = - "Hakyll.Core.Compiler.getDependency: " ++ show id' ++ " not found " ++ + "Hakyll.Core.Compiler.getDependency: " ++ show id' ++ " was " "not found in the cache, the cache might be corrupted or " ++ "the item you are referring to might not exist" wrongType e r = diff --git a/src/Hakyll/Web/Page.hs b/src/Hakyll/Web/Page.hs index 1450702..bcc3aba 100644 --- a/src/Hakyll/Web/Page.hs +++ b/src/Hakyll/Web/Page.hs @@ -56,7 +56,6 @@ module Hakyll.Web.Page , pageCompilerWith , pageCompilerWithPandoc , addDefaultFields - , sortByBaseName ) where import Prelude hiding (id) @@ -64,8 +63,6 @@ import Control.Category (id) import Control.Arrow (arr, (>>^), (&&&), (>>>)) import System.FilePath (takeBaseName, takeDirectory) import qualified Data.Map as M -import Data.List (sortBy) -import Data.Ord (comparing) import Text.Pandoc (Pandoc, ParserState, WriterOptions) @@ -137,10 +134,3 @@ addDefaultFields = (getRoute &&& id >>^ uncurry addRoute) . trySetField "path" p where p = toFilePath i - --- | Sort posts based on the basename of the post. This is equivalent to a --- chronologival sort, because of the @year-month-day-title.extension@ naming --- convention in Hakyll. --- -sortByBaseName :: [Page a] -> [Page a] -sortByBaseName = sortBy $ comparing $ takeBaseName . getField "path" diff --git a/src/Hakyll/Web/Page/List.hs b/src/Hakyll/Web/Page/List.hs new file mode 100644 index 0000000..1edb250 --- /dev/null +++ b/src/Hakyll/Web/Page/List.hs @@ -0,0 +1,82 @@ +-- | Provides an easy way to combine several pages in a list. The applications +-- are obvious: +-- +-- * A post list on a blog +-- +-- * An image list in a gallery +-- +-- * A sitemap +-- +module Hakyll.Web.Page.List + ( setFieldPageList + , pageListCompiler + , chronological + , recentFirst + , sortByBaseName + ) where + +import Control.Arrow ((>>>), arr) +import Data.List (sortBy) +import Data.Monoid (Monoid, mconcat) +import Data.Ord (comparing) +import System.FilePath (takeBaseName) + +import Hakyll.Core.Compiler +import Hakyll.Core.Identifier +import Hakyll.Core.Identifier.Pattern +import Hakyll.Web.Page +import Hakyll.Web.Page.Metadata +import Hakyll.Web.Template + +-- | Set a field of a page to a listing of pages +-- +setFieldPageList :: ([Page String] -> [Page String]) + -- ^ Determines list order + -> Identifier Template + -- ^ Applied to every page + -> String + -- ^ Key indicating which field should be set + -> Pattern (Page String) + -- ^ Selects pages to include in the list + -> Compiler (Page String) (Page String) + -- ^ Compiler that sets the page list in a field +setFieldPageList sort template key pattern = + requireAllA pattern $ setFieldA key $ pageListCompiler sort template + +-- | Create a list of pages +-- +pageListCompiler :: ([Page String] -> [Page String]) -- ^ Determine list order + -> Identifier Template -- ^ Applied to pages + -> Compiler [Page String] String -- ^ Compiles page list +pageListCompiler sort template = + arr sort >>> applyTemplateToList template >>> arr concatPages + +-- | Apply a template to every page in a list +-- +applyTemplateToList :: Identifier Template + -> Compiler [Page String] [Page String] +applyTemplateToList identifier = + require identifier $ \posts template -> map (applyTemplate template) posts + +-- | Concatenate the bodies of a page list +-- +concatPages :: Monoid m => [Page m] -> m +concatPages = mconcat . map pageBody + +-- | Sort pages chronologically. This function assumes that the pages have a +-- @year-month-day-title.extension@ naming scheme -- as is the convention in +-- Hakyll. +-- +chronological :: [Page a] -> [Page a] +chronological = sortBy $ comparing $ takeBaseName . getField "path" + +-- | The reverse of 'chronological' +-- +recentFirst :: [Page a] -> [Page a] +recentFirst = reverse . chronological + +-- | Deprecated, see 'chronological' +-- +sortByBaseName :: [Page a] -> [Page a] +sortByBaseName = chronological +{-# DEPRECATED sortByBaseName "Use chronological" #-} diff --git a/src/Hakyll/Web/Tags.hs b/src/Hakyll/Web/Tags.hs index d05256e..6ae47fa 100644 --- a/src/Hakyll/Web/Tags.hs +++ b/src/Hakyll/Web/Tags.hs @@ -111,7 +111,7 @@ readCategory = readTagsWith getCategory -- | Render tags in HTML -- -renderTags :: (String -> Identifier a) +renderTags :: (String -> Identifier (Page a)) -- ^ Produce a link -> (String -> String -> Int -> Int -> Int -> String) -- ^ Produce a tag item: tag, url, count, min count, max count @@ -141,10 +141,14 @@ renderTags makeUrl makeItem concatItems = proc (Tags tags) -> do -- | Render a tag cloud in HTML -- -renderTagCloud :: (String -> Identifier a) -- ^ Produce a link for a tag - -> Double -- ^ Smallest font size, in percent - -> Double -- ^ Biggest font size, in percent - -> Compiler (Tags a) String -- ^ Tag cloud renderer +renderTagCloud :: (String -> Identifier (Page a)) + -- ^ Produce a link for a tag + -> Double + -- ^ Smallest font size, in percent + -> Double + -- ^ Biggest font size, in percent + -> Compiler (Tags a) String + -- ^ Tag cloud renderer renderTagCloud makeUrl minSize maxSize = renderTags makeUrl makeLink (intercalate " ") where @@ -162,7 +166,7 @@ renderTagCloud makeUrl minSize maxSize = -- | Render a simple tag list in HTML, with the tag count next to the item -- -renderTagList :: (String -> Identifier a) -> Compiler (Tags a) (String) +renderTagList :: (String -> Identifier (Page a)) -> Compiler (Tags a) (String) renderTagList makeUrl = renderTags makeUrl makeLink (intercalate ", ") where makeLink tag url count _ _ = renderHtml $ -- cgit v1.2.3