on master help sign in
Refactored Template data structure.
commitacbdf6c329fa1f71dac1a035557150033586f784 authorJasper Van der Jeugt <jaspervdj@gmail.com> dateFri 6 Aug 2010, 10:52 (16 years ago) parent69ca425
3 files changed+52−45
src/Text/Hakyll/Internal/Template.hs+19−16 src/Text/Hakyll/Internal/Template/Hamlet.hs+10−9 src/Text/Hakyll/Internal/Template/Template.hs+23−20
src/Text/Hakyll/Internal/Template.hs+19−16
@@ -22,16 +22,22 @@ import Text.Hakyll.Internal.Template.Template
2222import Text.Hakyll.Internal.Template.Hamlet
2323
2424-- | Construct a @Template@ from a string.
25+--
2526fromString :: String -> Template
26−fromString [] = End
27−fromString string
28− | "$$" `isPrefixOf` string = EscapeCharacter (fromString $ tail tail')
29− | "$" `isPrefixOf` string = let (key, rest) = span isAlphaNum tail'
30− in Identifier key (fromString rest)
31− | otherwise = let (chunk, rest) = break (== '$') string
32− in Chunk chunk (fromString rest)
27+fromString = Template . fromString'
3328 where
34− tail' = tail string
29+ fromString' [] = []
30+ fromString' string
31+ | "$$" `isPrefixOf` string =
32+ EscapeCharacter : (fromString' $ tail tail')
33+ | "$" `isPrefixOf` string =
34+ let (key, rest) = span isAlphaNum tail'
35+ in Identifier key : fromString' rest
36+ | otherwise =
37+ let (chunk, rest) = break (== '$') string
38+ in Chunk chunk : fromString' rest
39+ where
40+ tail' = tail string
3541
3642-- | Read a @Template@ from a file. This function might fetch the @Template@
3743-- from the cache, if available.
@@ -60,15 +66,12 @@ readTemplate path = do
6066-- "Context". When a key is not found, it is left as it is. You can specify
6167-- the characters used to replace escaped dollars (@$$@) here.
6268substitute :: String -> Template -> Context -> String
63−substitute escaper (Chunk chunk template) context =
64− chunk ++ substitute escaper template context
65−substitute escaper (Identifier key template) context =
66− replacement ++ substitute escaper template context
69+substitute escaper template context = substitute' =<< unTemplate template
6770 where
68− replacement = fromMaybe ('$' : key) $ M.lookup key $ unContext context
69−substitute escaper (EscapeCharacter template) context =
70− escaper ++ substitute escaper template context
71−substitute _ End _ = []
71+ substitute' (Chunk chunk) = chunk
72+ substitute' (Identifier key) =
73+ fromMaybe ('$' : key) $ M.lookup key $ unContext context
74+ substitute' (EscapeCharacter) = escaper
7275
7376-- | @substitute@ for use during a chain. This will leave escaped characters as
7477-- they are.
src/Text/Hakyll/Internal/Template/Hamlet.hs+10−9
@@ -6,7 +6,6 @@ module Text.Hakyll.Internal.Template.Hamlet
66 , fromHamletRT
77 ) where
88
9−import Data.List (intercalate)
109import Control.Monad.Trans (liftIO)
1110import System.FilePath (takeExtension)
1211
@@ -29,16 +28,18 @@ readHamletRT fileName = do
2928 string <- liftIO $ readFile fileName
3029 liftIO $ parseHamletRT settings string
3130
32−
3331-- | Convert a 'HamletRT' to a 'Template'
3432--
3533fromHamletRT :: HamletRT -- ^ Hamlet runtime template
3634 -> Template -- ^ Hakyll template
37−fromHamletRT (HamletRT sd) = fromSimpleDoc sd
35+fromHamletRT (HamletRT sd) = Template $ map fromSimpleDoc sd
3836 where
39− fromSimpleDoc :: [SimpleDoc] -> Template
40− fromSimpleDoc [] = End
41− fromSimpleDoc (SDRaw chunk : xs) = Chunk chunk $ fromSimpleDoc xs
42− fromSimpleDoc (SDVar vars : xs) =
43− Identifier (intercalate "." vars) $ fromSimpleDoc xs
44− fromSimpleDoc (_ : xs) = fromSimpleDoc xs -- Unsupported elements
37+ fromSimpleDoc :: SimpleDoc -> TemplateElement
38+ fromSimpleDoc (SDRaw chunk) = Chunk chunk
39+ fromSimpleDoc (SDVar [var]) = Identifier var
40+ fromSimpleDoc (SDVar _) =
41+ error "Hakyll does not support '.' in identifier names when using \
42+ \hamlet templates."
43+ fromSimpleDoc _ =
44+ error "Only simple $key$ identifiers are allowed when using hamlet \
45+ \templates."
src/Text/Hakyll/Internal/Template/Template.hs+23−20
@@ -1,31 +1,34 @@
11-- | Module containing the template data structure.
22--
3+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
34module Text.Hakyll.Internal.Template.Template
45 ( Template (..)
6+ , TemplateElement (..)
57 ) where
68
7−import Control.Monad (liftM, liftM2)
8−import Data.Word (Word8)
9+import Control.Applicative ((<$>))
910
10−import Data.Binary (Binary, get, put, getWord8)
11+import Data.Binary (Binary, get, getWord8, put, putWord8)
1112
1213-- | Datatype used for template substitutions.
1314--
14−data Template = Chunk String Template
15− | Identifier String Template
16− | EscapeCharacter Template
17− | End
18− deriving (Show, Read, Eq)
19−
20−instance Binary Template where
21− put (Chunk string template) = put (0 :: Word8) >> put string >> put template
22− put (Identifier key template) = put (1 :: Word8) >> put key >> put template
23− put (EscapeCharacter template) = put (2 :: Word8) >> put template
24− put (End) = put (3 :: Word8)
15+newtype Template = Template { unTemplate :: [TemplateElement] }
16+ deriving (Show, Eq, Binary)
2517
26− get = do tag <- getWord8
27− case tag of 0 -> liftM2 Chunk get get
28− 1 -> liftM2 Identifier get get
29− 2 -> liftM EscapeCharacter get
30− 3 -> return End
31− _ -> error "Error reading template"
18+-- | Elements of a template.
19+--
20+data TemplateElement = Chunk String
21+ | Identifier String
22+ | EscapeCharacter
23+ deriving (Show, Eq)
24+
25+instance Binary TemplateElement where
26+ put (Chunk string) = putWord8 0 >> put string
27+ put (Identifier key) = putWord8 1 >> put key
28+ put (EscapeCharacter) = putWord8 2
29+
30+ get = getWord8 >>= \tag ->
31+ case tag of 0 -> Chunk <$> get
32+ 1 -> Identifier <$> get
33+ 2 -> return EscapeCharacter
34+ _ -> error "Error reading cached template"