Some prototype work on the Page.List module

5 files changed, 95 insertions, 17 deletions

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 $