Add applyJoinTemplateList, and a test for it

3 files changed, 55 insertions, 14 deletions

diff --git a/src/Hakyll/Web/Template/Internal.hs b/src/Hakyll/Web/Template/Internal.hs
index d0e0859..e264731 100644
--- a/src/Hakyll/Web/Template/Internal.hs
+++ b/src/Hakyll/Web/Template/Internal.hs
@@ -1,37 +1,47 @@
+--------------------------------------------------------------------------------
 -- | Module containing the template data structure
---
-{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}
+{-# LANGUAGE DeriveDataTypeable         #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module Hakyll.Web.Template.Internal
     ( Template (..)
     , TemplateElement (..)
     ) where
 
-import Control.Applicative ((<$>))
 
-import Data.Binary (Binary, get, getWord8, put, putWord8)
-import Data.Typeable (Typeable)
+--------------------------------------------------------------------------------
+import           Control.Applicative  ((<$>))
+import           Data.Binary          (Binary, get, getWord8, put, putWord8)
+import           Data.Typeable        (Typeable)
 
-import Hakyll.Core.Writable
 
+--------------------------------------------------------------------------------
+import           Hakyll.Core.Writable
+
+
+--------------------------------------------------------------------------------
 -- | Datatype used for template substitutions.
---
 newtype Template = Template
     { unTemplate :: [TemplateElement]
     }
     deriving (Show, Eq, Binary, Typeable)
 
+
+--------------------------------------------------------------------------------
 instance Writable Template where
     -- Writing a template is impossible
     write _ _ = return ()
 
+
+--------------------------------------------------------------------------------
 -- | Elements of a template.
---
 data TemplateElement
     = Chunk String
     | Key String
     | Escaped
     deriving (Show, Eq, Typeable)
 
+
+--------------------------------------------------------------------------------
 instance Binary TemplateElement where
     put (Chunk string)    = putWord8 0 >> put string
     put (Key key)  = putWord8 1 >> put key
diff --git a/src/Hakyll/Web/Template/List.hs b/src/Hakyll/Web/Template/List.hs
index e8da74f..6d2a341 100644
--- a/src/Hakyll/Web/Template/List.hs
+++ b/src/Hakyll/Web/Template/List.hs
@@ -9,13 +9,14 @@
 -- * A sitemap
 module Hakyll.Web.Template.List
     ( applyTemplateList
+    , applyJoinTemplateList
     , chronological
     , recentFirst
     ) where
 
 
 --------------------------------------------------------------------------------
-import           Data.List                   (sortBy)
+import           Data.List                   (intersperse, sortBy)
 import           Data.Ord                    (comparing)
 import           System.FilePath             (takeBaseName)
 
@@ -29,14 +30,26 @@ import           Hakyll.Web.Template.Context
 
 
 --------------------------------------------------------------------------------
--- | Set a field of a page to a listing of pages
+-- | Generate a string of a listing of pages, after applying a template to each
+-- page.
 applyTemplateList :: Template
                   -> Context a
                   -> [Item a]
                   -> Compiler String
-applyTemplateList tpl context items = do
+applyTemplateList = applyJoinTemplateList ""
+
+
+--------------------------------------------------------------------------------
+-- | Join a listing of pages with a string in between, after applying a template
+-- to each page.
+applyJoinTemplateList :: String
+                      -> Template
+                      -> Context a
+                      -> [Item a]
+                      -> Compiler String
+applyJoinTemplateList delimiter tpl context items = do
     items' <- mapM (applyTemplate tpl context) items
-    return $ concat $ map itemBody items'
+    return $ concat $ intersperse delimiter $ map itemBody items'
 
 
 --------------------------------------------------------------------------------
diff --git a/tests/Hakyll/Web/Template/Tests.hs b/tests/Hakyll/Web/Template/Tests.hs
index fce5503..6fb5233 100644
--- a/tests/Hakyll/Web/Template/Tests.hs
+++ b/tests/Hakyll/Web/Template/Tests.hs
@@ -9,7 +9,7 @@ module Hakyll.Web.Template.Tests
 import           Data.Monoid                    (mconcat)
 import           Test.Framework                 (Test, testGroup)
 import           Test.Framework.Providers.HUnit (testCase)
-import           Test.HUnit                     (Assertion, (@=?))
+import           Test.HUnit                     (Assertion, (@=?), (@?=))
 
 
 --------------------------------------------------------------------------------
@@ -18,13 +18,16 @@ import           Hakyll.Core.Provider
 import           Hakyll.Web.Pandoc
 import           Hakyll.Web.Template
 import           Hakyll.Web.Template.Context
+import           Hakyll.Web.Template.Internal
+import           Hakyll.Web.Template.List
 import           TestSuite.Util
 
 
 --------------------------------------------------------------------------------
 tests :: Test
 tests = testGroup "Hakyll.Core.Template.Tests"
-    [ testCase "case01" case01
+    [ testCase "case01"                case01
+    , testCase "applyJoinTemplateList" testApplyJoinTemplateList
     ]
 
 
@@ -49,3 +52,18 @@ testContext = mconcat
     [ functionField "echo" (\args _ -> return $ unwords args)
     , defaultContext
     ]
+
+
+--------------------------------------------------------------------------------
+testApplyJoinTemplateList :: Assertion
+testApplyJoinTemplateList = do
+    store    <- newTestStore
+    provider <- newTestProvider store
+    str      <- testCompilerDone store provider "item3" $
+        applyJoinTemplateList ", " tpl defaultContext [i1, i2]
+
+    str @?= "<b>Hello</b>, <b>World</b>"
+  where
+    i1  = Item "item1" "Hello"
+    i2  = Item "item2" "World"
+    tpl = Template [Chunk "<b>", Key "body", Chunk "</b>"]