diff options
Diffstat (limited to 'src/Text/Hakyll/Internal')
| -rw-r--r-- | src/Text/Hakyll/Internal/Template.hs | 35 | ||||
| -rw-r--r-- | src/Text/Hakyll/Internal/Template/Hamlet.hs | 19 | ||||
| -rw-r--r-- | src/Text/Hakyll/Internal/Template/Template.hs | 43 |
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" |