summaryrefslogtreecommitdiff
path: root/src/Hakyll/Web
diff options
context:
space:
mode:
Diffstat (limited to 'src/Hakyll/Web')
-rw-r--r--src/Hakyll/Web/Template.hs13
-rw-r--r--src/Hakyll/Web/Template/Internal.hs22
-rw-r--r--src/Hakyll/Web/Template/Read.hs57
3 files changed, 47 insertions, 45 deletions
diff --git a/src/Hakyll/Web/Template.hs b/src/Hakyll/Web/Template.hs
index 371ccef..8e3859a 100644
--- a/src/Hakyll/Web/Template.hs
+++ b/src/Hakyll/Web/Template.hs
@@ -116,14 +116,15 @@ applyAsTemplate context item =
applyTemplateWith :: MonadError e m
=> (String -> a -> m String)
-> Template -> a -> m String
-applyTemplateWith context tpl x = go tpl where
-
+applyTemplateWith context tpl x = go tpl
+ where
go = liftM concat . mapM applyElem . unTemplate
applyElem (Chunk c) = return c
applyElem Escaped = return "$"
applyElem (Key k) = context k x
- applyElem (If k t mf) = (context k x >> go t) `catchError` handler where
- handler _ = case mf of
- Nothing -> return ""
- Just f -> go f
+ applyElem (If k t mf) = (context k x >> go t) `catchError` handler
+ where
+ handler _ = case mf of
+ Nothing -> return ""
+ Just f -> go f
diff --git a/src/Hakyll/Web/Template/Internal.hs b/src/Hakyll/Web/Template/Internal.hs
index 0bd999e..f939566 100644
--- a/src/Hakyll/Web/Template/Internal.hs
+++ b/src/Hakyll/Web/Template/Internal.hs
@@ -22,8 +22,7 @@ import Hakyll.Core.Writable
-- | Datatype used for template substitutions.
newtype Template = Template
{ unTemplate :: [TemplateElement]
- }
- deriving (Show, Eq, Binary, Typeable)
+ } deriving (Show, Eq, Binary, Typeable)
--------------------------------------------------------------------------------
@@ -41,17 +40,18 @@ data TemplateElement
| If String Template (Maybe Template) -- key, then branch, else branch
deriving (Show, Eq, Typeable)
+
--------------------------------------------------------------------------------
instance Binary TemplateElement where
put (Chunk string) = putWord8 0 >> put string
- put (Key key) = putWord8 1 >> put key
- put (Escaped) = putWord8 2
- put (If key t f) = putWord8 3 >> put key >> put t >> put f
+ put (Key key) = putWord8 1 >> put key
+ put (Escaped) = putWord8 2
+ put (If key t f) = putWord8 3 >> put key >> put t >> put f
get = getWord8 >>= \tag -> case tag of
- 0 -> Chunk <$> get
- 1 -> Key <$> get
- 2 -> pure Escaped
- 3 -> If <$> get <*> get <*> get
- _ -> error $ "Hakyll.Web.Template.Internal: "
- ++ "Error reading cached template"
+ 0 -> Chunk <$> get
+ 1 -> Key <$> get
+ 2 -> pure Escaped
+ 3 -> If <$> get <*> get <*> get
+ _ -> error $
+ "Hakyll.Web.Template.Internal: Error reading cached template"
diff --git a/src/Hakyll/Web/Template/Read.hs b/src/Hakyll/Web/Template/Read.hs
index 9504f0b..620ce14 100644
--- a/src/Hakyll/Web/Template/Read.hs
+++ b/src/Hakyll/Web/Template/Read.hs
@@ -4,56 +4,57 @@ module Hakyll.Web.Template.Read
( readTemplate
) where
+
--------------------------------------------------------------------------------
-import Control.Applicative ((<$>), (<$), (<*>))
-import Control.Monad (void, mzero)
+import Control.Applicative ((<$), (<$>))
+import Control.Monad (void)
import Text.Parsec
import Text.Parsec.String
+
--------------------------------------------------------------------------------
+import Hakyll.Core.Util.Parser
import Hakyll.Web.Template.Internal
---------------------------------------------------------------------------------
+--------------------------------------------------------------------------------
readTemplate :: String -> Template
-readTemplate input =
- case parse template "" input of
+readTemplate input = case parse template "" input of
Left err -> error $ "Cannot parse template: " ++ show err
Right t -> t
+
+--------------------------------------------------------------------------------
template :: Parser Template
-template = Template <$>
- (many1 $ chunk <|> escaped <|> conditional <|> key)
+template = Template <$> (many1 $ chunk <|> escaped <|> conditional <|> key)
+
+--------------------------------------------------------------------------------
chunk :: Parser TemplateElement
chunk = Chunk <$> (many1 $ noneOf "$")
+
+--------------------------------------------------------------------------------
escaped :: Parser TemplateElement
escaped = Escaped <$ (try $ string "$$")
+
+--------------------------------------------------------------------------------
conditional :: Parser TemplateElement
conditional = try $ do
- void $ string "$if("
- i <- ident
- void $ string ")$"
- thenBranch <- template
- elseBranch <- optionMaybe $ try (string "$else$") >> template
- void $ string "$endif$"
- return $ If i thenBranch elseBranch
-
-ident :: Parser String
-ident = do
- i <- (:) <$> letter <*> (many $ alphaNum <|> oneOf " _-.")
- if i `elem` reserved
- then mzero
- else return i
-
-reserved :: [String]
-reserved = ["if", "else","endif"]
+ void $ string "$if("
+ i <- metadataKey
+ void $ string ")$"
+ thenBranch <- template
+ elseBranch <- optionMaybe $ try (string "$else$") >> template
+ void $ string "$endif$"
+ return $ If i thenBranch elseBranch
+
+--------------------------------------------------------------------------------
key :: Parser TemplateElement
key = try $ do
- void $ char '$'
- k <- ident
- void $ char '$'
- return $ Key k
+ void $ char '$'
+ k <- metadataKey
+ void $ char '$'
+ return $ Key k