diff options
Diffstat (limited to 'src/Hakyll/Web/Template')
| -rw-r--r-- | src/Hakyll/Web/Template/Context.hs | 10 | ||||
| -rw-r--r-- | src/Hakyll/Web/Template/Read.hs | 44 | ||||
| -rw-r--r-- | src/Hakyll/Web/Template/Read/Hakyll.hs | 35 | ||||
| -rw-r--r-- | src/Hakyll/Web/Template/Read/Hamlet.hs | 46 |
4 files changed, 48 insertions, 87 deletions
diff --git a/src/Hakyll/Web/Template/Context.hs b/src/Hakyll/Web/Template/Context.hs index eeec728..acc01bf 100644 --- a/src/Hakyll/Web/Template/Context.hs +++ b/src/Hakyll/Web/Template/Context.hs @@ -4,6 +4,7 @@ module Hakyll.Web.Template.Context , mapContext , field , constField + , functionField , defaultContext , bodyField @@ -71,6 +72,15 @@ 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 + + +-------------------------------------------------------------------------------- defaultContext :: Context String defaultContext = bodyField "body" `mappend` diff --git a/src/Hakyll/Web/Template/Read.hs b/src/Hakyll/Web/Template/Read.hs index 421b7e9..f8583ff 100644 --- a/src/Hakyll/Web/Template/Read.hs +++ b/src/Hakyll/Web/Template/Read.hs @@ -1,10 +1,42 @@ --- | Re-exports all different template reading modules --- +-------------------------------------------------------------------------------- +-- | Read templates in Hakyll's native format module Hakyll.Web.Template.Read ( readTemplate - , readHamletTemplate - , readHamletTemplateWith ) where -import Hakyll.Web.Template.Read.Hakyll -import Hakyll.Web.Template.Read.Hamlet + +-------------------------------------------------------------------------------- +import Data.List (isPrefixOf) +import Data.Char (isAlphaNum) + + +-------------------------------------------------------------------------------- +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 + + -- 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 + + validKeyChar x = isAlphaNum x || x == ' ' diff --git a/src/Hakyll/Web/Template/Read/Hakyll.hs b/src/Hakyll/Web/Template/Read/Hakyll.hs deleted file mode 100644 index fecf772..0000000 --- a/src/Hakyll/Web/Template/Read/Hakyll.hs +++ /dev/null @@ -1,35 +0,0 @@ --- | Read templates in Hakyll's native format --- -module Hakyll.Web.Template.Read.Hakyll - ( readTemplate - ) where - -import Data.List (isPrefixOf) -import Data.Char (isAlphaNum) - -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 - - -- Parse an key into (key, rest) if it's valid, and return - -- Nothing otherwise - readKey string = - let (key, rest) = span isAlphaNum string - in if not (null key) && "$" `isPrefixOf` rest - then Just (key, drop 1 rest) - else Nothing diff --git a/src/Hakyll/Web/Template/Read/Hamlet.hs b/src/Hakyll/Web/Template/Read/Hamlet.hs deleted file mode 100644 index a08cb1d..0000000 --- a/src/Hakyll/Web/Template/Read/Hamlet.hs +++ /dev/null @@ -1,46 +0,0 @@ --- | Read templates in the hamlet format --- -{-# LANGUAGE MultiParamTypeClasses #-} -module Hakyll.Web.Template.Read.Hamlet - ( readHamletTemplate - , readHamletTemplateWith - ) where - -import Text.Hamlet (HamletSettings, defaultHamletSettings) -import Text.Hamlet.RT - -import Hakyll.Web.Template.Internal - --- | Read a hamlet template using the default settings --- -readHamletTemplate :: String -> Template -readHamletTemplate = readHamletTemplateWith defaultHamletSettings - --- | Read a hamlet template using the specified settings --- -readHamletTemplateWith :: HamletSettings -> String -> Template -readHamletTemplateWith settings string = - let result = parseHamletRT settings string - in case result of - Just hamlet -> fromHamletRT hamlet - Nothing -> error - "Hakyll.Web.Template.Read.Hamlet.readHamletTemplateWith: \ - \Could not parse Hamlet file" - --- | Convert a 'HamletRT' to a 'Template' --- -fromHamletRT :: HamletRT -- ^ Hamlet runtime template - -> Template -- ^ Hakyll template -fromHamletRT (HamletRT sd) = Template $ map fromSimpleDoc sd - where - fromSimpleDoc :: SimpleDoc -> TemplateElement - fromSimpleDoc (SDRaw chunk) = Chunk chunk - fromSimpleDoc (SDVar [var]) = Key var - fromSimpleDoc (SDVar _) = error - "Hakyll.Web.Template.Read.Hamlet.fromHamletRT: \ - \Hakyll does not support '.' in identifier names when using \ - \hamlet templates." - fromSimpleDoc _ = error - "Hakyll.Web.Template.Read.Hamlet.fromHamletRT: \ - \Only simple $key$ identifiers are allowed when using hamlet \ - \templates." |