diff options
author | Jasper Van der Jeugt <m@jaspervdj.be> | 2013-01-16 10:50:01 +0100 |
---|---|---|
committer | Jasper Van der Jeugt <m@jaspervdj.be> | 2013-01-16 10:50:01 +0100 |
commit | 652ceb03f1185ad8d41e7a3b91f00e1064bdd4ba (patch) | |
tree | a269f96a06462531678263a0d678457f2b59af70 /src/Hakyll/Web | |
parent | e53ca6724c8f5715792ad6b269ede52f21eb606c (diff) | |
download | hakyll-652ceb03f1185ad8d41e7a3b91f00e1064bdd4ba.tar.gz |
Add applyJoinTemplateList, and a test for it
Diffstat (limited to 'src/Hakyll/Web')
-rw-r--r-- | src/Hakyll/Web/Template/Internal.hs | 26 | ||||
-rw-r--r-- | src/Hakyll/Web/Template/List.hs | 21 |
2 files changed, 35 insertions, 12 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' -------------------------------------------------------------------------------- |