@@ -4,6 +4,8 @@
44{-# LANGUAGE GeneralizedNewtypeDeriving #-}
55module Hakyll.Web.Template.Internal
66 ( Template (..)
7+ , TemplateKey (..)
8+ , TemplateExpr (..)
79 , TemplateElement (..)
810 , readTemplate
911 ) where
@@ -14,6 +16,7 @@ import Control.Applicative (pure, (<$), (<$>), (<*>), (<|>))
1416import Control.Monad (void)
1517import Data.Binary (Binary, get, getWord8, put, putWord8)
1618import Data.Typeable (Typeable)
19+import Data.List (intercalate)
1720import GHC.Exts (IsString (..))
1821import qualified Text.Parsec as P
1922import qualified Text.Parsec.String as P
@@ -37,30 +40,45 @@ instance Writable Template where
3740 write _ _ = return ()
3841
3942
43+--------------------------------------------------------------------------------
44+instance IsString Template where
45+ fromString = readTemplate
46+
47+
48+--------------------------------------------------------------------------------
49+newtype TemplateKey = TemplateKey String
50+ deriving (Binary, Show, Eq, Typeable)
51+
52+
53+--------------------------------------------------------------------------------
54+instance IsString TemplateKey where
55+ fromString = TemplateKey
56+
57+
4058--------------------------------------------------------------------------------
4159-- | Elements of a template.
4260data TemplateElement
4361 = Chunk String
44− | Key String
62+ | Expr TemplateExpr
4563 | Escaped
46− | If String Template (Maybe Template) -- key, then branch, else branch
47− | For String Template (Maybe Template) -- key, body, separator
48− | Partial String -- filename
64+ | If TemplateExpr Template (Maybe Template) -- expr, then, else
65+ | For TemplateExpr Template (Maybe Template) -- expr, body, separator
66+ | Partial TemplateExpr -- filename
4967 deriving (Show, Eq, Typeable)
5068
5169
5270--------------------------------------------------------------------------------
5371instance Binary TemplateElement where
5472 put (Chunk string) = putWord8 0 >> put string
55− put (Key k) = putWord8 1 >> put k
73+ put (Expr e) = putWord8 1 >> put e
5674 put (Escaped) = putWord8 2
57− put (If k t f ) = putWord8 3 >> put k >> put t >> put f
58− put (For k b s) = putWord8 4 >> put k >> put b >> put s
59− put (Partial p) = putWord8 5 >> put p
75+ put (If e t f ) = putWord8 3 >> put e >> put t >> put f
76+ put (For e b s) = putWord8 4 >> put e >> put b >> put s
77+ put (Partial e) = putWord8 5 >> put e
6078
6179 get = getWord8 >>= \tag -> case tag of
6280 0 -> Chunk <$> get
63− 1 -> Key <$> get
81+ 1 -> Expr <$> get
6482 2 -> pure Escaped
6583 3 -> If <$> get <*> get <*> get
6684 4 -> For <$> get <*> get <*> get
@@ -70,8 +88,34 @@ instance Binary TemplateElement where
7088
7189
7290--------------------------------------------------------------------------------
73−instance IsString Template where
74− fromString = readTemplate
91+-- | Expression in a template
92+data TemplateExpr
93+ = Ident TemplateKey
94+ | Call TemplateKey [TemplateExpr]
95+ | StringLiteral String
96+ deriving (Eq, Typeable)
97+
98+
99+--------------------------------------------------------------------------------
100+instance Show TemplateExpr where
101+ show (Ident (TemplateKey k)) = k
102+ show (Call (TemplateKey k) as) =
103+ k ++ "(" ++ intercalate ", " (map show as) ++ ")"
104+ show (StringLiteral s) = show s
105+
106+
107+--------------------------------------------------------------------------------
108+instance Binary TemplateExpr where
109+ put (Ident k) = putWord8 0 >> put k
110+ put (Call k as) = putWord8 1 >> put k >> put as
111+ put (StringLiteral s) = putWord8 2 >> put s
112+
113+ get = getWord8 >>= \tag -> case tag of
114+ 0 -> Ident <$> get
115+ 1 -> Call <$> get <*> get
116+ 2 -> StringLiteral <$> get
117+ _ -> error $
118+ "Hakyll.Web.Tamplte.Internal: Error reading cached template"
75119
76120
77121--------------------------------------------------------------------------------
@@ -84,7 +128,7 @@ readTemplate input = case P.parse template "" input of
84128--------------------------------------------------------------------------------
85129template :: P.Parser Template
86130template = Template <$>
87− (P.many1 $ chunk <|> escaped <|> conditional <|> for <|> partial <|> key)
131+ (P.many1 $ chunk <|> escaped <|> conditional <|> for <|> partial <|> expr)
88132
89133
90134--------------------------------------------------------------------------------
@@ -92,6 +136,20 @@ chunk :: P.Parser TemplateElement
92136chunk = Chunk <$> (P.many1 $ P.noneOf "$")
93137
94138
139+--------------------------------------------------------------------------------
140+expr :: P.Parser TemplateElement
141+expr = P.try $ do
142+ void $ P.char '$'
143+ e <- expr'
144+ void $ P.char '$'
145+ return $ Expr e
146+
147+
148+--------------------------------------------------------------------------------
149+expr' :: P.Parser TemplateExpr
150+expr' = stringLiteral <|> call <|> ident
151+
152+
95153--------------------------------------------------------------------------------
96154escaped :: P.Parser TemplateElement
97155escaped = Escaped <$ (P.try $ P.string "$$")
@@ -101,50 +159,63 @@ escaped = Escaped <$ (P.try $ P.string "$$")
101159conditional :: P.Parser TemplateElement
102160conditional = P.try $ do
103161 void $ P.string "$if("
104− i <- metadataKey
162+ e <- expr'
105163 void $ P.string ")$"
106164 thenBranch <- template
107165 elseBranch <- P.optionMaybe $ P.try (P.string "$else$") >> template
108166 void $ P.string "$endif$"
109− return $ If i thenBranch elseBranch
167+ return $ If e thenBranch elseBranch
110168
111169
112170--------------------------------------------------------------------------------
113171for :: P.Parser TemplateElement
114172for = P.try $ do
115173 void $ P.string "$for("
116− i <- metadataKey
174+ e <- expr'
117175 void $ P.string ")$"
118176 body <- template
119177 sep <- P.optionMaybe $ P.try (P.string "$sep$") >> template
120178 void $ P.string "$endfor$"
121− return $ For i body sep
179+ return $ For e body sep
122180
123181
124182--------------------------------------------------------------------------------
125183partial :: P.Parser TemplateElement
126184partial = P.try $ do
127185 void $ P.string "$partial("
128− i <- stringLiteral
186+ e <- expr'
129187 void $ P.string ")$"
130− return $ Partial i
188+ return $ Partial e
131189
132190
133191--------------------------------------------------------------------------------
134−key :: P.Parser TemplateElement
135−key = P.try $ do
136− void $ P.char '$'
137− k <- metadataKey
138− void $ P.char '$'
139− return $ Key k
192+ident :: P.Parser TemplateExpr
193+ident = P.try $ Ident <$> key
140194
141195
142196--------------------------------------------------------------------------------
143−stringLiteral :: P.Parser String
197+call :: P.Parser TemplateExpr
198+call = P.try $ do
199+ f <- key
200+ void $ P.char '('
201+ P.spaces
202+ as <- P.sepBy expr' (P.spaces >> P.char ',' >> P.spaces)
203+ P.spaces
204+ void $ P.char ')'
205+ return $ Call f as
206+
207+
208+--------------------------------------------------------------------------------
209+stringLiteral :: P.Parser TemplateExpr
144210stringLiteral = do
145211 void $ P.char '\"'
146212 str <- P.many $ do
147213 x <- P.noneOf "\""
148214 if x == '\\' then P.anyChar else return x
149215 void $ P.char '\"'
150− return str
216+ return $ StringLiteral str
217+
218+
219+--------------------------------------------------------------------------------
220+key :: P.Parser TemplateKey
221+key = TemplateKey <$> metadataKey