4 files changed, 136 insertions, 0 deletions
diff --git a/src/Hakyll/Web/Template/Internal.hs b/src/Hakyll/Web/Template/Internal.hs
new file mode 100644
index 0000000..d0e0859
--- /dev/null
+++ b/src/Hakyll/Web/Template/Internal.hs
@@ -0,0 +1,45 @@
+-- | 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
+    | 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
+    put (Escaped) = putWord8 2
+
+    get = getWord8 >>= \tag -> case tag of
+            0 -> Chunk <$> get
+            1 -> Key   <$> get
+            2 -> return Escaped
+            _ -> error $  "Hakyll.Web.Template.Internal: "
+                       ++ "Error reading cached template"
diff --git a/src/Hakyll/Web/Template/Read.hs b/src/Hakyll/Web/Template/Read.hs
new file mode 100644
index 0000000..421b7e9
--- /dev/null
+++ b/src/Hakyll/Web/Template/Read.hs
@@ -0,0 +1,10 @@
+-- | Re-exports all different template reading modules
+--
+module Hakyll.Web.Template.Read
+    ( readTemplate
+    , readHamletTemplate
+    , readHamletTemplateWith
+    ) where
+
+import Hakyll.Web.Template.Read.Hakyll
+import Hakyll.Web.Template.Read.Hamlet
diff --git a/src/Hakyll/Web/Template/Read/Hakyll.hs b/src/Hakyll/Web/Template/Read/Hakyll.hs
new file mode 100644
index 0000000..fecf772
--- /dev/null
+++ b/src/Hakyll/Web/Template/Read/Hakyll.hs
@@ -0,0 +1,35 @@
+-- | Read templates in Hakyll's native format
+--
+module Hakyll.Web.Template.Read.Hakyll
+    ( readTemplate
+    ) where
+
+import Data.List (isPrefixOf)
+import Data.Char (isAlphaNum)
+
+import Hakyll.Web.Template.Internal
+
+-- | Construct a @Template@ from a string.
+--
+readTemplate :: String -> Template
+readTemplate = Template . readTemplate'
+  where
+    readTemplate' [] = []
+    readTemplate' string
+        | "$$" `isPrefixOf` string =
+            Escaped : readTemplate' (drop 2 string)
+        | "$" `isPrefixOf` string =
+            case readKey (drop 1 string) of
+                Just (key, rest) -> Key key : readTemplate' rest
+                Nothing          -> Chunk "$" : readTemplate' (drop 1 string)
+        | otherwise =
+            let (chunk, rest) = break (== '$') string
+            in Chunk chunk : readTemplate' rest
+
+    -- Parse an key into (key, rest) if it's valid, and return
+    -- Nothing otherwise
+    readKey string =
+        let (key, rest) = span isAlphaNum string
+        in if not (null key) && "$" `isPrefixOf` rest
+            then Just (key, drop 1 rest)
+            else Nothing
diff --git a/src/Hakyll/Web/Template/Read/Hamlet.hs b/src/Hakyll/Web/Template/Read/Hamlet.hs
new file mode 100644
index 0000000..7b496de
--- /dev/null
+++ b/src/Hakyll/Web/Template/Read/Hamlet.hs
@@ -0,0 +1,46 @@
+-- | Read templates in the hamlet format
+--
+{-# LANGUAGE MultiParamTypeClasses #-}
+module Hakyll.Web.Template.Read.Hamlet
+    ( readHamletTemplate
+    , readHamletTemplateWith
+    ) where
+
+import Text.Hamlet (HamletSettings (..), defaultHamletSettings)
+import Text.Hamlet.RT
+
+import Hakyll.Web.Template.Internal
+
+-- | Read a hamlet template using the default settings
+--
+readHamletTemplate :: String -> Template
+readHamletTemplate = readHamletTemplateWith defaultHamletSettings
+
+-- | Read a hamlet template using the specified settings
+--
+readHamletTemplateWith :: HamletSettings -> String -> Template
+readHamletTemplateWith settings string =
+    let result = parseHamletRT settings string
+    in case result of
+        Just hamlet -> fromHamletRT hamlet
+        Nothing     -> error
+            "Hakyll.Web.Template.Read.Hamlet.readHamletTemplateWith: \
+            \Could not parse Hamlet file"
+
+-- | Convert a 'HamletRT' to a 'Template'
+--
+fromHamletRT :: HamletRT  -- ^ Hamlet runtime template
+             -> Template  -- ^ Hakyll template
+fromHamletRT (HamletRT sd) = Template $ map fromSimpleDoc sd
+  where
+    fromSimpleDoc :: SimpleDoc -> TemplateElement
+    fromSimpleDoc (SDRaw chunk) = Chunk chunk
+    fromSimpleDoc (SDVar [var]) = Key var
+    fromSimpleDoc (SDVar _) = error
+        "Hakyll.Web.Template.Read.Hamlet.fromHamletRT: \
+        \Hakyll does not support '.' in identifier names when using \
+        \hamlet templates."
+    fromSimpleDoc _ = error
+        "Hakyll.Web.Template.Read.Hamlet.fromHamletRT: \
+        \Only simple $key$ identifiers are allowed when using hamlet \
+        \templates."