2 files changed, 93 insertions, 0 deletions
diff --git a/src/Hakyll/Web/Template.hs b/src/Hakyll/Web/Template.hs
new file mode 100644
index 0000000..586d0b6
--- /dev/null
+++ b/src/Hakyll/Web/Template.hs
@@ -0,0 +1,49 @@
+module Hakyll.Web.Template
+    ( Template
+    , readTemplate
+    , applyTemplate
+    , applySelf
+    ) where
+
+import Data.List (isPrefixOf)
+import Data.Char (isAlphaNum)
+import Data.Maybe (fromMaybe)
+import qualified Data.Map as M
+
+import Hakyll.Web.Template.Internal
+import Hakyll.Web.Page
+
+-- | Construct a @Template@ from a string.
+--
+readTemplate :: String -> Template
+readTemplate = Template . readTemplate'
+  where
+    readTemplate' [] = []
+    readTemplate' string
+        | "$$" `isPrefixOf` string =
+            EscapeCharacter : (readTemplate' $ drop 2 string)
+        | "$" `isPrefixOf` string =
+            let (key, rest) = span isAlphaNum $ drop 1 string
+            in Identifier key : readTemplate' rest
+        | otherwise =
+            let (chunk, rest) = break (== '$') string
+            in Chunk chunk : readTemplate' rest
+
+-- | Substitutes @$identifiers@ in the given @Template@ by values from the given
+--   "Page". When a key is not found, it is left as it is. You can specify
+--   the characters used to replace escaped dollars (@$$@) here.
+--
+applyTemplate :: Template -> Page String -> Page String
+applyTemplate template page =
+    fmap (const $ substitute =<< unTemplate template) page
+  where
+    substitute (Chunk chunk) = chunk
+    substitute (Identifier key) =
+        fromMaybe ('$' : key) $ M.lookup key $ toMap page
+    substitute (EscapeCharacter) = "$"
+
+-- | Apply a page as it's own template. This is often very useful to fill in
+-- certain keys like @$root@ and @$url@.
+--
+applySelf :: Page String -> Page String
+applySelf page = applyTemplate (readTemplate $ pageBody page) page
diff --git a/src/Hakyll/Web/Template/Internal.hs b/src/Hakyll/Web/Template/Internal.hs
new file mode 100644
index 0000000..43df1db
--- /dev/null
+++ b/src/Hakyll/Web/Template/Internal.hs
@@ -0,0 +1,44 @@
+-- | Module containing the template data structure
+--
+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}
+module Hakyll.Web.Template.Internal
+    ( Template (..)
+    , TemplateElement (..)
+    ) where
+
+import Control.Applicative ((<$>))
+
+import Data.Binary (Binary, get, getWord8, put, putWord8)
+import Data.Typeable (Typeable)
+
+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
+    | Identifier String
+    | EscapeCharacter
+    deriving (Show, Eq, Typeable)
+
+instance Binary TemplateElement where
+    put (Chunk string)    = putWord8 0 >> put string
+    put (Identifier key)  = putWord8 1 >> put key
+    put (EscapeCharacter) = putWord8 2
+
+    get = getWord8 >>= \tag -> case tag of
+            0 -> Chunk <$> get
+            1 -> Identifier <$> get
+            2 -> return EscapeCharacter
+            _ -> error "Error reading cached template"