Hamlet support (experimental)

3 files changed, 87 insertions, 26 deletions

diff --git a/src/Text/Hakyll/Internal/Template.hs b/src/Text/Hakyll/Internal/Template.hs
index bd8db2c..54636ee 100644
--- a/src/Text/Hakyll/Internal/Template.hs
+++ b/src/Text/Hakyll/Internal/Template.hs
@@ -10,8 +10,6 @@ module Text.Hakyll.Internal.Template
 import Control.Applicative ((<$>))
 import Data.List (isPrefixOf)
 import Data.Char (isAlphaNum)
-import Data.Binary
-import Control.Monad (liftM, liftM2)
 import Data.Maybe (fromMaybe)
 import System.FilePath ((</>))
 import qualified Data.Map as M
@@ -20,13 +18,8 @@ import Text.Hakyll.Context (Context (..))
 import Text.Hakyll.HakyllMonad (Hakyll)
 import Text.Hakyll.Internal.Cache
 import Text.Hakyll.Internal.Page
-
--- | Datatype used for template substitutions.
-data Template = Chunk String Template
-              | Identifier String Template
-              | EscapeCharacter Template
-              | End
-              deriving (Show, Read, Eq)
+import Text.Hakyll.Internal.Template.Template
+import Text.Hakyll.Internal.Template.Hamlet
 
 -- | Construct a @Template@ from a string.
 fromString :: String -> Template
@@ -48,14 +41,20 @@ readTemplate path = do
     if isCacheMoreRecent'
         then getFromCache fileName
         else do
-            page <- unContext <$> readPage path
-            let body = fromMaybe (error $ "No body in template " ++ fileName)
-                                 (M.lookup "body" page)
-                template = fromString body
+            template <- if isHamletRTFile path
+                            then readHamletTemplate
+                            else readDefaultTemplate
             storeInCache template fileName
             return template
   where 
     fileName = "templates" </> path
+    readDefaultTemplate = do
+        page <- unContext <$> readPage path
+        let body = fromMaybe (error $ "No body in template " ++ fileName)
+                             (M.lookup "body" page)
+        return $ fromString body
+
+    readHamletTemplate = fromHamletRT <$> readHamletRT path
 
 -- | Substitutes @$identifiers@ in the given @Template@ by values from the given
 --   "Context". When a key is not found, it is left as it is. You can specify
@@ -80,16 +79,3 @@ regularSubstitute = substitute "$$"
 --   escaped characters.
 finalSubstitute :: Template -> Context -> String
 finalSubstitute = substitute "$"
-    
-instance Binary Template where
-    put (Chunk string template) = put (0 :: Word8) >> put string >> put template
-    put (Identifier key template) = put (1 :: Word8) >> put key >> put template
-    put (EscapeCharacter template) = put (2 :: Word8) >> put template
-    put (End) = put (3 :: Word8)
-
-    get = do tag <- getWord8
-             case tag of 0 -> liftM2 Chunk get get
-                         1 -> liftM2 Identifier get get
-                         2 -> liftM EscapeCharacter get
-                         3 -> return End
-                         _ -> error "Error reading template"
diff --git a/src/Text/Hakyll/Internal/Template/Hamlet.hs b/src/Text/Hakyll/Internal/Template/Hamlet.hs
new file mode 100644
index 0000000..35c8e20
--- /dev/null
+++ b/src/Text/Hakyll/Internal/Template/Hamlet.hs
@@ -0,0 +1,44 @@
+-- | Support for Hamlet templates in Hakyll.
+--
+module Text.Hakyll.Internal.Template.Hamlet
+    ( isHamletRTFile
+    , readHamletRT
+    , fromHamletRT
+    ) where
+
+import Data.List (intercalate)
+import Control.Monad.Trans (liftIO)
+import System.FilePath (takeExtension)
+
+import Text.Hamlet.RT
+
+import Text.Hakyll.Internal.Template.Template
+import Text.Hakyll.HakyllMonad (Hakyll, askHakyll, hamletSettings)
+
+-- | Determine if a file is a hamlet template by extension.
+--
+isHamletRTFile :: FilePath -> Bool
+isHamletRTFile fileName = takeExtension fileName `elem` [".hamlet", ".hml"]
+
+-- | Read a 'HamletRT' by file name.
+--
+readHamletRT :: FilePath         -- ^ Filename of the template
+             -> Hakyll HamletRT  -- ^ Resulting hamlet template
+readHamletRT fileName = do
+    settings <- askHakyll hamletSettings
+    string <- liftIO $ readFile fileName
+    liftIO $ parseHamletRT settings string 
+
+
+-- | Convert a 'HamletRT' to a 'Template'
+--
+fromHamletRT :: HamletRT  -- ^ Hamlet runtime template
+             -> Template  -- ^ Hakyll template
+fromHamletRT (HamletRT sd) = fromSimpleDoc sd
+  where
+    fromSimpleDoc :: [SimpleDoc] -> Template
+    fromSimpleDoc [] = End
+    fromSimpleDoc (SDRaw chunk : xs) = Chunk chunk $ fromSimpleDoc xs
+    fromSimpleDoc (SDVar vars : xs) =
+        Identifier (intercalate "." vars) $ fromSimpleDoc xs
+    fromSimpleDoc (_ : xs) = fromSimpleDoc xs  -- Unsupported elements
diff --git a/src/Text/Hakyll/Internal/Template/Template.hs b/src/Text/Hakyll/Internal/Template/Template.hs
new file mode 100644
index 0000000..0fb2d09
--- /dev/null
+++ b/src/Text/Hakyll/Internal/Template/Template.hs
@@ -0,0 +1,31 @@
+-- | Module containing the template data structure.
+--
+module Text.Hakyll.Internal.Template.Template
+    ( Template (..)
+    ) where
+
+import Control.Monad (liftM, liftM2)
+import Data.Word (Word8)
+
+import Data.Binary (Binary, get, put, getWord8)
+
+-- | Datatype used for template substitutions.
+--
+data Template = Chunk String Template
+              | Identifier String Template
+              | EscapeCharacter Template
+              | End
+              deriving (Show, Read, Eq)
+    
+instance Binary Template where
+    put (Chunk string template) = put (0 :: Word8) >> put string >> put template
+    put (Identifier key template) = put (1 :: Word8) >> put key >> put template
+    put (EscapeCharacter template) = put (2 :: Word8) >> put template
+    put (End) = put (3 :: Word8)
+
+    get = do tag <- getWord8
+             case tag of 0 -> liftM2 Chunk get get
+                         1 -> liftM2 Identifier get get
+                         2 -> liftM EscapeCharacter get
+                         3 -> return End
+                         _ -> error "Error reading template"