Hamlet support (experimental)

6 files changed, 97 insertions, 28 deletions

diff --git a/hakyll.cabal b/hakyll.cabal
index ba8199b..9236d4c 100644
--- a/hakyll.cabal
+++ b/hakyll.cabal
@@ -38,8 +38,9 @@ library
                     mtl == 1.*,
                     old-locale == 1.*,
                     old-time == 1.*,
-                    time == 1.*,
-                    binary >= 0.5
+                    time >= 1.2,
+                    binary >= 0.5,
+                    hamlet == 0.4.2
   exposed-modules:  Network.Hakyll.SimpleServer
                     Text.Hakyll
                     Text.Hakyll.Context
@@ -61,3 +62,5 @@ library
                     Text.Hakyll.Internal.FileType
                     Text.Hakyll.Internal.Page
                     Text.Hakyll.Internal.Template
+                    Text.Hakyll.Internal.Template.Template
+                    Text.Hakyll.Internal.Template.Hamlet
diff --git a/src/Text/Hakyll.hs b/src/Text/Hakyll.hs
index 15cfda4..675b72b 100644
--- a/src/Text/Hakyll.hs
+++ b/src/Text/Hakyll.hs
@@ -23,6 +23,7 @@ import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
 import System.Time (getClockTime)
 
 import Text.Pandoc
+import Text.Hamlet (defaultHamletSettings)
 
 import Network.Hakyll.SimpleServer (simpleServer)
 import Text.Hakyll.HakyllMonad
@@ -59,6 +60,7 @@ defaultHakyllConfiguration absoluteUrl' = HakyllConfiguration
     , previewMode         = BuildOnRequest
     , pandocParserState   = defaultPandocParserState
     , pandocWriterOptions = defaultPandocWriterOptions
+    , hamletSettings      = defaultHamletSettings
     }
 
 -- | Main function to run Hakyll with the default configuration. The
diff --git a/src/Text/Hakyll/HakyllMonad.hs b/src/Text/Hakyll/HakyllMonad.hs
index 2140ea7..40e8c75 100644
--- a/src/Text/Hakyll/HakyllMonad.hs
+++ b/src/Text/Hakyll/HakyllMonad.hs
@@ -15,6 +15,7 @@ import qualified Data.Map as M
 import System.IO (hPutStrLn, stderr)
 
 import Text.Pandoc (ParserState, WriterOptions)
+import Text.Hamlet (HamletSettings)
 
 import Text.Hakyll.Context (Context (..))
 
@@ -48,6 +49,8 @@ data HakyllConfiguration = HakyllConfiguration
       pandocParserState   :: ParserState
     , -- | Pandoc writer options
       pandocWriterOptions :: WriterOptions
+    , -- | Hamlet settings (if you use hamlet for templates)
+      hamletSettings      :: HamletSettings
     }
 
 -- | Simplified @ask@ function for the Hakyll monad stack.
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"