summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Hakyll/Core/Compiler/Internal.hs7
-rw-r--r--src/Hakyll/Core/Provider/Metadata.hs7
-rw-r--r--src/Hakyll/Core/Util/Parser.hs25
-rw-r--r--src/Hakyll/Web/Template.hs13
-rw-r--r--src/Hakyll/Web/Template/Internal.hs22
-rw-r--r--src/Hakyll/Web/Template/Read.hs57
6 files changed, 82 insertions, 49 deletions
diff --git a/src/Hakyll/Core/Compiler/Internal.hs b/src/Hakyll/Core/Compiler/Internal.hs
index fbb7528..5b3e466 100644
--- a/src/Hakyll/Core/Compiler/Internal.hs
+++ b/src/Hakyll/Core/Compiler/Internal.hs
@@ -1,9 +1,9 @@
--------------------------------------------------------------------------------
-- | Internally used compiler module
+{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
module Hakyll.Core.Compiler.Internal
( -- * Types
CompilerRead (..)
@@ -31,7 +31,7 @@ import Control.Applicative (Alternative (..),
Applicative (..), (<$>))
import Control.Exception (SomeException, handle)
import Control.Monad (forM_)
-import Control.Monad.Error
+import Control.Monad.Error (MonadError (..))
import Data.Monoid (Monoid (..))
import Data.Set (Set)
import qualified Data.Set as S
@@ -149,6 +149,7 @@ instance MonadMetadata Compiler where
getMetadata = compilerGetMetadata
getMatches = compilerGetMatches
+
--------------------------------------------------------------------------------
instance MonadError [String] Compiler where
throwError = compilerThrow
diff --git a/src/Hakyll/Core/Provider/Metadata.hs b/src/Hakyll/Core/Provider/Metadata.hs
index 0d94ad7..fe2857a 100644
--- a/src/Hakyll/Core/Provider/Metadata.hs
+++ b/src/Hakyll/Core/Provider/Metadata.hs
@@ -4,6 +4,9 @@ module Hakyll.Core.Provider.Metadata
( loadMetadata
, metadata
, page
+
+ -- This parser can be reused in some places
+ , metadataKey
) where
@@ -23,6 +26,7 @@ import Text.Parsec.String (Parser)
import Hakyll.Core.Identifier
import Hakyll.Core.Metadata
import Hakyll.Core.Provider.Internal
+import Hakyll.Core.Util.Parser
import Hakyll.Core.Util.String
@@ -93,7 +97,8 @@ newline = P.string "\n" <|> P.string "\r\n"
-- | Parse a single metadata field
metadataField :: Parser (String, String)
metadataField = do
- key <- P.manyTill P.alphaNum $ P.char ':'
+ key <- metadataKey
+ _ <- P.char ':'
P.skipMany1 inlineSpace <?> "space followed by metadata for: " ++ key
value <- P.manyTill P.anyChar newline
trailing' <- P.many trailing
diff --git a/src/Hakyll/Core/Util/Parser.hs b/src/Hakyll/Core/Util/Parser.hs
new file mode 100644
index 0000000..afa72c1
--- /dev/null
+++ b/src/Hakyll/Core/Util/Parser.hs
@@ -0,0 +1,25 @@
+--------------------------------------------------------------------------------
+-- | Parser utilities
+module Hakyll.Core.Util.Parser
+ ( metadataKey
+ , reservedKeys
+ ) where
+
+
+--------------------------------------------------------------------------------
+import Control.Applicative ((<$>), (<*>), (<|>))
+import Control.Monad (mzero)
+import qualified Text.Parsec as P
+import Text.Parsec.String (Parser)
+
+
+--------------------------------------------------------------------------------
+metadataKey :: Parser String
+metadataKey = do
+ i <- (:) <$> P.letter <*> (P.many $ P.alphaNum <|> P.oneOf " _-.")
+ if i `elem` reservedKeys then mzero else return i
+
+
+--------------------------------------------------------------------------------
+reservedKeys :: [String]
+reservedKeys = ["if", "else","endif"]
diff --git a/src/Hakyll/Web/Template.hs b/src/Hakyll/Web/Template.hs
index 371ccef..8e3859a 100644
--- a/src/Hakyll/Web/Template.hs
+++ b/src/Hakyll/Web/Template.hs
@@ -116,14 +116,15 @@ applyAsTemplate context item =
applyTemplateWith :: MonadError e m
=> (String -> a -> m String)
-> Template -> a -> m String
-applyTemplateWith context tpl x = go tpl where
-
+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
+ applyElem (If k t mf) = (context k x >> go t) `catchError` handler
+ where
+ handler _ = case mf of
+ Nothing -> return ""
+ Just f -> go f
diff --git a/src/Hakyll/Web/Template/Internal.hs b/src/Hakyll/Web/Template/Internal.hs
index 0bd999e..f939566 100644
--- a/src/Hakyll/Web/Template/Internal.hs
+++ b/src/Hakyll/Web/Template/Internal.hs
@@ -22,8 +22,7 @@ import Hakyll.Core.Writable
-- | Datatype used for template substitutions.
newtype Template = Template
{ unTemplate :: [TemplateElement]
- }
- deriving (Show, Eq, Binary, Typeable)
+ } deriving (Show, Eq, Binary, Typeable)
--------------------------------------------------------------------------------
@@ -41,17 +40,18 @@ data TemplateElement
| 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 (Escaped) = putWord8 2
- put (If key t f) = putWord8 3 >> put key >> put t >> put f
+ 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 -> pure Escaped
- 3 -> If <$> get <*> get <*> get
- _ -> error $ "Hakyll.Web.Template.Internal: "
- ++ "Error reading cached template"
+ 0 -> Chunk <$> get
+ 1 -> Key <$> get
+ 2 -> pure Escaped
+ 3 -> If <$> get <*> get <*> get
+ _ -> error $
+ "Hakyll.Web.Template.Internal: Error reading cached template"
diff --git a/src/Hakyll/Web/Template/Read.hs b/src/Hakyll/Web/Template/Read.hs
index 9504f0b..620ce14 100644
--- a/src/Hakyll/Web/Template/Read.hs
+++ b/src/Hakyll/Web/Template/Read.hs
@@ -4,56 +4,57 @@ module Hakyll.Web.Template.Read
( readTemplate
) where
+
--------------------------------------------------------------------------------
-import Control.Applicative ((<$>), (<$), (<*>))
-import Control.Monad (void, mzero)
+import Control.Applicative ((<$), (<$>))
+import Control.Monad (void)
import Text.Parsec
import Text.Parsec.String
+
--------------------------------------------------------------------------------
+import Hakyll.Core.Util.Parser
import Hakyll.Web.Template.Internal
---------------------------------------------------------------------------------
+--------------------------------------------------------------------------------
readTemplate :: String -> Template
-readTemplate input =
- case parse template "" input of
+readTemplate input = case parse template "" input of
Left err -> error $ "Cannot parse template: " ++ show err
Right t -> t
+
+--------------------------------------------------------------------------------
template :: Parser Template
-template = Template <$>
- (many1 $ chunk <|> escaped <|> conditional <|> key)
+template = Template <$> (many1 $ chunk <|> escaped <|> conditional <|> key)
+
+--------------------------------------------------------------------------------
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"]
+ void $ string "$if("
+ i <- metadataKey
+ void $ string ")$"
+ thenBranch <- template
+ elseBranch <- optionMaybe $ try (string "$else$") >> template
+ void $ string "$endif$"
+ return $ If i thenBranch elseBranch
+
+--------------------------------------------------------------------------------
key :: Parser TemplateElement
key = try $ do
- void $ char '$'
- k <- ident
- void $ char '$'
- return $ Key k
+ void $ char '$'
+ k <- metadataKey
+ void $ char '$'
+ return $ Key k
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-23 11:36:44 +0000