@@ -5,16 +5,22 @@
55module Hakyll.Web.Template.Internal
66 ( Template (..)
77 , TemplateElement (..)
8+ , readTemplate
89 ) where
910
1011
1112--------------------------------------------------------------------------------
12−import Control.Applicative (pure, (<$>), (<*>))
13−import Data.Binary (Binary, get, getWord8, put, putWord8)
14−import Data.Typeable (Typeable)
13+import Control.Applicative (pure, (<$), (<$>), (<*>), (<|>))
14+import Control.Monad (void)
15+import Data.Binary (Binary, get, getWord8, put, putWord8)
16+import Data.Typeable (Typeable)
17+import GHC.Exts (IsString (..))
18+import qualified Text.Parsec as P
19+import qualified Text.Parsec.String as P
1520
1621
1722--------------------------------------------------------------------------------
23+import Hakyll.Core.Util.Parser
1824import Hakyll.Core.Writable
1925
2026
@@ -46,10 +52,10 @@ data TemplateElement
4652--------------------------------------------------------------------------------
4753instance Binary TemplateElement where
4854 put (Chunk string) = putWord8 0 >> put string
49− put (Key key) = putWord8 1 >> put key
55+ put (Key k) = putWord8 1 >> put k
5056 put (Escaped) = putWord8 2
51− put (If key t f) = putWord8 3 >> put key >> put t >> put f
52− put (For key b s) = putWord8 4 >> put key >> put b >> put s
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
5359 put (Partial p) = putWord8 5 >> put p
5460
5561 get = getWord8 >>= \tag -> case tag of
@@ -61,3 +67,84 @@ instance Binary TemplateElement where
6167 5 -> Partial <$> get
6268 _ -> error $
6369 "Hakyll.Web.Template.Internal: Error reading cached template"
70+
71+
72+--------------------------------------------------------------------------------
73+instance IsString Template where
74+ fromString = readTemplate
75+
76+
77+--------------------------------------------------------------------------------
78+readTemplate :: String -> Template
79+readTemplate input = case P.parse template "" input of
80+ Left err -> error $ "Cannot parse template: " ++ show err
81+ Right t -> t
82+
83+
84+--------------------------------------------------------------------------------
85+template :: P.Parser Template
86+template = Template <$>
87+ (P.many1 $ chunk <|> escaped <|> conditional <|> for <|> partial <|> key)
88+
89+
90+--------------------------------------------------------------------------------
91+chunk :: P.Parser TemplateElement
92+chunk = Chunk <$> (P.many1 $ P.noneOf "$")
93+
94+
95+--------------------------------------------------------------------------------
96+escaped :: P.Parser TemplateElement
97+escaped = Escaped <$ (P.try $ P.string "$$")
98+
99+
100+--------------------------------------------------------------------------------
101+conditional :: P.Parser TemplateElement
102+conditional = P.try $ do
103+ void $ P.string "$if("
104+ i <- metadataKey
105+ void $ P.string ")$"
106+ thenBranch <- template
107+ elseBranch <- P.optionMaybe $ P.try (P.string "$else$") >> template
108+ void $ P.string "$endif$"
109+ return $ If i thenBranch elseBranch
110+
111+
112+--------------------------------------------------------------------------------
113+for :: P.Parser TemplateElement
114+for = P.try $ do
115+ void $ P.string "$for("
116+ i <- metadataKey
117+ void $ P.string ")$"
118+ body <- template
119+ sep <- P.optionMaybe $ P.try (P.string "$sep$") >> template
120+ void $ P.string "$endfor$"
121+ return $ For i body sep
122+
123+
124+--------------------------------------------------------------------------------
125+partial :: P.Parser TemplateElement
126+partial = P.try $ do
127+ void $ P.string "$partial("
128+ i <- stringLiteral
129+ void $ P.string ")$"
130+ return $ Partial i
131+
132+
133+--------------------------------------------------------------------------------
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
140+
141+
142+--------------------------------------------------------------------------------
143+stringLiteral :: P.Parser String
144+stringLiteral = do
145+ void $ P.char '\"'
146+ str <- P.many $ do
147+ x <- P.noneOf "\""
148+ if x == '\\' then P.anyChar else return x
149+ void $ P.char '\"'
150+ return str