diff options
Diffstat (limited to 'lib/Hakyll/Web')
| -rw-r--r-- | lib/Hakyll/Web/Feed.hs | 55 | ||||
| -rw-r--r-- | lib/Hakyll/Web/Template.hs | 26 | ||||
| -rw-r--r-- | lib/Hakyll/Web/Template/Context.hs | 132 | ||||
| -rw-r--r-- | lib/Hakyll/Web/Template/Internal.hs | 144 | ||||
| -rw-r--r-- | lib/Hakyll/Web/Template/Internal/Element.hs | 21 |
5 files changed, 257 insertions, 121 deletions
diff --git a/lib/Hakyll/Web/Feed.hs b/lib/Hakyll/Web/Feed.hs index 6f6d699..468453b 100644 --- a/lib/Hakyll/Web/Feed.hs +++ b/lib/Hakyll/Web/Feed.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} -------------------------------------------------------------------------------- -- | A Module that allows easy rendering of RSS feeds. @@ -37,27 +38,26 @@ import Hakyll.Web.Template.List -------------------------------------------------------------------------------- -import Data.FileEmbed (makeRelativeToProject, embedFile) -import qualified Data.Text as T -import qualified Data.Text.Encoding as T +import Data.FileEmbed (makeRelativeToProject) -------------------------------------------------------------------------------- -rssTemplate :: String -rssTemplate = T.unpack $ - T.decodeUtf8 $(makeRelativeToProject "data/templates/rss.xml" >>= embedFile) +rssTemplate :: Template +rssTemplate = + $(makeRelativeToProject "data/templates/rss.xml" >>= embedTemplate) -rssItemTemplate :: String -rssItemTemplate = T.unpack $ - T.decodeUtf8 $(makeRelativeToProject "data/templates/rss-item.xml" >>= embedFile) +rssItemTemplate :: Template +rssItemTemplate = + $(makeRelativeToProject "data/templates/rss-item.xml" >>= embedTemplate) -atomTemplate :: String -atomTemplate = T.unpack $ - T.decodeUtf8 $(makeRelativeToProject "data/templates/atom.xml" >>= embedFile) +atomTemplate :: Template +atomTemplate = + $(makeRelativeToProject "data/templates/atom.xml" >>= embedTemplate) + +atomItemTemplate :: Template +atomItemTemplate = + $(makeRelativeToProject "data/templates/atom-item.xml" >>= embedTemplate) -atomItemTemplate :: String -atomItemTemplate = T.unpack $ - T.decodeUtf8 $(makeRelativeToProject "data/templates/atom-item.xml" >>= embedFile) -------------------------------------------------------------------------------- -- | This is a data structure to keep the configuration of a feed. @@ -77,16 +77,13 @@ data FeedConfiguration = FeedConfiguration -------------------------------------------------------------------------------- -- | Abstract function to render any feed. -renderFeed :: String -- ^ Default feed template - -> String -- ^ Default item template +renderFeed :: Template -- ^ Default feed template + -> Template -- ^ Default item template -> FeedConfiguration -- ^ Feed configuration -> Context String -- ^ Context for the items -> [Item String] -- ^ Input items -> Compiler (Item String) -- ^ Resulting item -renderFeed defFeed defItem config itemContext items = do - feedTpl <- readTemplateFile defFeed - itemTpl <- readTemplateFile defItem - +renderFeed feedTpl itemTpl config itemContext items = do protectedItems <- mapM (applyFilter protectCDATA) items body <- makeItem =<< applyTemplateList itemTpl itemContext' protectedItems applyTemplate feedTpl feedContext body @@ -120,18 +117,14 @@ renderFeed defFeed defItem config itemContext items = do updatedField = field "updated" $ \_ -> case items of [] -> return "Unknown" (x : _) -> unContext itemContext' "updated" [] x >>= \cf -> case cf of - ListField _ _ -> fail "Hakyll.Web.Feed.renderFeed: Internal error" StringField s -> return s - - readTemplateFile :: String -> Compiler Template - readTemplateFile value = pure $ template $ readTemplateElems value - + _ -> fail "Hakyll.Web.Feed.renderFeed: Internal error" -------------------------------------------------------------------------------- -- | Render an RSS feed using given templates with a number of items. renderRssWithTemplates :: - String -- ^ Feed template - -> String -- ^ Item template + Template -- ^ Feed template + -> Template -- ^ Item template -> FeedConfiguration -- ^ Feed configuration -> Context String -- ^ Item context -> [Item String] -- ^ Feed items @@ -144,8 +137,8 @@ renderRssWithTemplates feedTemplate itemTemplate config context = renderFeed -------------------------------------------------------------------------------- -- | Render an Atom feed using given templates with a number of items. renderAtomWithTemplates :: - String -- ^ Feed template - -> String -- ^ Item template + Template -- ^ Feed template + -> Template -- ^ Item template -> FeedConfiguration -- ^ Feed configuration -> Context String -- ^ Item context -> [Item String] -- ^ Feed items diff --git a/lib/Hakyll/Web/Template.hs b/lib/Hakyll/Web/Template.hs index a436106..3ef79f9 100644 --- a/lib/Hakyll/Web/Template.hs +++ b/lib/Hakyll/Web/Template.hs @@ -138,19 +138,41 @@ -- > 3...2...1 -- > </p> -- +{-# LANGUAGE TemplateHaskell #-} module Hakyll.Web.Template ( Template - , template - , readTemplateElems , templateBodyCompiler , templateCompiler , applyTemplate , loadAndApplyTemplate , applyAsTemplate , readTemplate + , compileTemplateItem , unsafeReadTemplateFile + , embedTemplate ) where -------------------------------------------------------------------------------- import Hakyll.Web.Template.Internal + + +-------------------------------------------------------------------------------- +import Data.FileEmbed (embedFile) +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Language.Haskell.TH (Exp, Q) + + +-------------------------------------------------------------------------------- +-- | Embed template allows you embed a template within the Haskell binary. +-- Example: +-- +-- > myTemplate :: Template +-- > myTemplate = $(embedTemplate "test.html") +embedTemplate :: FilePath -> Q Exp +embedTemplate filePath = [| + let source = T.unpack $ T.decodeUtf8 $(embedFile filePath) in + case parseTemplateElemsFile filePath source of + Left err -> error err + Right tpl -> template filePath tpl |] diff --git a/lib/Hakyll/Web/Template/Context.hs b/lib/Hakyll/Web/Template/Context.hs index 8038253..9cd1426 100644 --- a/lib/Hakyll/Web/Template/Context.hs +++ b/lib/Hakyll/Web/Template/Context.hs @@ -1,3 +1,23 @@ +-- | This module provides 'Context's which are used to expand expressions in +-- templates and allow for arbitrary customisation. +-- +-- 'Template's define a small expression DSL which consists of strings, +-- identifiers and function application. There is no type system, every value is +-- a string and on the top level they get substituted verbatim into the page. +-- +-- For example, you can build a context that contains +-- +-- > … <> functionField "concat" (const . concat) <> … +-- +-- which will allow you to use the @concat@ identifier as a function that takes +-- arbitrarily many stings and concatenates them to a new string: +-- +-- > $partial(concat("templates/categories/", category))$ +-- +-- This will evaluate the @category@ field in the context, then prepend he path, +-- and include the referenced file as a template. + + -------------------------------------------------------------------------------- {-# LANGUAGE CPP #-} {-# LANGUAGE ExistentialQuantification #-} @@ -50,13 +70,16 @@ import Hakyll.Core.Metadata import Hakyll.Core.Provider import Hakyll.Core.Util.String (needlePrefix, splitAll) import Hakyll.Web.Html -import System.FilePath (splitDirectories, takeBaseName, dropExtension) +import Prelude hiding (id) +import System.FilePath (dropExtension, splitDirectories, + takeBaseName) -------------------------------------------------------------------------------- -- | Mostly for internal usage data ContextField - = StringField String + = EmptyField + | StringField String | forall a. ListField (Context a) [Item a] @@ -81,6 +104,8 @@ newtype Context a = Context -------------------------------------------------------------------------------- +-- | Tries to find a key in the left context, +-- or when that fails in the right context. #if MIN_VERSION_base(4,9,0) instance Semigroup (Context a) where (<>) (Context f) (Context g) = Context $ \k a i -> f k a i <|> g k a i @@ -97,64 +122,101 @@ instance Monoid (Context a) where -------------------------------------------------------------------------------- field' :: String -> (Item a -> Compiler ContextField) -> Context a -field' key value = Context $ \k _ i -> if k == key then value i else empty +field' key value = Context $ \k _ i -> + if k == key + then value i + else noResult $ "Tried field " ++ key -------------------------------------------------------------------------------- --- | Constructs a new field in the 'Context.' +-- | Constructs a new field for a 'Context'. +-- If the key matches, the compiler is run and its result is substituted in the +-- template. +-- +-- If the compiler fails, the field will be considered non-existent +-- in an @$if()$@ macro or ultimately break the template application +-- (unless the key is found in another context when using '<>'). +-- Use 'empty' or 'noResult' for intentional failures of fields used in +-- @$if()$@, to distinguish them from exceptions thrown with 'fail'. field :: String -- ^ Key -> (Item a -> Compiler String) -- ^ Function that constructs a value based - -- on the item + -- on the item (e.g. accessing metadata) -> Context a field key value = field' key (fmap StringField . value) -------------------------------------------------------------------------------- -- | Creates a 'field' to use with the @$if()$@ template macro. +-- Attempting to substitute the field into the template will cause an error. boolField :: String -> (Item a -> Bool) -> Context a -boolField name f = field name (\i -> if f i - then pure (error $ unwords ["no string value for bool field:",name]) - else empty) +boolField name f = field' name (\i -> if f i + then return EmptyField + else noResult $ "Field " ++ name ++ " is false") -------------------------------------------------------------------------------- --- | Creates a 'field' that does not depend on the 'Item' -constField :: String -> String -> Context a +-- | Creates a 'field' that does not depend on the 'Item' but always yields +-- the same string +constField :: String -- ^ Key + -> String -- ^ Value + -> Context a constField key = field key . const . return -------------------------------------------------------------------------------- +-- | Creates a list field to be consumed by a @$for(…)$@ expression. +-- The compiler returns multiple items which are rendered in the loop body +-- with the supplied context. listField :: String -> Context a -> Compiler [Item a] -> Context b listField key c xs = listFieldWith key c (const xs) -------------------------------------------------------------------------------- +-- | Creates a list field like 'listField', but supplies the current page +-- to the compiler. listFieldWith :: String -> Context a -> (Item b -> Compiler [Item a]) -> Context b listFieldWith key c f = field' key $ fmap (ListField c) . f -------------------------------------------------------------------------------- -functionField :: String -> ([String] -> Item a -> Compiler String) -> Context a +-- | Creates a variadic function field. +-- +-- The function will be called with the dynamically evaluated string arguments +-- from the template as well as the page that is currently rendered. +functionField :: String -- ^ Key + -> ([String] -> Item a -> Compiler String) -- ^ Function + -> Context a functionField name value = Context $ \k args i -> if k == name then StringField <$> value args i - else empty + else noResult $ "Tried function field " ++ name -------------------------------------------------------------------------------- +-- | Transform the respective string results of all fields in a context. +-- For example, +-- +-- > mapContext (++"c") (constField "x" "a" <> constField "y" "b") +-- +-- is equivalent to +-- +-- > constField "x" "ac" <> constField "y" "bc" +-- mapContext :: (String -> String) -> Context a -> Context a mapContext f (Context c) = Context $ \k a i -> do fld <- c k a i case fld of + EmptyField -> wrongType "boolField" StringField str -> return $ StringField (f str) - ListField _ _ -> fail $ - "Hakyll.Web.Template.Context.mapContext: " ++ - "can't map over a ListField!" + _ -> wrongType "ListField" + where + wrongType typ = fail $ "Hakyll.Web.Template.Context.mapContext: " ++ + "can't map over a " ++ typ ++ "!" -------------------------------------------------------------------------------- -- | A context that allows snippet inclusion. In processed file, use as: @@ -163,15 +225,15 @@ mapContext f (Context c) = Context $ \k a i -> do -- > $snippet("path/to/snippet/")$ -- > ... -- --- The contents of the included file will not be interpolated. +-- The contents of the included file will not be interpolated like @partial@ +-- does it. -- snippetField :: Context String snippetField = functionField "snippet" f where f [contentsPath] _ = loadBody (fromFilePath contentsPath) - f _ i = error $ - "Too many arguments to function 'snippet()' in item " ++ - show (itemIdentifier i) + f [] _ = fail "No argument to function 'snippet()'" + f _ _ = fail "Too many arguments to function 'snippet()'" -------------------------------------------------------------------------------- -- | A context that contains (in that order) @@ -191,8 +253,7 @@ defaultContext = metadataField `mappend` urlField "url" `mappend` pathField "path" `mappend` - titleField "title" `mappend` - missingField + titleField "title" -------------------------------------------------------------------------------- @@ -210,15 +271,20 @@ bodyField key = field key $ return . itemBody -- | Map any field to its metadata value, if present metadataField :: Context a metadataField = Context $ \k _ i -> do - value <- getMetadataField (itemIdentifier i) k - maybe empty (return . StringField) value + let id = itemIdentifier i + empty' = noResult $ "No '" ++ k ++ "' field in metadata " ++ + "of item " ++ show id + value <- getMetadataField id k + maybe empty' (return . StringField) value -------------------------------------------------------------------------------- -- | Absolute url to the resulting item urlField :: String -> Context a -urlField key = field key $ - fmap (maybe empty toUrl) . getRoute . itemIdentifier +urlField key = field key $ \i -> do + let id = itemIdentifier i + empty' = fail $ "No route url found for item " ++ show id + fmap (maybe empty' toUrl) $ getRoute id -------------------------------------------------------------------------------- @@ -272,8 +338,8 @@ titleField = mapContext takeBaseName . pathField -- -- As another alternative, if none of the above matches, and the file has a -- path which contains nested directories specifying a date, then that date --- will be used. In other words, if the path is of the form --- @**//yyyy//mm//dd//**//main.extension@ . +-- will be used. In other words, if the path is of the form +-- @**//yyyy//mm//dd//**//main.extension@ . -- As above, in case of multiple matches, the rightmost one is used. dateField :: String -- ^ Key in which the rendered date should be placed @@ -285,7 +351,7 @@ dateField = dateFieldWith defaultTimeLocale -------------------------------------------------------------------------------- -- | This is an extended version of 'dateField' that allows you to -- specify a time locale that is used for outputting the date. For more --- details, see 'dateField'. +-- details, see 'dateField' and 'formatTime'. dateFieldWith :: TimeLocale -- ^ Output time locale -> String -- ^ Destination key -> String -- ^ Format to use on the date @@ -340,6 +406,7 @@ getItemModificationTime identifier = do -------------------------------------------------------------------------------- +-- | Creates a field with the last modification date of the underlying item. modificationTimeField :: String -- ^ Key -> String -- ^ Format -> Context a -- ^ Resulting context @@ -347,6 +414,8 @@ modificationTimeField = modificationTimeFieldWith defaultTimeLocale -------------------------------------------------------------------------------- +-- | Creates a field with the last modification date of the underlying item +-- in a custom localisation format (see 'formatTime'). modificationTimeFieldWith :: TimeLocale -- ^ Time output locale -> String -- ^ Key -> String -- ^ Format @@ -385,10 +454,11 @@ teaserFieldWithSeparator separator key snapshot = field key $ \item -> do -------------------------------------------------------------------------------- +-- | Constantly reports any field as missing. Mostly for internal usage, +-- it is the last choice in every context used in a template application. missingField :: Context a -missingField = Context $ \k _ i -> fail $ - "Missing field $" ++ k ++ "$ in context for item " ++ - show (itemIdentifier i) +missingField = Context $ \k _ _ -> noResult $ + "Missing field '" ++ k ++ "' in context" parseTimeM :: Bool -> TimeLocale -> String -> String -> Maybe UTCTime #if MIN_VERSION_time(1,5,0) diff --git a/lib/Hakyll/Web/Template/Internal.hs b/lib/Hakyll/Web/Template/Internal.hs index 154cee6..c369560 100644 --- a/lib/Hakyll/Web/Template/Internal.hs +++ b/lib/Hakyll/Web/Template/Internal.hs @@ -1,15 +1,18 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ScopedTypeVariables #-} + module Hakyll.Web.Template.Internal ( Template (..) , template , templateBodyCompiler , templateCompiler , applyTemplate - , applyTemplate' , loadAndApplyTemplate , applyAsTemplate , readTemplate + , compileTemplateItem , unsafeReadTemplateFile , module Hakyll.Web.Template.Internal.Element @@ -18,16 +21,18 @@ module Hakyll.Web.Template.Internal -------------------------------------------------------------------------------- -import Control.Monad.Except (MonadError (..)) +import Control.Monad.Except (catchError) import Data.Binary (Binary) import Data.List (intercalate) +import qualified Data.List.NonEmpty as NonEmpty import Data.Typeable (Typeable) import GHC.Exts (IsString (..)) -import Prelude hiding (id) +import GHC.Generics (Generic) -------------------------------------------------------------------------------- import Hakyll.Core.Compiler +import Hakyll.Core.Compiler.Internal import Hakyll.Core.Identifier import Hakyll.Core.Item import Hakyll.Core.Writable @@ -38,9 +43,10 @@ import Hakyll.Web.Template.Internal.Trim -------------------------------------------------------------------------------- -- | Datatype used for template substitutions. -newtype Template = Template - { unTemplate :: [TemplateElement] - } deriving (Show, Eq, Binary, Typeable) +data Template = Template + { tplElements :: [TemplateElement] + , tplOrigin :: FilePath -- Only for error messages. + } deriving (Show, Eq, Generic, Binary, Typeable) -------------------------------------------------------------------------------- @@ -56,39 +62,68 @@ instance IsString Template where -------------------------------------------------------------------------------- -- | Wrap the constructor to ensure trim is called. -template :: [TemplateElement] -> Template -template = Template . trim +template :: FilePath -> [TemplateElement] -> Template +template p = flip Template p . trim -------------------------------------------------------------------------------- +-- | Parse a string into a template. +-- You should prefer 'compileTemplateItem' over this. readTemplate :: String -> Template -readTemplate = Template . trim . readTemplateElems +readTemplate = either error (template origin) . parseTemplateElemsFile origin + where + origin = "{literal}" +{-# DEPRECATED readTemplate "Use templateCompiler instead" #-} + +-------------------------------------------------------------------------------- +-- | Parse an item body into a template. +-- Provides useful error messages in the 'Compiler' monad. +compileTemplateItem :: Item String -> Compiler Template +compileTemplateItem item = let file = itemIdentifier item + in compileTemplateFile file (itemBody item) + +-------------------------------------------------------------------------------- +compileTemplateFile :: Identifier -> String -> Compiler Template +compileTemplateFile file = either fail (return . template origin) + . parseTemplateElemsFile origin + where + origin = show file -------------------------------------------------------------------------------- -- | Read a template, without metadata header templateBodyCompiler :: Compiler (Item Template) templateBodyCompiler = cached "Hakyll.Web.Template.templateBodyCompiler" $ do item <- getResourceBody - file <- getResourceFilePath - return $ fmap (template . readTemplateElemsFile file) item + file <- getUnderlying + withItemBody (compileTemplateFile file) item -------------------------------------------------------------------------------- -- | Read complete file contents as a template templateCompiler :: Compiler (Item Template) templateCompiler = cached "Hakyll.Web.Template.templateCompiler" $ do item <- getResourceString - file <- getResourceFilePath - return $ fmap (template . readTemplateElemsFile file) item + file <- getUnderlying + withItemBody (compileTemplateFile file) item -------------------------------------------------------------------------------- +-- | Interpolate template expressions from context values in a page applyTemplate :: Template -- ^ Template -> Context a -- ^ Context -> Item a -- ^ Page -> Compiler (Item String) -- ^ Resulting item applyTemplate tpl context item = do - body <- applyTemplate' (unTemplate tpl) context item + body <- applyTemplate' (tplElements tpl) context item `catchError` handler return $ itemSetBody body item + where + tplName = tplOrigin tpl + itemName = show $ itemIdentifier item + handler es = fail $ "Hakyll.Web.Template.applyTemplate: Failed to " ++ + (if tplName == itemName + then "interpolate template in item " ++ itemName + else "apply template " ++ tplName ++ " to item " ++ itemName) ++ + ":\n" ++ intercalate ",\n" es + -------------------------------------------------------------------------------- @@ -105,9 +140,6 @@ applyTemplate' tes context x = go tes go = fmap concat . mapM applyElem - trimError = error $ "Hakyll.Web.Template.applyTemplate: template not " ++ - "fully trimmed." - --------------------------------------------------------------------------- applyElem :: TemplateElement -> Compiler String @@ -118,29 +150,43 @@ applyTemplate' tes context x = go tes applyElem (Chunk c) = return c - applyElem (Expr e) = applyExpr e >>= getString e + applyElem (Expr e) = withErrorMessage evalMsg (applyStringExpr typeMsg e) + where + evalMsg = "In expr '$" ++ show e ++ "$'" + typeMsg = "expr '$" ++ show e ++ "$'" applyElem Escaped = return "$" - applyElem (If e t mf) = (applyExpr e >> go t) `catchError` handler + applyElem (If e t mf) = compilerTry (applyExpr e) >>= handle where - handler _ = case mf of - Nothing -> return "" - Just f -> go f - - applyElem (For e b s) = applyExpr e >>= \cf -> case cf of - StringField _ -> fail $ - "Hakyll.Web.Template.applyTemplateWith: expected ListField but " ++ - "got StringField for expr " ++ show e - ListField c xs -> do + f = maybe (return "") go mf + handle (Right _) = go t + handle (Left (CompilationNoResult _)) = f + handle (Left (CompilationFailure es)) = debug (NonEmpty.toList es) >> f + debug = compilerDebugEntries ("Hakyll.Web.Template.applyTemplate: " ++ + "[ERROR] in 'if' condition on expr '" ++ show e ++ "':") + + applyElem (For e b s) = withErrorMessage headMsg (applyExpr e) >>= \cf -> case cf of + EmptyField -> expected "list" "boolean" typeMsg + StringField _ -> expected "list" "string" typeMsg + ListField c xs -> withErrorMessage bodyMsg $ do sep <- maybe (return "") go s bs <- mapM (applyTemplate' b c) xs return $ intercalate sep bs - - applyElem (Partial e) = do - p <- applyExpr e >>= getString e - Template tpl' <- loadBody (fromFilePath p) - applyTemplate' tpl' context x + where + headMsg = "In expr '$for(" ++ show e ++ ")$'" + typeMsg = "loop expr '" ++ show e ++ "'" + bodyMsg = "In loop context of '$for(" ++ show e ++ ")$'" + + applyElem (Partial e) = withErrorMessage headMsg $ + applyStringExpr typeMsg e >>= \p -> + withErrorMessage inclMsg $ do + tpl' <- loadBody (fromFilePath p) + itemBody <$> applyTemplate tpl' context x + where + headMsg = "In expr '$partial(" ++ show e ++ ")$'" + typeMsg = "partial expr '" ++ show e ++ "'" + inclMsg = "In inclusion of '$partial(" ++ show e ++ ")$'" --------------------------------------------------------------------------- @@ -149,17 +195,29 @@ applyTemplate' tes context x = go tes applyExpr (Ident (TemplateKey k)) = context' k [] x applyExpr (Call (TemplateKey k) args) = do - args' <- mapM (\e -> applyExpr e >>= getString e) args + args' <- mapM (\e -> applyStringExpr (typeMsg e) e) args context' k args' x + where + typeMsg e = "argument '" ++ show e ++ "'" applyExpr (StringLiteral s) = return (StringField s) ---------------------------------------------------------------------------- - getString _ (StringField s) = return s - getString e (ListField _ _) = fail $ - "Hakyll.Web.Template.applyTemplateWith: expected StringField but " ++ - "got ListField for expr " ++ show e + applyStringExpr :: String -> TemplateExpr -> Compiler String + applyStringExpr msg expr = + applyExpr expr >>= getString + where + getString EmptyField = expected "string" "boolean" msg + getString (StringField s) = return s + getString (ListField _ _) = expected "string" "list" msg + + expected typ act expr = fail $ unwords ["Hakyll.Web.Template.applyTemplate:", + "expected", typ, "but got", act, "for", expr] + + -- expected to never happen with all templates constructed by 'template' + trimError = fail $ + "Hakyll.Web.Template.applyTemplate: template not fully trimmed." -------------------------------------------------------------------------------- @@ -189,14 +247,14 @@ loadAndApplyTemplate identifier context item = do applyAsTemplate :: Context String -- ^ Context -> Item String -- ^ Item and template -> Compiler (Item String) -- ^ Resulting item -applyAsTemplate context item = - let tpl = template $ readTemplateElemsFile file (itemBody item) - file = toFilePath $ itemIdentifier item - in applyTemplate tpl context item +applyAsTemplate context item = do + tpl <- compileTemplateItem item + applyTemplate tpl context item -------------------------------------------------------------------------------- unsafeReadTemplateFile :: FilePath -> Compiler Template unsafeReadTemplateFile file = do tpl <- unsafeCompiler $ readFile file - pure $ template $ readTemplateElemsFile file tpl + compileTemplateFile (fromFilePath file) tpl +{-# DEPRECATED unsafeReadTemplateFile "Use templateCompiler" #-} diff --git a/lib/Hakyll/Web/Template/Internal/Element.hs b/lib/Hakyll/Web/Template/Internal/Element.hs index f564355..fc77501 100644 --- a/lib/Hakyll/Web/Template/Internal/Element.hs +++ b/lib/Hakyll/Web/Template/Internal/Element.hs @@ -7,14 +7,14 @@ module Hakyll.Web.Template.Internal.Element , TemplateExpr (..) , TemplateElement (..) , templateElems - , readTemplateElems - , readTemplateElemsFile + , parseTemplateElemsFile ) where -------------------------------------------------------------------------------- -import Control.Applicative ((<|>)) +import Control.Applicative ((<|>), (<*)) import Control.Monad (void) +import Control.Arrow (left) import Data.Binary (Binary, get, getWord8, put, putWord8) import Data.List (intercalate) import Data.Maybe (isJust) @@ -107,17 +107,10 @@ instance Binary TemplateExpr where 2 -> StringLiteral <$> get _ -> error "Hakyll.Web.Template.Internal: Error reading cached template" - --------------------------------------------------------------------------------- -readTemplateElems :: String -> [TemplateElement] -readTemplateElems = readTemplateElemsFile "{literal}" - - -------------------------------------------------------------------------------- -readTemplateElemsFile :: FilePath -> String -> [TemplateElement] -readTemplateElemsFile file input = case P.parse templateElems file input of - Left err -> error $ "Cannot parse template: " ++ show err - Right t -> t +parseTemplateElemsFile :: FilePath -> String -> Either String [TemplateElement] +parseTemplateElemsFile file = left (\e -> "Cannot parse template " ++ show e) + . P.parse (templateElems <* P.eof) file -------------------------------------------------------------------------------- @@ -167,7 +160,7 @@ trimOpen = do -------------------------------------------------------------------------------- trimClose :: P.Parser Bool trimClose = do - trimIfR <- P.optionMaybe $ P.try (P.char '-') + trimIfR <- P.optionMaybe $ (P.char '-') void $ P.char '$' pure $ isJust trimIfR |