diff options
-rw-r--r-- | src/Hakyll/Web/Template/Internal.hs | 26 | ||||
-rw-r--r-- | src/Hakyll/Web/Template/List.hs | 21 | ||||
-rw-r--r-- | tests/Hakyll/Web/Template/Tests.hs | 22 |
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>"] |