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 | 7 | ||||
| -rw-r--r-- | src/Hakyll/Web/Template/Read.hs | 15 |
3 files changed, 39 insertions, 18 deletions
diff --git a/src/Hakyll/Web/Template/Context.hs b/src/Hakyll/Web/Template/Context.hs index 74c2e8d..7b2d920 100644 --- a/src/Hakyll/Web/Template/Context.hs +++ b/src/Hakyll/Web/Template/Context.hs @@ -1,10 +1,11 @@ -------------------------------------------------------------------------------- +{-# LANGUAGE ExistentialQuantification #-} module Hakyll.Web.Template.Context - ( Context (..) - , mapContext + ( ContextField (..) + , Context (..) , field , constField - , functionField + , listField , defaultContext , teaserContext @@ -46,8 +47,15 @@ import Hakyll.Web.Html -------------------------------------------------------------------------------- +-- | Mostly for internal usage +data ContextField + = StringField String + | forall a. ListField (Context a) [Item a] + + +-------------------------------------------------------------------------------- newtype Context a = Context - { unContext :: String -> Item a -> Compiler String + { unContext :: String -> Item a -> Compiler ContextField } @@ -58,13 +66,13 @@ instance Monoid (Context a) where -------------------------------------------------------------------------------- -mapContext :: (String -> String) -> Context a -> Context a -mapContext f (Context g) = Context $ \k i -> f <$> g k i +field' :: String -> (Item a -> Compiler ContextField) -> Context a +field' key value = Context $ \k i -> if k == key then value i else empty -------------------------------------------------------------------------------- field :: String -> (Item a -> Compiler String) -> Context a -field key value = Context $ \k i -> if k == key then value i else empty +field key value = field' key (fmap StringField . value) -------------------------------------------------------------------------------- @@ -73,12 +81,8 @@ constField key = field key . const . return -------------------------------------------------------------------------------- -functionField :: String -> ([String] -> Item a -> Compiler String) -> Context a -functionField name value = Context $ \k i -> case words k of - [] -> empty - (n : args) - | n == name -> value args i - | otherwise -> empty +listField :: String -> Context a -> Compiler [Item a] -> Context b +listField key c xs = field' key $ \_ -> fmap (ListField c) xs -------------------------------------------------------------------------------- @@ -91,6 +95,7 @@ defaultContext = titleField "title" `mappend` missingField + -------------------------------------------------------------------------------- -- | A context with "teaser" key which contain a teaser of the item. -- The item is loaded from the given snapshot (which should be saved @@ -116,7 +121,7 @@ bodyField key = field key $ return . itemBody metadataField :: Context String metadataField = Context $ \k i -> do value <- getMetadataField (itemIdentifier i) k - maybe empty return value + maybe empty (return . StringField) value -------------------------------------------------------------------------------- @@ -135,7 +140,7 @@ pathField key = field key $ return . toFilePath . itemIdentifier -------------------------------------------------------------------------------- -- | This title field takes the basename of the underlying file by default titleField :: String -> Context a -titleField key = mapContext takeBaseName $ pathField key +titleField key = field key $ return . takeBaseName . toFilePath . itemIdentifier -------------------------------------------------------------------------------- diff --git a/src/Hakyll/Web/Template/Internal.hs b/src/Hakyll/Web/Template/Internal.hs index f939566..1c81670 100644 --- a/src/Hakyll/Web/Template/Internal.hs +++ b/src/Hakyll/Web/Template/Internal.hs @@ -37,7 +37,8 @@ data TemplateElement = Chunk String | Key String | Escaped - | If String Template (Maybe Template) -- key, then branch, else branch + | If String Template (Maybe Template) -- key, then branch, else branch + | For String Template (Maybe Template) -- key, body, separator deriving (Show, Eq, Typeable) @@ -47,11 +48,13 @@ instance Binary TemplateElement where 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 (For key b s) = putWord8 4 >> put key >> put b >> put s get = getWord8 >>= \tag -> case tag of 0 -> Chunk <$> get 1 -> Key <$> get 2 -> pure Escaped - 3 -> If <$> get <*> get <*> get + 3 -> If <$> get <*> get <*> get + 4 -> For <$> 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 620ce14..2dd0fc5 100644 --- a/src/Hakyll/Web/Template/Read.hs +++ b/src/Hakyll/Web/Template/Read.hs @@ -26,7 +26,8 @@ readTemplate input = case parse template "" input of -------------------------------------------------------------------------------- template :: Parser Template -template = Template <$> (many1 $ chunk <|> escaped <|> conditional <|> key) +template = Template <$> + (many1 $ chunk <|> escaped <|> conditional <|> for <|> key) -------------------------------------------------------------------------------- @@ -52,6 +53,18 @@ conditional = try $ do -------------------------------------------------------------------------------- +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 + + +-------------------------------------------------------------------------------- key :: Parser TemplateElement key = try $ do void $ char '$' |