28bc3f1 · hakyll · git.iko.soy

src/Hakyll/Core/Compiler/Internal.hs+8

compare with master

unifiedsplit

@@ -2,6 +2,8 @@

2-- | Internally used compiler module

3{-# LANGUAGE GADTs #-}

4{-# LANGUAGE GeneralizedNewtypeDeriving #-}

5+{-# LANGUAGE FlexibleInstances #-}

6+{-# LANGUAGE MultiParamTypeClasses #-}

5module Hakyll.Core.Compiler.Internal

7module Hakyll.Core.Compiler.Internal

6 ( -- * Types

8 ( -- * Types

7 CompilerRead (..)

9 CompilerRead (..)

@@ -29,6 +31,7 @@ import Control.Applicative (Alternative (..),

29 Applicative (..), (<$>))

31 Applicative (..), (<$>))

30import Control.Exception (SomeException, handle)

32import Control.Exception (SomeException, handle)

31import Control.Monad (forM_)

33import Control.Monad (forM_)

34+import Control.Monad.Error

32import Data.Monoid (Monoid (..))

35import Data.Monoid (Monoid (..))

33import Data.Set (Set)

36import Data.Set (Set)

34import qualified Data.Set as S

37import qualified Data.Set as S

@@ -146,6 +149,11 @@ instance MonadMetadata Compiler where

146 getMetadata = compilerGetMetadata

149 getMetadata = compilerGetMetadata

147 getMatches = compilerGetMatches

150 getMatches = compilerGetMatches

148

151

152+--------------------------------------------------------------------------------

153+instance MonadError [String] Compiler where

154+ throwError = compilerThrow

155+ catchError = compilerCatch

156+

149

157

150--------------------------------------------------------------------------------

158--------------------------------------------------------------------------------

151runCompiler :: Compiler a -> CompilerRead -> IO (CompilerResult a)

159runCompiler :: Compiler a -> CompilerRead -> IO (CompilerResult a)

src/Hakyll/Web/Template.hs+14−7

@@ -44,7 +44,8 @@ module Hakyll.Web.Template

44

45

46--------------------------------------------------------------------------------

47−import Control.Monad (forM, liftM)

47+import Control.Monad (liftM)

48+import Control.Monad.Error (MonadError(..))

48import Data.Monoid (mappend)

49import Data.Monoid (mappend)

49import Prelude hiding (id)

50import Prelude hiding (id)

50

51

@@ -112,11 +113,17 @@ applyAsTemplate context item =

112

113

113--------------------------------------------------------------------------------

114--------------------------------------------------------------------------------

114-- | Overloaded apply template function to work in an arbitrary Monad.

115-- | Overloaded apply template function to work in an arbitrary Monad.

115−applyTemplateWith :: Monad m

116+applyTemplateWith :: MonadError e m

116 => (String -> a -> m String)

117 => (String -> a -> m String)

117 -> Template -> a -> m String

118 -> Template -> a -> m String

118−applyTemplateWith context tpl x = liftM concat $

119+applyTemplateWith context tpl x = go tpl where

119− forM (unTemplate tpl) $ \e -> case e of

120+

121+ go = liftM concat . mapM applyElem . unTemplate

122+

120− Chunk c -> return c

123+ applyElem (Chunk c) = return c

121− Escaped -> return "$"

124+ applyElem Escaped = return "$"

122− Key k -> context k x

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

9

10

11--------------------------------------------------------------------------------

12−import Control.Applicative ((<$>))

12+import Control.Applicative (pure, (<$>), (<*>))

13import Data.Binary (Binary, get, getWord8, put, putWord8)

14import Data.Typeable (Typeable)

15

@@ -38,18 +38,20 @@ data TemplateElement

38 = Chunk String

39 | Key String

40 | Escaped

41+ | If String Template (Maybe Template) -- key, then branch, else branch

41 deriving (Show, Eq, Typeable)

42 deriving (Show, Eq, Typeable)

42

43

43−

44--------------------------------------------------------------------------------

45instance Binary TemplateElement where

46− put (Chunk string) = putWord8 0 >> put string

46+ put (Chunk string) = putWord8 0 >> put string

47− put (Key key) = putWord8 1 >> put key

47+ put (Key key) = putWord8 1 >> put key

48 put (Escaped) = putWord8 2

49+ put (If key t f) = putWord8 3 >> put key >> put t >> put f

49

50

50 get = getWord8 >>= \tag -> case tag of

51 get = getWord8 >>= \tag -> case tag of

51 0 -> Chunk <$> get

52 0 -> Chunk <$> get

52 1 -> Key <$> get

53 1 -> Key <$> get

53− 2 -> return Escaped

54+ 2 -> pure Escaped

55+ 3 -> If <$> get <*> get <*> get

54 _ -> error $ "Hakyll.Web.Template.Internal: "

56 _ -> error $ "Hakyll.Web.Template.Internal: "

55 ++ "Error reading cached template"

57 ++ "Error reading cached template"

src/Hakyll/Web/Template/Read.hs+46−28

@@ -4,38 +4,56 @@ module Hakyll.Web.Template.Read

4 ( readTemplate

5 ) where

6

7−

8--------------------------------------------------------------------------------

7--------------------------------------------------------------------------------

9−import Data.List (isPrefixOf)

8+import Control.Applicative ((<$>), (<$), (<*>))

10−

9+import Control.Monad (void, mzero)

10+import Text.Parsec

11+import Text.Parsec.String

11

12

12--------------------------------------------------------------------------------

13--------------------------------------------------------------------------------

13import Hakyll.Web.Template.Internal

14import Hakyll.Web.Template.Internal

14

15

15−

16--------------------------------------------------------------------------------

17−-- | Construct a @Template@ from a string.

17+

18readTemplate :: String -> Template

19−readTemplate = Template . readTemplate'

19+readTemplate input =

20− where

20+ case parse template "" input of

21− readTemplate' [] = []

21+ Left err -> error $ "Cannot parse template: " ++ show err

22− readTemplate' string

22+ Right t -> t

23− | "$$" `isPrefixOf` string =

23+

24− Escaped : readTemplate' (drop 2 string)

24+template :: Parser Template

25− | "$" `isPrefixOf` string =

25+template = Template <$>

26− case readKey (drop 1 string) of

26+ (many1 $ chunk <|> escaped <|> conditional <|> key)

27− Just (key, rest) -> Key key : readTemplate' rest

27+

28− Nothing -> Chunk "$" : readTemplate' (drop 1 string)

28+chunk :: Parser TemplateElement

29− | otherwise =

29+chunk = Chunk <$> (many1 $ noneOf "$")

30− let (chunk, rest) = break (== '$') string

30+

31− in Chunk chunk : readTemplate' rest

31+escaped :: Parser TemplateElement

32−

32+escaped = Escaped <$ (try $ string "$$")

33− -- Parse an key into (key, rest) if it's valid, and return

33+

34− -- Nothing otherwise

34+conditional :: Parser TemplateElement

35− readKey string =

35+conditional = try $ do

36− let (key, rest) = span validKeyChar string

36+ void $ string "$if("

37− in if not (null key) && "$" `isPrefixOf` rest

37+ i <- ident

38− then Just (key, drop 1 rest)

38+ void $ string ")$"

39− else Nothing

39+ thenBranch <- template

40−

40+ elseBranch <- optionMaybe $ try (string "$else$") >> template

41− validKeyChar x = x `notElem` ['$', '\n', '\r']

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 @@

1<div>

2 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$

4 $body$

15 $body$

5</div>

16</div>

tests/data/template.html.out+8−1

@@ -1,5 +1,12 @@

1<div>

2 I'm so rich I have $3.

3− test!

3+ test

4+

5+ I have body

6+

7+

8+

9+ should be printed

10+

4 <p>This is an example.</p>

11 <p>This is an example.</p>

5</div>

12</div>