From 60cda32b72ce35e4c7c797be91badcb20afbe887 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Fri, 11 Feb 2011 15:34:34 +0100 Subject: Add transparent reading of hamlet/hakyll templates --- src/Hakyll/Web.hs | 19 ++++++------------- src/Hakyll/Web/Template.hs | 30 +++++++++++++++++++++++++++++- src/Hakyll/Web/Template/Internal.hs | 8 ++++---- src/Hakyll/Web/Template/Read/Hakyll.hs | 14 +++++++------- src/Hakyll/Web/Template/Read/Hamlet.hs | 2 +- 5 files changed, 47 insertions(+), 26 deletions(-) (limited to 'src/Hakyll') diff --git a/src/Hakyll/Web.hs b/src/Hakyll/Web.hs index 73f818a..617e2de 100644 --- a/src/Hakyll/Web.hs +++ b/src/Hakyll/Web.hs @@ -3,8 +3,7 @@ module Hakyll.Web ( defaultPageRead , defaultTemplateRead - , defaultHamletTemplateRead - , defaultHamletTemplateReadWith + , defaultTemplateReadWith , defaultRelativizeUrls , defaultCopyFile , defaultCompressCss @@ -15,7 +14,7 @@ import Prelude hiding (id) import Control.Category (id) import Control.Arrow (arr, (>>>), (>>^), (&&&)) -import Text.Hamlet (HamletSettings, defaultHamletSettings) +import Text.Hamlet (HamletSettings) import Hakyll.Core.Compiler import Hakyll.Core.Writable @@ -23,7 +22,6 @@ import Hakyll.Core.Identifier import Hakyll.Web.Page import Hakyll.Web.Pandoc import Hakyll.Web.Template -import Hakyll.Web.Template.Read import Hakyll.Web.RelativizeUrls import Hakyll.Web.Util.String import Hakyll.Web.CompressCss @@ -39,16 +37,11 @@ defaultRelativizeUrls = getRoute &&& id >>^ uncurry relativize relativize (Just r) = fmap (relativizeUrls $ toSiteRoot r) defaultTemplateRead :: Compiler () Template -defaultTemplateRead = cached "Hakyll.Web.defaultTemplateRead" $ - getResourceString >>^ readTemplate +defaultTemplateRead = cached "Hakyll.Web.defaultTemplateRead" $ templateRead -defaultHamletTemplateRead :: Compiler () Template -defaultHamletTemplateRead = defaultHamletTemplateReadWith defaultHamletSettings - -defaultHamletTemplateReadWith :: HamletSettings -> Compiler () Template -defaultHamletTemplateReadWith settings = - cached "Hakyll.Web.defaultHamletTemplateReadWith" $ - getResourceString >>^ readHamletTemplateWith settings +defaultTemplateReadWith :: HamletSettings -> Compiler () Template +defaultTemplateReadWith settings = cached "Hakyll.Web.defaultTemplateReadWith" $ + templateReadWith settings defaultCopyFile :: Compiler () CopyFile defaultCopyFile = getIdentifier >>^ CopyFile . toFilePath diff --git a/src/Hakyll/Web/Template.hs b/src/Hakyll/Web/Template.hs index 06794e8..00c1a27 100644 --- a/src/Hakyll/Web/Template.hs +++ b/src/Hakyll/Web/Template.hs @@ -2,11 +2,19 @@ module Hakyll.Web.Template ( Template , applyTemplate , applySelf + , templateRead + , templateReadWith ) where +import Control.Arrow import Data.Maybe (fromMaybe) import qualified Data.Map as M +import System.FilePath (takeExtension) +import Text.Hamlet (HamletSettings, defaultHamletSettings) + +import Hakyll.Core.Compiler +import Hakyll.Core.Identifier import Hakyll.Web.Template.Internal import Hakyll.Web.Template.Read import Hakyll.Web.Page @@ -20,7 +28,7 @@ applyTemplate template page = fmap (const $ substitute =<< unTemplate template) page where substitute (Chunk chunk) = chunk - substitute (Identifier key) = + substitute (Key key) = fromMaybe ('$' : key) $ M.lookup key $ toMap page substitute (Escaped) = "$" @@ -29,3 +37,23 @@ applyTemplate template page = -- applySelf :: Page String -> Page String applySelf page = applyTemplate (readTemplate $ pageBody page) page + +-- | Read a template. If the extension of the file we're compiling is +-- @.hml@ or @.hamlet@, it will be considered as a Hamlet template, and parsed +-- as such. +-- +templateRead :: Compiler a Template +templateRead = templateReadWith defaultHamletSettings + +-- | Version of 'templateRead' that enables custom settings. +-- +templateReadWith :: HamletSettings -> Compiler a Template +templateReadWith settings = + getIdentifier &&& getResourceString >>^ uncurry read' + where + read' identifier string = + if takeExtension (toFilePath identifier) `elem` [".hml", ".hamlet"] + -- Hamlet template + then readHamletTemplateWith settings string + -- Hakyll template + else readTemplate string diff --git a/src/Hakyll/Web/Template/Internal.hs b/src/Hakyll/Web/Template/Internal.hs index d0f6472..d0e0859 100644 --- a/src/Hakyll/Web/Template/Internal.hs +++ b/src/Hakyll/Web/Template/Internal.hs @@ -28,18 +28,18 @@ instance Writable Template where -- data TemplateElement = Chunk String - | Identifier String + | Key String | Escaped deriving (Show, Eq, Typeable) instance Binary TemplateElement where put (Chunk string) = putWord8 0 >> put string - put (Identifier key) = putWord8 1 >> put key + put (Key key) = putWord8 1 >> put key put (Escaped) = putWord8 2 get = getWord8 >>= \tag -> case tag of - 0 -> Chunk <$> get - 1 -> Identifier <$> get + 0 -> Chunk <$> get + 1 -> Key <$> get 2 -> return Escaped _ -> error $ "Hakyll.Web.Template.Internal: " ++ "Error reading cached template" diff --git a/src/Hakyll/Web/Template/Read/Hakyll.hs b/src/Hakyll/Web/Template/Read/Hakyll.hs index e0e10f4..fecf772 100644 --- a/src/Hakyll/Web/Template/Read/Hakyll.hs +++ b/src/Hakyll/Web/Template/Read/Hakyll.hs @@ -19,17 +19,17 @@ readTemplate = Template . readTemplate' | "$$" `isPrefixOf` string = Escaped : readTemplate' (drop 2 string) | "$" `isPrefixOf` string = - case readIdentifier (drop 1 string) of - Just (key, rest) -> Identifier key : readTemplate' rest + case readKey (drop 1 string) of + Just (key, rest) -> Key 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 + -- Parse an key into (key, 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) + readKey string = + let (key, rest) = span isAlphaNum string + in if not (null key) && "$" `isPrefixOf` rest + then Just (key, drop 1 rest) else Nothing diff --git a/src/Hakyll/Web/Template/Read/Hamlet.hs b/src/Hakyll/Web/Template/Read/Hamlet.hs index 55b73f8..7b496de 100644 --- a/src/Hakyll/Web/Template/Read/Hamlet.hs +++ b/src/Hakyll/Web/Template/Read/Hamlet.hs @@ -35,7 +35,7 @@ fromHamletRT (HamletRT sd) = Template $ map fromSimpleDoc sd where fromSimpleDoc :: SimpleDoc -> TemplateElement fromSimpleDoc (SDRaw chunk) = Chunk chunk - fromSimpleDoc (SDVar [var]) = Identifier var + fromSimpleDoc (SDVar [var]) = Key var fromSimpleDoc (SDVar _) = error "Hakyll.Web.Template.Read.Hamlet.fromHamletRT: \ \Hakyll does not support '.' in identifier names when using \ -- cgit v1.2.3