summaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text')
-rw-r--r--src/Text/Hakyll/Internal/Template.hs35
-rw-r--r--src/Text/Hakyll/Internal/Template/Hamlet.hs19
-rw-r--r--src/Text/Hakyll/Internal/Template/Template.hs43
3 files changed, 52 insertions, 45 deletions
diff --git a/src/Text/Hakyll/Internal/Template.hs b/src/Text/Hakyll/Internal/Template.hs
index 54636ee..bd9121b 100644
--- a/src/Text/Hakyll/Internal/Template.hs
+++ b/src/Text/Hakyll/Internal/Template.hs
@@ -22,16 +22,22 @@ import Text.Hakyll.Internal.Template.Template
import Text.Hakyll.Internal.Template.Hamlet
-- | Construct a @Template@ from a string.
+--
fromString :: String -> Template
-fromString [] = End
-fromString string
- | "$$" `isPrefixOf` string = EscapeCharacter (fromString $ tail tail')
- | "$" `isPrefixOf` string = let (key, rest) = span isAlphaNum tail'
- in Identifier key (fromString rest)
- | otherwise = let (chunk, rest) = break (== '$') string
- in Chunk chunk (fromString rest)
+fromString = Template . fromString'
where
- tail' = tail string
+ fromString' [] = []
+ fromString' string
+ | "$$" `isPrefixOf` string =
+ EscapeCharacter : (fromString' $ tail tail')
+ | "$" `isPrefixOf` string =
+ let (key, rest) = span isAlphaNum tail'
+ in Identifier key : fromString' rest
+ | otherwise =
+ let (chunk, rest) = break (== '$') string
+ in Chunk chunk : fromString' rest
+ where
+ tail' = tail string
-- | Read a @Template@ from a file. This function might fetch the @Template@
-- from the cache, if available.
@@ -60,15 +66,12 @@ readTemplate path = do
-- "Context". When a key is not found, it is left as it is. You can specify
-- the characters used to replace escaped dollars (@$$@) here.
substitute :: String -> Template -> Context -> String
-substitute escaper (Chunk chunk template) context =
- chunk ++ substitute escaper template context
-substitute escaper (Identifier key template) context =
- replacement ++ substitute escaper template context
+substitute escaper template context = substitute' =<< unTemplate template
where
- replacement = fromMaybe ('$' : key) $ M.lookup key $ unContext context
-substitute escaper (EscapeCharacter template) context =
- escaper ++ substitute escaper template context
-substitute _ End _ = []
+ substitute' (Chunk chunk) = chunk
+ substitute' (Identifier key) =
+ fromMaybe ('$' : key) $ M.lookup key $ unContext context
+ substitute' (EscapeCharacter) = escaper
-- | @substitute@ for use during a chain. This will leave escaped characters as
-- they are.
diff --git a/src/Text/Hakyll/Internal/Template/Hamlet.hs b/src/Text/Hakyll/Internal/Template/Hamlet.hs
index 35c8e20..3bd9bb5 100644
--- a/src/Text/Hakyll/Internal/Template/Hamlet.hs
+++ b/src/Text/Hakyll/Internal/Template/Hamlet.hs
@@ -6,7 +6,6 @@ module Text.Hakyll.Internal.Template.Hamlet
, fromHamletRT
) where
-import Data.List (intercalate)
import Control.Monad.Trans (liftIO)
import System.FilePath (takeExtension)
@@ -29,16 +28,18 @@ readHamletRT fileName = do
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
+fromHamletRT (HamletRT sd) = Template $ map 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
+ fromSimpleDoc :: SimpleDoc -> TemplateElement
+ fromSimpleDoc (SDRaw chunk) = Chunk chunk
+ fromSimpleDoc (SDVar [var]) = Identifier var
+ fromSimpleDoc (SDVar _) =
+ error "Hakyll does not support '.' in identifier names when using \
+ \hamlet templates."
+ fromSimpleDoc _ =
+ error "Only simple $key$ identifiers are allowed when using hamlet \
+ \templates."
diff --git a/src/Text/Hakyll/Internal/Template/Template.hs b/src/Text/Hakyll/Internal/Template/Template.hs
index 0fb2d09..49373fd 100644
--- a/src/Text/Hakyll/Internal/Template/Template.hs
+++ b/src/Text/Hakyll/Internal/Template/Template.hs
@@ -1,31 +1,34 @@
-- | Module containing the template data structure.
--
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Text.Hakyll.Internal.Template.Template
( Template (..)
+ , TemplateElement (..)
) where
-import Control.Monad (liftM, liftM2)
-import Data.Word (Word8)
+import Control.Applicative ((<$>))
-import Data.Binary (Binary, get, put, getWord8)
+import Data.Binary (Binary, get, getWord8, put, putWord8)
-- | 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)
+newtype Template = Template { unTemplate :: [TemplateElement] }
+ deriving (Show, Eq, Binary)
- 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"
+-- | Elements of a template.
+--
+data TemplateElement = Chunk String
+ | Identifier String
+ | EscapeCharacter
+ deriving (Show, Eq)
+
+instance Binary TemplateElement where
+ put (Chunk string) = putWord8 0 >> put string
+ put (Identifier key) = putWord8 1 >> put key
+ put (EscapeCharacter) = putWord8 2
+
+ get = getWord8 >>= \tag ->
+ case tag of 0 -> Chunk <$> get
+ 1 -> Identifier <$> get
+ 2 -> return EscapeCharacter
+ _ -> error "Error reading cached template"