on master help sign in
Add transparent reading of hamlet/hakyll templates
commit60cda32b72ce35e4c7c797be91badcb20afbe887 authorJasper Van der Jeugt <jaspervdj@gmail.com> dateFri 11 Feb 2011, 15:34 (16 years ago) parentdd81433
5 files changed+47−26
src/Hakyll/Web.hs+6−13 src/Hakyll/Web/Template.hs+29−1 src/Hakyll/Web/Template/Internal.hs+4−4 src/Hakyll/Web/Template/Read/Hakyll.hs+7−7 src/Hakyll/Web/Template/Read/Hamlet.hs+1−1
src/Hakyll/Web.hs+6−13
@@ -3,8 +3,7 @@
33module Hakyll.Web
44 ( defaultPageRead
55 , defaultTemplateRead
6− , defaultHamletTemplateRead
7− , defaultHamletTemplateReadWith
6+ , defaultTemplateReadWith
87 , defaultRelativizeUrls
98 , defaultCopyFile
109 , defaultCompressCss
@@ -15,7 +14,7 @@ import Prelude hiding (id)
1514import Control.Category (id)
1615import Control.Arrow (arr, (>>>), (>>^), (&&&))
1716
18−import Text.Hamlet (HamletSettings, defaultHamletSettings)
17+import Text.Hamlet (HamletSettings)
1918
2019import Hakyll.Core.Compiler
2120import Hakyll.Core.Writable
@@ -23,7 +22,6 @@ import Hakyll.Core.Identifier
2322import Hakyll.Web.Page
2423import Hakyll.Web.Pandoc
2524import Hakyll.Web.Template
26−import Hakyll.Web.Template.Read
2725import Hakyll.Web.RelativizeUrls
2826import Hakyll.Web.Util.String
2927import Hakyll.Web.CompressCss
@@ -39,16 +37,11 @@ defaultRelativizeUrls = getRoute &&& id >>^ uncurry relativize
3937 relativize (Just r) = fmap (relativizeUrls $ toSiteRoot r)
4038
4139defaultTemplateRead :: Compiler () Template
42−defaultTemplateRead = cached "Hakyll.Web.defaultTemplateRead" $
43− getResourceString >>^ readTemplate
40+defaultTemplateRead = cached "Hakyll.Web.defaultTemplateRead" $ templateRead
4441
45−defaultHamletTemplateRead :: Compiler () Template
46−defaultHamletTemplateRead = defaultHamletTemplateReadWith defaultHamletSettings
47−
48−defaultHamletTemplateReadWith :: HamletSettings -> Compiler () Template
49−defaultHamletTemplateReadWith settings =
50− cached "Hakyll.Web.defaultHamletTemplateReadWith" $
51− getResourceString >>^ readHamletTemplateWith settings
42+defaultTemplateReadWith :: HamletSettings -> Compiler () Template
43+defaultTemplateReadWith settings = cached "Hakyll.Web.defaultTemplateReadWith" $
44+ templateReadWith settings
5245
5346defaultCopyFile :: Compiler () CopyFile
5447defaultCopyFile = getIdentifier >>^ CopyFile . toFilePath
src/Hakyll/Web/Template.hs+29−1
@@ -2,11 +2,19 @@ module Hakyll.Web.Template
22 ( Template
33 , applyTemplate
44 , applySelf
5+ , templateRead
6+ , templateReadWith
57 ) where
68
9+import Control.Arrow
710import Data.Maybe (fromMaybe)
811import qualified Data.Map as M
12+import System.FilePath (takeExtension)
913
14+import Text.Hamlet (HamletSettings, defaultHamletSettings)
15+
16+import Hakyll.Core.Compiler
17+import Hakyll.Core.Identifier
1018import Hakyll.Web.Template.Internal
1119import Hakyll.Web.Template.Read
1220import Hakyll.Web.Page
@@ -20,7 +28,7 @@ applyTemplate template page =
2028 fmap (const $ substitute =<< unTemplate template) page
2129 where
2230 substitute (Chunk chunk) = chunk
23− substitute (Identifier key) =
31+ substitute (Key key) =
2432 fromMaybe ('$' : key) $ M.lookup key $ toMap page
2533 substitute (Escaped) = "$"
2634
@@ -29,3 +37,23 @@ applyTemplate template page =
2937--
3038applySelf :: Page String -> Page String
3139applySelf page = applyTemplate (readTemplate $ pageBody page) page
40+
41+-- | Read a template. If the extension of the file we're compiling is
42+-- @.hml@ or @.hamlet@, it will be considered as a Hamlet template, and parsed
43+-- as such.
44+--
45+templateRead :: Compiler a Template
46+templateRead = templateReadWith defaultHamletSettings
47+
48+-- | Version of 'templateRead' that enables custom settings.
49+--
50+templateReadWith :: HamletSettings -> Compiler a Template
51+templateReadWith settings =
52+ getIdentifier &&& getResourceString >>^ uncurry read'
53+ where
54+ read' identifier string =
55+ if takeExtension (toFilePath identifier) `elem` [".hml", ".hamlet"]
56+ -- Hamlet template
57+ then readHamletTemplateWith settings string
58+ -- Hakyll template
59+ else readTemplate string
src/Hakyll/Web/Template/Internal.hs+4−4
@@ -28,18 +28,18 @@ instance Writable Template where
2828--
2929data TemplateElement
3030 = Chunk String
31− | Identifier String
31+ | Key String
3232 | Escaped
3333 deriving (Show, Eq, Typeable)
3434
3535instance Binary TemplateElement where
3636 put (Chunk string) = putWord8 0 >> put string
37− put (Identifier key) = putWord8 1 >> put key
37+ put (Key key) = putWord8 1 >> put key
3838 put (Escaped) = putWord8 2
3939
4040 get = getWord8 >>= \tag -> case tag of
41− 0 -> Chunk <$> get
42− 1 -> Identifier <$> get
41+ 0 -> Chunk <$> get
42+ 1 -> Key <$> get
4343 2 -> return Escaped
4444 _ -> error $ "Hakyll.Web.Template.Internal: "
4545 ++ "Error reading cached template"
src/Hakyll/Web/Template/Read/Hakyll.hs+7−7
@@ -19,17 +19,17 @@ readTemplate = Template . readTemplate'
1919 | "$$" `isPrefixOf` string =
2020 Escaped : readTemplate' (drop 2 string)
2121 | "$" `isPrefixOf` string =
22− case readIdentifier (drop 1 string) of
23− Just (key, rest) -> Identifier key : readTemplate' rest
22+ case readKey (drop 1 string) of
23+ Just (key, rest) -> Key key : readTemplate' rest
2424 Nothing -> Chunk "$" : readTemplate' (drop 1 string)
2525 | otherwise =
2626 let (chunk, rest) = break (== '$') string
2727 in Chunk chunk : readTemplate' rest
2828
29− -- Parse an identifier into (identifier, rest) if it's valid, and return
29+ -- Parse an key into (key, rest) if it's valid, and return
3030 -- Nothing otherwise
31− readIdentifier string =
32− let (identifier, rest) = span isAlphaNum string
33− in if not (null identifier) && "$" `isPrefixOf` rest
34− then Just (identifier, drop 1 rest)
31+ readKey string =
32+ let (key, rest) = span isAlphaNum string
33+ in if not (null key) && "$" `isPrefixOf` rest
34+ then Just (key, drop 1 rest)
3535 else Nothing
src/Hakyll/Web/Template/Read/Hamlet.hs+1−1
@@ -35,7 +35,7 @@ fromHamletRT (HamletRT sd) = Template $ map fromSimpleDoc sd
3535 where
3636 fromSimpleDoc :: SimpleDoc -> TemplateElement
3737 fromSimpleDoc (SDRaw chunk) = Chunk chunk
38− fromSimpleDoc (SDVar [var]) = Identifier var
38+ fromSimpleDoc (SDVar [var]) = Key var
3939 fromSimpleDoc (SDVar _) = error
4040 "Hakyll.Web.Template.Read.Hamlet.fromHamletRT: \
4141 \Hakyll does not support '.' in identifier names when using \