From 69ca4255f07b147082614af34a883b557f456a74 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Thu, 5 Aug 2010 18:41:15 +0200 Subject: Hamlet support (experimental) --- src/Text/Hakyll.hs | 2 ++ src/Text/Hakyll/HakyllMonad.hs | 3 ++ src/Text/Hakyll/Internal/Template.hs | 38 ++++++++--------------- src/Text/Hakyll/Internal/Template/Hamlet.hs | 44 +++++++++++++++++++++++++++ src/Text/Hakyll/Internal/Template/Template.hs | 31 +++++++++++++++++++ 5 files changed, 92 insertions(+), 26 deletions(-) create mode 100644 src/Text/Hakyll/Internal/Template/Hamlet.hs create mode 100644 src/Text/Hakyll/Internal/Template/Template.hs (limited to 'src') 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" -- cgit v1.2.3