Add hamlet templates and restructure tests

5 files changed, 108 insertions, 30 deletions

diff --git a/src/Hakyll/Web.hs b/src/Hakyll/Web.hs
index 4172283..f991e21 100644
--- a/src/Hakyll/Web.hs
+++ b/src/Hakyll/Web.hs
@@ -12,12 +12,16 @@ import Prelude hiding (id)
 import Control.Category (id)
 import Control.Arrow (arr, (>>>), (>>^), (&&&))
 
+import Text.Hamlet (HamletSettings, defaultHamletSettings)
+
 import Hakyll.Core.Compiler
 import Hakyll.Core.Writable
 import Hakyll.Core.Identifier
 import Hakyll.Web.Page
 import Hakyll.Web.Pandoc
 import Hakyll.Web.Template
+import Hakyll.Web.Template.Read.Hakyll
+import Hakyll.Web.Template.Read.Hamlet
 import Hakyll.Web.RelativizeUrls
 import Hakyll.Web.Util.String
 import Hakyll.Web.CompressCss
@@ -36,6 +40,14 @@ defaultTemplateRead :: Compiler () Template
 defaultTemplateRead = cached "Hakyll.Web.defaultTemplateRead" $
     getResourceString >>^ readTemplate
 
+defaultHamletTemplateRead :: Compiler () Template
+defaultHamletTemplateRead = defaultHamletTemplateReadWith defaultHamletSettings
+
+defaultHamletTemplateReadWith :: HamletSettings -> Compiler () Template
+defaultHamletTemplateReadWith settings =
+    cached "Hakyll.Web.defaultHamletTemplateReadWith" $
+        getResourceString >>^ readHamletTemplateWith settings
+
 defaultCopyFile :: Compiler () CopyFile
 defaultCopyFile = getIdentifier >>^ CopyFile . toFilePath
 
diff --git a/src/Hakyll/Web/Page.hs b/src/Hakyll/Web/Page.hs
index a7c237a..c7de026 100644
--- a/src/Hakyll/Web/Page.hs
+++ b/src/Hakyll/Web/Page.hs
@@ -6,6 +6,7 @@
 module Hakyll.Web.Page
     ( Page (..)
     , fromBody
+    , fromMap
     , toMap
     , pageRead
     , addDefaultFields
@@ -15,6 +16,7 @@ import Prelude hiding (id)
 import Control.Category (id)
 import Control.Arrow ((>>^), (&&&), (>>>))
 import System.FilePath (takeBaseName, takeDirectory)
+import Data.Monoid (Monoid, mempty)
 import Data.Map (Map)
 import qualified Data.Map as M
 
@@ -30,6 +32,11 @@ import Hakyll.Web.Util.String
 fromBody :: a -> Page a
 fromBody = Page M.empty
 
+-- | Create a metadata page, without a body
+--
+fromMap :: Monoid a => Map String String -> Page a
+fromMap m = Page m mempty
+
 -- | Convert a page to a map. The body will be placed in the @body@ key.
 --
 toMap :: Page String -> Map String String
diff --git a/src/Hakyll/Web/Template.hs b/src/Hakyll/Web/Template.hs
index 06fa8d4..83fd7eb 100644
--- a/src/Hakyll/Web/Template.hs
+++ b/src/Hakyll/Web/Template.hs
@@ -1,46 +1,19 @@
 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.Template.Read.Hakyll (readTemplate)
 import Hakyll.Web.Page
 
--- | 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 readIdentifier (drop 1 string) of
-                Just (key, rest) -> Identifier key : readTemplate' rest
-                Nothing          -> Chunk "$" : readTemplate' (drop 1 string)
-        | otherwise =
-            let (chunk, rest) = break (== '$') string
-            in Chunk chunk : readTemplate' rest
-
-    -- Parse an identifier into (identifier, rest) if it's valid, and return
-    -- Nothing otherwise
-    readIdentifier string =
-        let (identifier, rest) = span isAlphaNum string
-        in if not (null identifier) && "$" `isPrefixOf` rest
-            then Just (identifier, drop 1 rest)
-            else Nothing
-
 -- | 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.
+-- "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 =
diff --git a/src/Hakyll/Web/Template/Read/Hakyll.hs b/src/Hakyll/Web/Template/Read/Hakyll.hs
new file mode 100644
index 0000000..fbbfee2
--- /dev/null
+++ b/src/Hakyll/Web/Template/Read/Hakyll.hs
@@ -0,0 +1,36 @@
+-- | Read templates in Hakyll's native format
+--
+module Hakyll.Web.Template.Read.Hakyll
+    ( readTemplate
+    ) where
+
+import Data.List (isPrefixOf)
+import Data.Char (isAlphaNum)
+import Data.Maybe (fromMaybe)
+
+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 readIdentifier (drop 1 string) of
+                Just (key, rest) -> Identifier key : readTemplate' rest
+                Nothing          -> Chunk "$" : readTemplate' (drop 1 string)
+        | otherwise =
+            let (chunk, rest) = break (== '$') string
+            in Chunk chunk : readTemplate' rest
+
+    -- Parse an identifier into (identifier, rest) if it's valid, and return
+    -- Nothing otherwise
+    readIdentifier string =
+        let (identifier, rest) = span isAlphaNum string
+        in if not (null identifier) && "$" `isPrefixOf` rest
+            then Just (identifier, 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..1c9bbf6
--- /dev/null
+++ b/src/Hakyll/Web/Template/Read/Hamlet.hs
@@ -0,0 +1,50 @@
+-- | Read templates in the hamlet format
+--
+{-# LANGUAGE MultiParamTypeClasses #-}
+module Hakyll.Web.Template.Read.Hamlet
+    ( readHamletTemplate
+    , readHamletTemplateWith
+    ) where
+
+import Control.Monad.Trans (liftIO)
+import System.FilePath (takeExtension)
+
+import Text.Hamlet (HamletSettings (..), defaultHamletSettings)
+import Text.Hamlet.RT
+import Control.Failure
+
+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]) = Identifier 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."