Merge remote-tracking branch 'sphynx/master'
This commit is contained in:
commit
28bc3f1f3b
6 changed files with 93 additions and 40 deletions
|
@ -2,6 +2,8 @@
|
|||
-- | Internally used compiler module
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
module Hakyll.Core.Compiler.Internal
|
||||
( -- * Types
|
||||
CompilerRead (..)
|
||||
|
@ -29,6 +31,7 @@ import Control.Applicative (Alternative (..),
|
|||
Applicative (..), (<$>))
|
||||
import Control.Exception (SomeException, handle)
|
||||
import Control.Monad (forM_)
|
||||
import Control.Monad.Error
|
||||
import Data.Monoid (Monoid (..))
|
||||
import Data.Set (Set)
|
||||
import qualified Data.Set as S
|
||||
|
@ -146,6 +149,11 @@ instance MonadMetadata Compiler where
|
|||
getMetadata = compilerGetMetadata
|
||||
getMatches = compilerGetMatches
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
instance MonadError [String] Compiler where
|
||||
throwError = compilerThrow
|
||||
catchError = compilerCatch
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
runCompiler :: Compiler a -> CompilerRead -> IO (CompilerResult a)
|
||||
|
|
|
@ -44,7 +44,8 @@ module Hakyll.Web.Template
|
|||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
import Control.Monad (forM, liftM)
|
||||
import Control.Monad (liftM)
|
||||
import Control.Monad.Error (MonadError(..))
|
||||
import Data.Monoid (mappend)
|
||||
import Prelude hiding (id)
|
||||
|
||||
|
@ -112,11 +113,17 @@ applyAsTemplate context item =
|
|||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Overloaded apply template function to work in an arbitrary Monad.
|
||||
applyTemplateWith :: Monad m
|
||||
applyTemplateWith :: MonadError e m
|
||||
=> (String -> a -> m String)
|
||||
-> Template -> a -> m String
|
||||
applyTemplateWith context tpl x = liftM concat $
|
||||
forM (unTemplate tpl) $ \e -> case e of
|
||||
Chunk c -> return c
|
||||
Escaped -> return "$"
|
||||
Key k -> context k x
|
||||
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
|
||||
|
|
|
@ -9,7 +9,7 @@ module Hakyll.Web.Template.Internal
|
|||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
import Control.Applicative ((<$>))
|
||||
import Control.Applicative (pure, (<$>), (<*>))
|
||||
import Data.Binary (Binary, get, getWord8, put, putWord8)
|
||||
import Data.Typeable (Typeable)
|
||||
|
||||
|
@ -38,18 +38,20 @@ data TemplateElement
|
|||
= Chunk String
|
||||
| Key String
|
||||
| Escaped
|
||||
| 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 (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
|
||||
|
||||
get = getWord8 >>= \tag -> case tag of
|
||||
0 -> Chunk <$> get
|
||||
1 -> Key <$> get
|
||||
2 -> return Escaped
|
||||
2 -> pure Escaped
|
||||
3 -> If <$> get <*> get <*> get
|
||||
_ -> error $ "Hakyll.Web.Template.Internal: "
|
||||
++ "Error reading cached template"
|
||||
|
|
|
@ -4,38 +4,56 @@ module Hakyll.Web.Template.Read
|
|||
( readTemplate
|
||||
) where
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
import Data.List (isPrefixOf)
|
||||
|
||||
import Control.Applicative ((<$>), (<$), (<*>))
|
||||
import Control.Monad (void, mzero)
|
||||
import Text.Parsec
|
||||
import Text.Parsec.String
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
import Hakyll.Web.Template.Internal
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Construct a @Template@ from a string.
|
||||
|
||||
readTemplate :: String -> Template
|
||||
readTemplate = Template . readTemplate'
|
||||
where
|
||||
readTemplate' [] = []
|
||||
readTemplate' string
|
||||
| "$$" `isPrefixOf` string =
|
||||
Escaped : readTemplate' (drop 2 string)
|
||||
| "$" `isPrefixOf` string =
|
||||
case readKey (drop 1 string) of
|
||||
Just (key, rest) -> Key key : readTemplate' rest
|
||||
Nothing -> Chunk "$" : readTemplate' (drop 1 string)
|
||||
| otherwise =
|
||||
let (chunk, rest) = break (== '$') string
|
||||
in Chunk chunk : readTemplate' rest
|
||||
readTemplate input =
|
||||
case parse template "" input of
|
||||
Left err -> error $ "Cannot parse template: " ++ show err
|
||||
Right t -> t
|
||||
|
||||
-- Parse an key into (key, rest) if it's valid, and return
|
||||
-- Nothing otherwise
|
||||
readKey string =
|
||||
let (key, rest) = span validKeyChar string
|
||||
in if not (null key) && "$" `isPrefixOf` rest
|
||||
then Just (key, drop 1 rest)
|
||||
else Nothing
|
||||
template :: Parser Template
|
||||
template = Template <$>
|
||||
(many1 $ chunk <|> escaped <|> conditional <|> key)
|
||||
|
||||
validKeyChar x = x `notElem` ['$', '\n', '\r']
|
||||
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"]
|
||||
|
||||
key :: Parser TemplateElement
|
||||
key = try $ do
|
||||
void $ char '$'
|
||||
k <- ident
|
||||
void $ char '$'
|
||||
return $ Key k
|
||||
|
|
|
@ -1,5 +1,16 @@
|
|||
<div>
|
||||
I'm so rich I have $$3.
|
||||
$echo test!$
|
||||
$echo test$
|
||||
$if(body)$
|
||||
I have body
|
||||
$else$
|
||||
or no
|
||||
$endif$
|
||||
$if(unbound)$
|
||||
should not be printed
|
||||
$endif$
|
||||
$if(body)$
|
||||
should be printed
|
||||
$endif$
|
||||
$body$
|
||||
</div>
|
||||
|
|
|
@ -1,5 +1,12 @@
|
|||
<div>
|
||||
I'm so rich I have $3.
|
||||
test!
|
||||
test
|
||||
|
||||
I have body
|
||||
|
||||
|
||||
|
||||
should be printed
|
||||
|
||||
<p>This is an example.</p>
|
||||
</div>
|
||||
|
|
Loading…
Reference in a new issue