diff options
Diffstat (limited to 'src/Hakyll/Web/Template')
| -rw-r--r-- | src/Hakyll/Web/Template/Context.hs | 35 | ||||
| -rw-r--r-- | src/Hakyll/Web/Template/Internal.hs | 99 | ||||
| -rw-r--r-- | src/Hakyll/Web/Template/Read.hs | 93 |
3 files changed, 126 insertions, 101 deletions
diff --git a/src/Hakyll/Web/Template/Context.hs b/src/Hakyll/Web/Template/Context.hs index cd52eb0..a741272 100644 --- a/src/Hakyll/Web/Template/Context.hs +++ b/src/Hakyll/Web/Template/Context.hs @@ -56,6 +56,20 @@ data ContextField -------------------------------------------------------------------------------- +-- | The 'Context' monoid. Please note that the order in which you +-- compose the items is important. For example in +-- +-- > field "A" f1 <> field "A" f2 +-- +-- the first context will overwrite the second. This is especially +-- important when something is being composed with +-- 'metadataField' (or 'defaultContext'). If you want your context to be +-- overwritten by the metadata fields, compose it from the right: +-- +-- @ +-- 'metadataField' \<\> field \"date\" fDate +-- @ +-- newtype Context a = Context { unContext :: String -> Item a -> Compiler ContextField } @@ -73,11 +87,16 @@ field' key value = Context $ \k i -> if k == key then value i else empty -------------------------------------------------------------------------------- -field :: String -> (Item a -> Compiler String) -> Context a +-- | Constructs a new field in the 'Context.' +field :: String -- ^ Key + -> (Item a -> Compiler String) -- ^ Function that constructs a + -- value based on the item + -> Context a field key value = field' key (fmap StringField . value) -------------------------------------------------------------------------------- +-- | Creates a 'field' that does not depend on the 'Item' constField :: String -> String -> Context a constField key = field key . const . return @@ -108,6 +127,17 @@ mapContext f (Context c) = Context $ \k i -> do -------------------------------------------------------------------------------- +-- | A context that contains (in that order) +-- +-- 1. A @$body$@ field +-- +-- 2. Metadata fields +-- +-- 3. A @$url$@ 'urlField' +-- +-- 4. A @$path$@ 'pathField' +-- +-- 5. A @$title$@ 'titleField' defaultContext :: Context String defaultContext = bodyField "body" `mappend` @@ -124,6 +154,7 @@ teaserSeparator = "<!--more-->" -------------------------------------------------------------------------------- +-- | Constructs a 'field' that contains the body of the item. bodyField :: String -> Context String bodyField key = field key $ return . itemBody @@ -150,7 +181,7 @@ pathField key = field key $ return . toFilePath . itemIdentifier -------------------------------------------------------------------------------- --- | This title field takes the basename of the underlying file by default +-- | This title 'field' takes the basename of the underlying file by default titleField :: String -> Context a titleField = mapContext takeBaseName . pathField diff --git a/src/Hakyll/Web/Template/Internal.hs b/src/Hakyll/Web/Template/Internal.hs index 138010e..4450a19 100644 --- a/src/Hakyll/Web/Template/Internal.hs +++ b/src/Hakyll/Web/Template/Internal.hs @@ -5,16 +5,22 @@ module Hakyll.Web.Template.Internal ( Template (..) , TemplateElement (..) + , readTemplate ) where -------------------------------------------------------------------------------- -import Control.Applicative (pure, (<$>), (<*>)) -import Data.Binary (Binary, get, getWord8, put, putWord8) -import Data.Typeable (Typeable) +import Control.Applicative (pure, (<$), (<$>), (<*>), (<|>)) +import Control.Monad (void) +import Data.Binary (Binary, get, getWord8, put, putWord8) +import Data.Typeable (Typeable) +import GHC.Exts (IsString (..)) +import qualified Text.Parsec as P +import qualified Text.Parsec.String as P -------------------------------------------------------------------------------- +import Hakyll.Core.Util.Parser import Hakyll.Core.Writable @@ -46,10 +52,10 @@ data TemplateElement -------------------------------------------------------------------------------- instance Binary TemplateElement where put (Chunk string) = putWord8 0 >> put string - put (Key key) = putWord8 1 >> put key + put (Key k) = putWord8 1 >> put k put (Escaped) = putWord8 2 - put (If key t f) = putWord8 3 >> put key >> put t >> put f - put (For key b s) = putWord8 4 >> put key >> put b >> put s + put (If k t f ) = putWord8 3 >> put k >> put t >> put f + put (For k b s) = putWord8 4 >> put k >> put b >> put s put (Partial p) = putWord8 5 >> put p get = getWord8 >>= \tag -> case tag of @@ -61,3 +67,84 @@ instance Binary TemplateElement where 5 -> Partial <$> get _ -> error $ "Hakyll.Web.Template.Internal: Error reading cached template" + + +-------------------------------------------------------------------------------- +instance IsString Template where + fromString = readTemplate + + +-------------------------------------------------------------------------------- +readTemplate :: String -> Template +readTemplate input = case P.parse template "" input of + Left err -> error $ "Cannot parse template: " ++ show err + Right t -> t + + +-------------------------------------------------------------------------------- +template :: P.Parser Template +template = Template <$> + (P.many1 $ chunk <|> escaped <|> conditional <|> for <|> partial <|> key) + + +-------------------------------------------------------------------------------- +chunk :: P.Parser TemplateElement +chunk = Chunk <$> (P.many1 $ P.noneOf "$") + + +-------------------------------------------------------------------------------- +escaped :: P.Parser TemplateElement +escaped = Escaped <$ (P.try $ P.string "$$") + + +-------------------------------------------------------------------------------- +conditional :: P.Parser TemplateElement +conditional = P.try $ do + void $ P.string "$if(" + i <- metadataKey + void $ P.string ")$" + thenBranch <- template + elseBranch <- P.optionMaybe $ P.try (P.string "$else$") >> template + void $ P.string "$endif$" + return $ If i thenBranch elseBranch + + +-------------------------------------------------------------------------------- +for :: P.Parser TemplateElement +for = P.try $ do + void $ P.string "$for(" + i <- metadataKey + void $ P.string ")$" + body <- template + sep <- P.optionMaybe $ P.try (P.string "$sep$") >> template + void $ P.string "$endfor$" + return $ For i body sep + + +-------------------------------------------------------------------------------- +partial :: P.Parser TemplateElement +partial = P.try $ do + void $ P.string "$partial(" + i <- stringLiteral + void $ P.string ")$" + return $ Partial i + + +-------------------------------------------------------------------------------- +key :: P.Parser TemplateElement +key = P.try $ do + void $ P.char '$' + k <- metadataKey + void $ P.char '$' + return $ Key k + + +-------------------------------------------------------------------------------- +stringLiteral :: P.Parser String +stringLiteral = do + void $ P.char '\"' + str <- P.many $ do + x <- P.noneOf "\"" + if x == '\\' then P.anyChar else return x + void $ P.char '\"' + return str diff --git a/src/Hakyll/Web/Template/Read.hs b/src/Hakyll/Web/Template/Read.hs deleted file mode 100644 index 2421b2d..0000000 --- a/src/Hakyll/Web/Template/Read.hs +++ /dev/null @@ -1,93 +0,0 @@ --------------------------------------------------------------------------------- --- | Read templates in Hakyll's native format -module Hakyll.Web.Template.Read - ( readTemplate - ) where - - --------------------------------------------------------------------------------- -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 - Left err -> error $ "Cannot parse template: " ++ show err - Right t -> t - - --------------------------------------------------------------------------------- -template :: Parser Template -template = Template <$> - (many1 $ chunk <|> escaped <|> conditional <|> for <|> partial <|> 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 <- metadataKey - void $ string ")$" - thenBranch <- template - elseBranch <- optionMaybe $ try (string "$else$") >> template - void $ string "$endif$" - return $ If i thenBranch elseBranch - - --------------------------------------------------------------------------------- -for :: Parser TemplateElement -for = try $ do - void $ string "$for(" - i <- metadataKey - void $ string ")$" - body <- template - sep <- optionMaybe $ try (string "$sep$") >> template - void $ string "$endfor$" - return $ For i body sep - - --------------------------------------------------------------------------------- -partial :: Parser TemplateElement -partial = try $ do - void $ string "$partial(" - i <- stringLiteral - void $ string ")$" - return $ Partial i - - --------------------------------------------------------------------------------- -key :: Parser TemplateElement -key = try $ do - void $ char '$' - k <- metadataKey - void $ char '$' - return $ Key k - - --------------------------------------------------------------------------------- -stringLiteral :: Parser String -stringLiteral = do - void $ char '\"' - str <- many $ do - x <- noneOf "\"" - if x == '\\' then anyChar else return x - void $ char '\"' - return str |