on master help sign in
Merge remote-tracking branch 'sphynx/master'
commit28bc3f1f3b98f3bf4c8601af8eb8fa7a9c226ed2 authorJasper Van der Jeugt <m@jaspervdj.be> dateSat 4 May 2013, 11:14 (13 years ago) parent35e2db27d489f3
6 files changed+95−42
src/Hakyll/Core/Compiler/Internal.hs+8 src/Hakyll/Web/Template.hs+14−7 src/Hakyll/Web/Template/Internal.hs+7−5 src/Hakyll/Web/Template/Read.hs+46−28 tests/data/template.html+12−1 tests/data/template.html.out+8−1
src/Hakyll/Core/Compiler/Internal.hs+8
@@ -2,6 +2,8 @@
22-- | Internally used compiler module
33{-# LANGUAGE GADTs #-}
44{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5+{-# LANGUAGE FlexibleInstances #-}
6+{-# LANGUAGE MultiParamTypeClasses #-}
57module Hakyll.Core.Compiler.Internal
68 ( -- * Types
79 CompilerRead (..)
@@ -29,6 +31,7 @@ import Control.Applicative (Alternative (..),
2931 Applicative (..), (<$>))
3032import Control.Exception (SomeException, handle)
3133import Control.Monad (forM_)
34+import Control.Monad.Error
3235import Data.Monoid (Monoid (..))
3336import Data.Set (Set)
3437import qualified Data.Set as S
@@ -146,6 +149,11 @@ instance MonadMetadata Compiler where
146149 getMetadata = compilerGetMetadata
147150 getMatches = compilerGetMatches
148151
152+--------------------------------------------------------------------------------
153+instance MonadError [String] Compiler where
154+ throwError = compilerThrow
155+ catchError = compilerCatch
156+
149157
150158--------------------------------------------------------------------------------
151159runCompiler :: Compiler a -> CompilerRead -> IO (CompilerResult a)
src/Hakyll/Web/Template.hs+14−7
@@ -44,7 +44,8 @@ module Hakyll.Web.Template
4444
4545
4646--------------------------------------------------------------------------------
47−import Control.Monad (forM, liftM)
47+import Control.Monad (liftM)
48+import Control.Monad.Error (MonadError(..))
4849import Data.Monoid (mappend)
4950import Prelude hiding (id)
5051
@@ -112,11 +113,17 @@ applyAsTemplate context item =
112113
113114--------------------------------------------------------------------------------
114115-- | Overloaded apply template function to work in an arbitrary Monad.
115−applyTemplateWith :: Monad m
116+applyTemplateWith :: MonadError e m
116117 => (String -> a -> m String)
117118 -> Template -> a -> m String
118−applyTemplateWith context tpl x = liftM concat $
119− forM (unTemplate tpl) $ \e -> case e of
120− Chunk c -> return c
121− Escaped -> return "$"
122− Key k -> context k x
119+applyTemplateWith context tpl x = go tpl where
120+
121+ go = liftM concat . mapM applyElem . unTemplate
122+
123+ applyElem (Chunk c) = return c
124+ applyElem Escaped = return "$"
125+ applyElem (Key k) = context k x
126+ applyElem (If k t mf) = (context k x >> go t) `catchError` handler where
127+ handler _ = case mf of
128+ Nothing -> return ""
129+ Just f -> go f
src/Hakyll/Web/Template/Internal.hs+7−5
@@ -9,7 +9,7 @@ module Hakyll.Web.Template.Internal
99
1010
1111--------------------------------------------------------------------------------
12−import Control.Applicative ((<$>))
12+import Control.Applicative (pure, (<$>), (<*>))
1313import Data.Binary (Binary, get, getWord8, put, putWord8)
1414import Data.Typeable (Typeable)
1515
@@ -38,18 +38,20 @@ data TemplateElement
3838 = Chunk String
3939 | Key String
4040 | Escaped
41+ | If String Template (Maybe Template) -- key, then branch, else branch
4142 deriving (Show, Eq, Typeable)
4243
43−
4444--------------------------------------------------------------------------------
4545instance Binary TemplateElement where
46− put (Chunk string) = putWord8 0 >> put string
47− put (Key key) = putWord8 1 >> put key
46+ put (Chunk string) = putWord8 0 >> put string
47+ put (Key key) = putWord8 1 >> put key
4848 put (Escaped) = putWord8 2
49+ put (If key t f) = putWord8 3 >> put key >> put t >> put f
4950
5051 get = getWord8 >>= \tag -> case tag of
5152 0 -> Chunk <$> get
5253 1 -> Key <$> get
53− 2 -> return Escaped
54+ 2 -> pure Escaped
55+ 3 -> If <$> get <*> get <*> get
5456 _ -> error $ "Hakyll.Web.Template.Internal: "
5557 ++ "Error reading cached template"
src/Hakyll/Web/Template/Read.hs+46−28
@@ -4,38 +4,56 @@ module Hakyll.Web.Template.Read
44 ( readTemplate
55 ) where
66
7−
87--------------------------------------------------------------------------------
9−import Data.List (isPrefixOf)
10−
8+import Control.Applicative ((<$>), (<$), (<*>))
9+import Control.Monad (void, mzero)
10+import Text.Parsec
11+import Text.Parsec.String
1112
1213--------------------------------------------------------------------------------
1314import Hakyll.Web.Template.Internal
1415
15−
1616--------------------------------------------------------------------------------
17−-- | Construct a @Template@ from a string.
17+
1818readTemplate :: String -> Template
19−readTemplate = Template . readTemplate'
20− where
21− readTemplate' [] = []
22− readTemplate' string
23− | "$$" `isPrefixOf` string =
24− Escaped : readTemplate' (drop 2 string)
25− | "$" `isPrefixOf` string =
26− case readKey (drop 1 string) of
27− Just (key, rest) -> Key key : readTemplate' rest
28− Nothing -> Chunk "$" : readTemplate' (drop 1 string)
29− | otherwise =
30− let (chunk, rest) = break (== '$') string
31− in Chunk chunk : readTemplate' rest
32−
33− -- Parse an key into (key, rest) if it's valid, and return
34− -- Nothing otherwise
35− readKey string =
36− let (key, rest) = span validKeyChar string
37− in if not (null key) && "$" `isPrefixOf` rest
38− then Just (key, drop 1 rest)
39− else Nothing
40−
41− validKeyChar x = x `notElem` ['$', '\n', '\r']
19+readTemplate input =
20+ case parse template "" input of
21+ Left err -> error $ "Cannot parse template: " ++ show err
22+ Right t -> t
23+
24+template :: Parser Template
25+template = Template <$>
26+ (many1 $ chunk <|> escaped <|> conditional <|> key)
27+
28+chunk :: Parser TemplateElement
29+chunk = Chunk <$> (many1 $ noneOf "$")
30+
31+escaped :: Parser TemplateElement
32+escaped = Escaped <$ (try $ string "$$")
33+
34+conditional :: Parser TemplateElement
35+conditional = try $ do
36+ void $ string "$if("
37+ i <- ident
38+ void $ string ")$"
39+ thenBranch <- template
40+ elseBranch <- optionMaybe $ try (string "$else$") >> template
41+ void $ string "$endif$"
42+ return $ If i thenBranch elseBranch
43+
44+ident :: Parser String
45+ident = do
46+ i <- (:) <$> letter <*> (many $ alphaNum <|> oneOf " _-.")
47+ if i `elem` reserved
48+ then mzero
49+ else return i
50+
51+reserved :: [String]
52+reserved = ["if", "else","endif"]
53+
54+key :: Parser TemplateElement
55+key = try $ do
56+ void $ char '$'
57+ k <- ident
58+ void $ char '$'
59+ return $ Key k
tests/data/template.html+12−1
@@ -1,5 +1,16 @@
11<div>
22 I'm so rich I have $$3.
3− $echo test!$
3+ $echo test$
4+ $if(body)$
5+ I have body
6+ $else$
7+ or no
8+ $endif$
9+ $if(unbound)$
10+ should not be printed
11+ $endif$
12+ $if(body)$
13+ should be printed
14+ $endif$
415 $body$
516</div>
tests/data/template.html.out+8−1
@@ -1,5 +1,12 @@
11<div>
22 I'm so rich I have $3.
3− test!
3+ test
4+
5+ I have body
6+
7+
8+
9+ should be printed
10+
411 <p>This is an example.</p>
512</div>