on master help sign in
Add Template module
commit686de03ebf1daafc244ce6d8823be37675843e6d authorJasper Van der Jeugt <jaspervdj@gmail.com> dateThu 30 Dec 2010, 21:19 (16 years ago) parente49cd3b
2 files changed+93
src/Hakyll/Web/Template.hs+49 src/Hakyll/Web/Template/Internal.hs+44
src/Hakyll/Web/Template.hsnew file+49
@@ -0,0 +1,49 @@
1+module Hakyll.Web.Template
2+ ( Template
3+ , readTemplate
4+ , applyTemplate
5+ , applySelf
6+ ) where
7+
8+import Data.List (isPrefixOf)
9+import Data.Char (isAlphaNum)
10+import Data.Maybe (fromMaybe)
11+import qualified Data.Map as M
12+
13+import Hakyll.Web.Template.Internal
14+import Hakyll.Web.Page
15+
16+-- | Construct a @Template@ from a string.
17+--
18+readTemplate :: String -> Template
19+readTemplate = Template . readTemplate'
20+ where
21+ readTemplate' [] = []
22+ readTemplate' string
23+ | "$$" `isPrefixOf` string =
24+ EscapeCharacter : (readTemplate' $ drop 2 string)
25+ | "$" `isPrefixOf` string =
26+ let (key, rest) = span isAlphaNum $ drop 1 string
27+ in Identifier key : readTemplate' rest
28+ | otherwise =
29+ let (chunk, rest) = break (== '$') string
30+ in Chunk chunk : readTemplate' rest
31+
32+-- | Substitutes @$identifiers@ in the given @Template@ by values from the given
33+-- "Page". When a key is not found, it is left as it is. You can specify
34+-- the characters used to replace escaped dollars (@$$@) here.
35+--
36+applyTemplate :: Template -> Page String -> Page String
37+applyTemplate template page =
38+ fmap (const $ substitute =<< unTemplate template) page
39+ where
40+ substitute (Chunk chunk) = chunk
41+ substitute (Identifier key) =
42+ fromMaybe ('$' : key) $ M.lookup key $ toMap page
43+ substitute (EscapeCharacter) = "$"
44+
45+-- | Apply a page as it's own template. This is often very useful to fill in
46+-- certain keys like @$root@ and @$url@.
47+--
48+applySelf :: Page String -> Page String
49+applySelf page = applyTemplate (readTemplate $ pageBody page) page
src/Hakyll/Web/Template/Internal.hsnew file+44
@@ -0,0 +1,44 @@
1+-- | Module containing the template data structure
2+--
3+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}
4+module Hakyll.Web.Template.Internal
5+ ( Template (..)
6+ , TemplateElement (..)
7+ ) where
8+
9+import Control.Applicative ((<$>))
10+
11+import Data.Binary (Binary, get, getWord8, put, putWord8)
12+import Data.Typeable (Typeable)
13+
14+import Hakyll.Core.Writable
15+
16+-- | Datatype used for template substitutions.
17+--
18+newtype Template = Template
19+ { unTemplate :: [TemplateElement]
20+ }
21+ deriving (Show, Eq, Binary, Typeable)
22+
23+instance Writable Template where
24+ -- Writing a template is impossible
25+ write _ _ = return ()
26+
27+-- | Elements of a template.
28+--
29+data TemplateElement
30+ = Chunk String
31+ | Identifier String
32+ | EscapeCharacter
33+ deriving (Show, Eq, Typeable)
34+
35+instance Binary TemplateElement where
36+ put (Chunk string) = putWord8 0 >> put string
37+ put (Identifier key) = putWord8 1 >> put key
38+ put (EscapeCharacter) = putWord8 2
39+
40+ get = getWord8 >>= \tag -> case tag of
41+ 0 -> Chunk <$> get
42+ 1 -> Identifier <$> get
43+ 2 -> return EscapeCharacter
44+ _ -> error "Error reading cached template"