Added simple pagination (unstable).

4 files changed, 86 insertions, 11 deletions

diff --git a/hakyll.cabal b/hakyll.cabal
index d2123f1..a01e264 100644
--- a/hakyll.cabal
+++ b/hakyll.cabal
@@ -47,6 +47,7 @@ library
                    Text.Hakyll.Renderable
                    Text.Hakyll.Renderables
                    Text.Hakyll.Page
+                   Text.Hakyll.Paginate
                    Text.Hakyll.Util
                    Text.Hakyll.Tags
                    Text.Hakyll.Internal.Cache
diff --git a/src/Text/Hakyll/Context.hs b/src/Text/Hakyll/Context.hs
index 69816b6..892d5f7 100644
--- a/src/Text/Hakyll/Context.hs
+++ b/src/Text/Hakyll/Context.hs
@@ -27,8 +27,8 @@ type ContextManipulation = Context -> Context
 -- | Do something with a value in a @Context@, but keep the old value as well.
 --   This is probably the most common function to construct a
 --   @ContextManipulation@.
-renderValue :: String -- ^ Key of which the value should be copied.
-            -> String -- ^ Key the value should be copied to.
+renderValue :: String             -- ^ Key of which the value should be copied.
+            -> String             -- ^ Key the value should be copied to.
             -> (String -> String) -- ^ Function to apply on the value.
             -> ContextManipulation
 renderValue src dst f context = case M.lookup src context of
@@ -41,7 +41,7 @@ renderValue src dst f context = case M.lookup src context of
 --   > changeValue "title" (map toUpper)
 --
 --   Will put the title in UPPERCASE.
-changeValue :: String -- ^ Key of which the value should be changed.
+changeValue :: String             -- ^ Key to change.
             -> (String -> String) -- ^ Function to apply on the value.
             -> ContextManipulation
 changeValue key = renderValue key key
diff --git a/src/Text/Hakyll/Paginate.hs b/src/Text/Hakyll/Paginate.hs
new file mode 100644
index 0000000..0f35854
--- /dev/null
+++ b/src/Text/Hakyll/Paginate.hs
@@ -0,0 +1,74 @@
+-- | Module aimed to paginate web pages.
+module Text.Hakyll.Paginate
+    ( PaginateConfiguration (..)
+    , defaultPaginateConfiguration
+    , paginate
+    ) where
+
+import Text.Hakyll.Renderables
+import Text.Hakyll.Renderable (Renderable, getUrl)
+import Text.Hakyll.Util (link)
+
+-- | A configuration for a pagination.
+data PaginateConfiguration = PaginateConfiguration
+    { -- | Label for the link to the previous page.
+      previousLabel :: String
+    , -- | Label for the link to the next page.
+      nextLabel     :: String
+    , -- | Label for the link to the first page.
+      firstLabel    :: String
+    , -- | Label for the link to the last page.
+      lastLabel     :: String
+    }
+
+-- | A simple default configuration for pagination.
+defaultPaginateConfiguration :: PaginateConfiguration
+defaultPaginateConfiguration = PaginateConfiguration
+    { previousLabel = "Previous"
+    , nextLabel     = "Next"
+    , firstLabel    = "First"
+    , lastLabel     = "Last"
+    }
+
+-- | The most important function for pagination. This function operates on a
+--   list of renderables (the pages), and basically just adds fields to them
+--   by combining them with a custom page.
+--
+--   The following metadata fields will be added:
+--
+--   - @$previous@: A link to the previous page.
+--   - @$next@: A link to the next page.
+--   - @$first@: A link to the first page.
+--   - @$last@: A link to the last page.
+--   - @$index@: 1-based index of the current page.
+--   - @$length@: Total number of pages.
+--
+paginate :: (Renderable a)
+         => PaginateConfiguration
+         -> [a]
+         -> [CombinedRenderable a CustomPage]
+paginate configuration renderables = paginate' Nothing renderables (1 :: Int)
+  where
+    linkWithLabel f r = link (f configuration) `fmap` getUrl r
+
+    first = linkWithLabel firstLabel (head renderables)
+    last' = linkWithLabel lastLabel (last renderables)
+    length' = length renderables
+
+    paginate' _ [] _ = []
+    paginate' maybePrev (x:xs) index = 
+        let previous = case maybePrev of
+                (Just r) -> linkWithLabel previousLabel r
+                Nothing  -> return $ previousLabel configuration
+            next = case xs of
+                (n:_) -> linkWithLabel nextLabel n
+                []    -> return $ nextLabel configuration
+            customPage = createCustomPage "" []
+                [ ("previous", Right previous)
+                , ("next", Right next)
+                , ("first", Right first)
+                , ("last", Right last')
+                , ("index", Left $ show index)
+                , ("length", Left $ show length')
+                ]
+        in (x `combine` customPage) : paginate' (Just x) xs (index + 1)
diff --git a/src/Text/Hakyll/Render.hs b/src/Text/Hakyll/Render.hs
index 34e1780..64fc0ab 100644
--- a/src/Text/Hakyll/Render.hs
+++ b/src/Text/Hakyll/Render.hs
@@ -26,9 +26,9 @@ import Text.Hakyll.Internal.CompressCss
 import Text.Hakyll.Internal.Render
 
 -- | Execute an IO action only when the cache is invalid.
-depends :: FilePath -- ^ File to be rendered or created.
+depends :: FilePath   -- ^ File to be rendered or created.
         -> [FilePath] -- ^ Files the render depends on.
-        -> Hakyll () -- ^ IO action to execute when the file is out of date.
+        -> Hakyll ()  -- ^ Action to execute when the file is out of date.
         -> Hakyll ()
 depends file dependencies action = do
     destination <- toDestination file
@@ -37,8 +37,8 @@ depends file dependencies action = do
 
 -- | Render to a Page.
 render :: Renderable a
-       => FilePath -- ^ Template to use for rendering.
-       -> a -- ^ Renderable object to render with given template.
+       => FilePath    -- ^ Template to use for rendering.
+       -> a           -- ^ Renderable object to render with given template.
        -> Hakyll Page -- ^ The body of the result will contain the render.
 render = renderWith id
 
@@ -46,9 +46,9 @@ render = renderWith id
 --   first.
 renderWith :: Renderable a
            => ContextManipulation -- ^ Manipulation to apply on the context.
-           -> FilePath -- ^ Template to use for rendering.
-           -> a -- ^ Renderable object to render with given template.
-           -> Hakyll Page -- ^ The body of the result will contain the render.
+           -> FilePath            -- ^ Template to use for rendering.
+           -> a                   -- ^ Data to render.
+           -> Hakyll Page         -- ^ Result of the render operation.
 renderWith manipulation templatePath renderable = do
     template <- readTemplate templatePath
     context <- toContext renderable
@@ -66,7 +66,7 @@ renderWith manipulation templatePath renderable = do
 --
 renderAndConcat :: Renderable a
                 => [FilePath] -- ^ Templates to apply on every renderable.
-                -> [a] -- ^ Renderables to render.
+                -> [a]        -- ^ Renderables to render.
                 -> Hakyll String
 renderAndConcat = renderAndConcatWith id