summaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text')
-rw-r--r--src/Text/Hakyll.hs2
-rw-r--r--src/Text/Hakyll/HakyllMonad.hs3
-rw-r--r--src/Text/Hakyll/Internal/Template.hs38
-rw-r--r--src/Text/Hakyll/Internal/Template/Hamlet.hs44
-rw-r--r--src/Text/Hakyll/Internal/Template/Template.hs31
5 files changed, 92 insertions, 26 deletions
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"