Move src/ to lib/, put Init.hs in src/

5 files changed, 1066 insertions, 0 deletions

diff --git a/lib/Hakyll/Web/Template/Context.hs b/lib/Hakyll/Web/Template/Context.hs
new file mode 100644
index 0000000..b6c7994
--- /dev/null
+++ b/lib/Hakyll/Web/Template/Context.hs
@@ -0,0 +1,379 @@
+--------------------------------------------------------------------------------
+{-# LANGUAGE CPP                       #-}
+{-# LANGUAGE ExistentialQuantification #-}
+module Hakyll.Web.Template.Context
+    ( ContextField (..)
+    , Context (..)
+    , field
+    , boolField
+    , constField
+    , listField
+    , listFieldWith
+    , functionField
+    , mapContext
+
+    , defaultContext
+    , bodyField
+    , metadataField
+    , urlField
+    , pathField
+    , titleField
+    , snippetField
+    , dateField
+    , dateFieldWith
+    , getItemUTC
+    , getItemModificationTime
+    , modificationTimeField
+    , modificationTimeFieldWith
+    , teaserField
+    , teaserFieldWithSeparator
+    , missingField
+    ) where
+
+
+--------------------------------------------------------------------------------
+import           Control.Applicative           (Alternative (..))
+import           Control.Monad                 (msum)
+import           Data.List                     (intercalate)
+import           Data.Time.Clock               (UTCTime (..))
+import           Data.Time.Format              (formatTime)
+import qualified Data.Time.Format              as TF
+import           Data.Time.Locale.Compat       (TimeLocale, defaultTimeLocale)
+import           Hakyll.Core.Compiler
+import           Hakyll.Core.Compiler.Internal
+import           Hakyll.Core.Identifier
+import           Hakyll.Core.Item
+import           Hakyll.Core.Metadata
+import           Hakyll.Core.Provider
+import           Hakyll.Core.Util.String       (needlePrefix, splitAll)
+import           Hakyll.Web.Html
+import           System.FilePath               (splitDirectories, takeBaseName)
+
+
+--------------------------------------------------------------------------------
+-- | Mostly for internal usage
+data ContextField
+    = StringField String
+    | forall a. ListField (Context a) [Item a]
+
+
+--------------------------------------------------------------------------------
+-- | 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 -> [String] -> Item a -> Compiler ContextField
+    }
+
+
+--------------------------------------------------------------------------------
+instance Monoid (Context a) where
+    mempty                          = missingField
+    mappend (Context f) (Context g) = Context $ \k a i -> f k a i <|> g k a i
+
+
+--------------------------------------------------------------------------------
+field' :: String -> (Item a -> Compiler ContextField) -> Context a
+field' key value = Context $ \k _ i -> if k == key then value i else empty
+
+
+--------------------------------------------------------------------------------
+-- | 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' to use with the @$if()$@ template macro.
+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)
+
+
+--------------------------------------------------------------------------------
+-- | Creates a 'field' that does not depend on the 'Item'
+constField :: String -> String -> Context a
+constField key = field key . const . return
+
+
+--------------------------------------------------------------------------------
+listField :: String -> Context a -> Compiler [Item a] -> Context b
+listField key c xs = listFieldWith key c (const xs)
+
+
+--------------------------------------------------------------------------------
+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
+functionField name value = Context $ \k args i ->
+    if k == name
+        then StringField <$> value args i
+        else empty
+
+
+--------------------------------------------------------------------------------
+mapContext :: (String -> String) -> Context a -> Context a
+mapContext f (Context c) = Context $ \k a i -> do
+    fld <- c k a i
+    case fld of
+        StringField str -> return $ StringField (f str)
+        ListField _ _   -> fail $
+            "Hakyll.Web.Template.Context.mapContext: " ++
+            "can't map over a ListField!"
+
+--------------------------------------------------------------------------------
+-- | A context that allows snippet inclusion. In processed file, use as:
+--
+-- > ...
+-- > $snippet("path/to/snippet/")$
+-- > ...
+--
+-- The contents of the included file will not be interpolated.
+--
+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)
+
+--------------------------------------------------------------------------------
+-- | 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`
+    metadataField            `mappend`
+    urlField      "url"      `mappend`
+    pathField     "path"     `mappend`
+    titleField    "title"    `mappend`
+    missingField
+
+
+--------------------------------------------------------------------------------
+teaserSeparator :: String
+teaserSeparator = "<!--more-->"
+
+
+--------------------------------------------------------------------------------
+-- | Constructs a 'field' that contains the body of the item.
+bodyField :: String -> Context String
+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
+
+
+--------------------------------------------------------------------------------
+-- | Absolute url to the resulting item
+urlField :: String -> Context a
+urlField key = field key $
+    fmap (maybe empty toUrl) . getRoute . itemIdentifier
+
+
+--------------------------------------------------------------------------------
+-- | Filepath of the underlying file of the item
+pathField :: String -> Context a
+pathField key = field key $ return . toFilePath . itemIdentifier
+
+
+--------------------------------------------------------------------------------
+-- | This title 'field' takes the basename of the underlying file by default
+titleField :: String -> Context a
+titleField = mapContext takeBaseName . pathField
+
+
+--------------------------------------------------------------------------------
+-- | When the metadata has a field called @published@ in one of the
+-- following formats then this function can render the date.
+--
+--   * @Mon, 06 Sep 2010 00:01:00 +0000@
+--
+--   * @Mon, 06 Sep 2010 00:01:00 UTC@
+--
+--   * @Mon, 06 Sep 2010 00:01:00@
+--
+--   * @2010-09-06T00:01:00+0000@
+--
+--   * @2010-09-06T00:01:00Z@
+--
+--   * @2010-09-06T00:01:00@
+--
+--   * @2010-09-06 00:01:00+0000@
+--
+--   * @2010-09-06 00:01:00@
+--
+--   * @September 06, 2010 00:01 AM@
+--
+-- Following date-only formats are supported too (@00:00:00@ for time is
+-- assumed)
+--
+--   * @2010-09-06@
+--
+--   * @September 06, 2010@
+--
+-- Alternatively, when the metadata has a field called @path@ in a
+-- @folder/yyyy-mm-dd-title.extension@ format (the convention for pages)
+-- and no @published@ metadata field set, this function can render
+-- the date. This pattern matches the file name or directory names
+-- that begins with @yyyy-mm-dd@ . For example:
+-- @folder//yyyy-mm-dd-title//dist//main.extension@ .
+-- In case of multiple matches, the rightmost one is used.
+
+dateField :: String     -- ^ Key in which the rendered date should be placed
+          -> String     -- ^ Format to use on the date
+          -> Context a  -- ^ Resulting context
+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'.
+dateFieldWith :: TimeLocale  -- ^ Output time locale
+              -> String      -- ^ Destination key
+              -> String      -- ^ Format to use on the date
+              -> Context a   -- ^ Resulting context
+dateFieldWith locale key format = field key $ \i -> do
+    time <- getItemUTC locale $ itemIdentifier i
+    return $ formatTime locale format time
+
+
+--------------------------------------------------------------------------------
+-- | Parser to try to extract and parse the time from the @published@
+-- field or from the filename. See 'dateField' for more information.
+-- Exported for user convenience.
+getItemUTC :: MonadMetadata m
+           => TimeLocale        -- ^ Output time locale
+           -> Identifier        -- ^ Input page
+           -> m UTCTime         -- ^ Parsed UTCTime
+getItemUTC locale id' = do
+    metadata <- getMetadata id'
+    let tryField k fmt = lookupString k metadata >>= parseTime' fmt
+        paths          = splitDirectories $ toFilePath id'
+
+    maybe empty' return $ msum $
+        [tryField "published" fmt | fmt <- formats] ++
+        [tryField "date"      fmt | fmt <- formats] ++
+        [parseTime' "%Y-%m-%d" $ intercalate "-" $ take 3 $ splitAll "-" fnCand | fnCand <- reverse paths]
+  where
+    empty'     = fail $ "Hakyll.Web.Template.Context.getItemUTC: " ++
+        "could not parse time for " ++ show id'
+    parseTime' = parseTimeM True locale
+    formats    =
+        [ "%a, %d %b %Y %H:%M:%S %Z"
+        , "%Y-%m-%dT%H:%M:%S%Z"
+        , "%Y-%m-%d %H:%M:%S%Z"
+        , "%Y-%m-%d"
+        , "%B %e, %Y %l:%M %p"
+        , "%B %e, %Y"
+        , "%b %d, %Y"
+        ]
+
+
+--------------------------------------------------------------------------------
+-- | Get the time on which the actual file was last modified. This only works if
+-- there actually is an underlying file, of couse.
+getItemModificationTime
+    :: Identifier
+    -> Compiler UTCTime
+getItemModificationTime identifier = do
+    provider <- compilerProvider <$> compilerAsk
+    return $ resourceModificationTime provider identifier
+
+
+--------------------------------------------------------------------------------
+modificationTimeField :: String     -- ^ Key
+                      -> String     -- ^ Format
+                      -> Context  a -- ^ Resuting context
+modificationTimeField = modificationTimeFieldWith defaultTimeLocale
+
+
+--------------------------------------------------------------------------------
+modificationTimeFieldWith :: TimeLocale  -- ^ Time output locale
+                          -> String      -- ^ Key
+                          -> String      -- ^ Format
+                          -> Context a   -- ^ Resulting context
+modificationTimeFieldWith locale key fmt = field key $ \i -> do
+    mtime <- getItemModificationTime $ itemIdentifier i
+    return $ formatTime locale fmt mtime
+
+
+--------------------------------------------------------------------------------
+-- | A context with "teaser" key which contain a teaser of the item.
+-- The item is loaded from the given snapshot (which should be saved
+-- in the user code before any templates are applied).
+teaserField :: String           -- ^ Key to use
+            -> Snapshot         -- ^ Snapshot to load
+            -> Context String   -- ^ Resulting context
+teaserField = teaserFieldWithSeparator teaserSeparator
+
+
+--------------------------------------------------------------------------------
+-- | A context with "teaser" key which contain a teaser of the item, defined as
+-- the snapshot content before the teaser separator. The item is loaded from the
+-- given snapshot (which should be saved in the user code before any templates
+-- are applied).
+teaserFieldWithSeparator :: String           -- ^ Separator to use
+                         -> String           -- ^ Key to use
+                         -> Snapshot         -- ^ Snapshot to load
+                         -> Context String   -- ^ Resulting context
+teaserFieldWithSeparator separator key snapshot = field key $ \item -> do
+    body <- itemBody <$> loadSnapshot (itemIdentifier item) snapshot
+    case needlePrefix separator body of
+        Nothing -> fail $
+            "Hakyll.Web.Template.Context: no teaser defined for " ++
+            show (itemIdentifier item)
+        Just t -> return t
+
+
+--------------------------------------------------------------------------------
+missingField :: Context a
+missingField = Context $ \k _ i -> fail $
+    "Missing field $" ++ k ++ "$ in context for item " ++
+    show (itemIdentifier i)
+
+parseTimeM :: Bool -> TimeLocale -> String -> String -> Maybe UTCTime
+#if MIN_VERSION_time(1,5,0)
+parseTimeM = TF.parseTimeM
+#else
+parseTimeM _ = TF.parseTime
+#endif
diff --git a/lib/Hakyll/Web/Template/Internal.hs b/lib/Hakyll/Web/Template/Internal.hs
new file mode 100644
index 0000000..d0e4d47
--- /dev/null
+++ b/lib/Hakyll/Web/Template/Internal.hs
@@ -0,0 +1,203 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ScopedTypeVariables        #-}
+module Hakyll.Web.Template.Internal
+    ( Template (..)
+    , template
+    , templateBodyCompiler
+    , templateCompiler
+    , applyTemplate
+    , applyTemplate'
+    , loadAndApplyTemplate
+    , applyAsTemplate
+    , readTemplate
+    , unsafeReadTemplateFile
+
+    , module Hakyll.Web.Template.Internal.Element
+    , module Hakyll.Web.Template.Internal.Trim
+    ) where
+
+
+--------------------------------------------------------------------------------
+import           Control.Monad.Except                 (MonadError (..))
+import           Data.Binary                          (Binary)
+import           Data.List                            (intercalate)
+import           Data.Typeable                        (Typeable)
+import           GHC.Exts                             (IsString (..))
+import           Prelude                              hiding (id)
+
+
+--------------------------------------------------------------------------------
+import           Hakyll.Core.Compiler
+import           Hakyll.Core.Identifier
+import           Hakyll.Core.Item
+import           Hakyll.Core.Writable
+import           Hakyll.Web.Template.Context
+import           Hakyll.Web.Template.Internal.Element
+import           Hakyll.Web.Template.Internal.Trim
+
+
+--------------------------------------------------------------------------------
+-- | Datatype used for template substitutions.
+newtype Template = Template
+    { unTemplate :: [TemplateElement]
+    } deriving (Show, Eq, Binary, Typeable)
+
+
+--------------------------------------------------------------------------------
+instance Writable Template where
+    -- Writing a template is impossible
+    write _ _ = return ()
+
+
+--------------------------------------------------------------------------------
+instance IsString Template where
+    fromString = readTemplate
+
+
+--------------------------------------------------------------------------------
+-- | Wrap the constructor to ensure trim is called.
+template :: [TemplateElement] -> Template
+template = Template . trim
+
+
+--------------------------------------------------------------------------------
+readTemplate :: String -> Template
+readTemplate = Template . trim . readTemplateElems
+
+--------------------------------------------------------------------------------
+-- | 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
+
+--------------------------------------------------------------------------------
+-- | 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
+
+
+--------------------------------------------------------------------------------
+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
+    return $ itemSetBody body item
+
+
+--------------------------------------------------------------------------------
+applyTemplate'
+    :: forall a.
+       [TemplateElement] -- ^ Unwrapped Template
+    -> Context a         -- ^ Context
+    -> Item a            -- ^ Page
+    -> Compiler String   -- ^ Resulting item
+applyTemplate' tes context x = go tes
+  where
+    context' :: String -> [String] -> Item a -> Compiler ContextField
+    context' = unContext (context `mappend` missingField)
+
+    go = fmap concat . mapM applyElem
+
+    trimError = error $ "Hakyll.Web.Template.applyTemplate: template not " ++
+        "fully trimmed."
+
+    ---------------------------------------------------------------------------
+
+    applyElem :: TemplateElement -> Compiler String
+
+    applyElem TrimL = trimError
+
+    applyElem TrimR = trimError
+
+    applyElem (Chunk c) = return c
+
+    applyElem (Expr e) = applyExpr e >>= getString e
+
+    applyElem Escaped = return "$"
+
+    applyElem (If e t mf) = (applyExpr e >> go t) `catchError` handler
+      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
+            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
+
+    ---------------------------------------------------------------------------
+
+    applyExpr :: TemplateExpr -> Compiler ContextField
+
+    applyExpr (Ident (TemplateKey k)) = context' k [] x
+
+    applyExpr (Call (TemplateKey k) args) = do
+        args' <- mapM (\e -> applyExpr e >>= getString e) args
+        context' k args' x
+
+    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
+
+
+--------------------------------------------------------------------------------
+-- | The following pattern is so common:
+--
+-- > tpl <- loadBody "templates/foo.html"
+-- > someCompiler
+-- >     >>= applyTemplate tpl context
+--
+-- That we have a single function which does this:
+--
+-- > someCompiler
+-- >     >>= loadAndApplyTemplate "templates/foo.html" context
+loadAndApplyTemplate :: Identifier              -- ^ Template identifier
+                     -> Context a               -- ^ Context
+                     -> Item a                  -- ^ Page
+                     -> Compiler (Item String)  -- ^ Resulting item
+loadAndApplyTemplate identifier context item = do
+    tpl <- loadBody identifier
+    applyTemplate tpl context item
+
+
+--------------------------------------------------------------------------------
+-- | It is also possible that you want to substitute @$key$@s within the body of
+-- an item. This function does that by interpreting the item body as a template,
+-- and then applying it to itself.
+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
+
+
+--------------------------------------------------------------------------------
+unsafeReadTemplateFile :: FilePath -> Compiler Template
+unsafeReadTemplateFile file = do
+    tpl <- unsafeCompiler $ readFile file
+    pure $ template $ readTemplateElemsFile file tpl
+
diff --git a/lib/Hakyll/Web/Template/Internal/Element.hs b/lib/Hakyll/Web/Template/Internal/Element.hs
new file mode 100644
index 0000000..f564355
--- /dev/null
+++ b/lib/Hakyll/Web/Template/Internal/Element.hs
@@ -0,0 +1,298 @@
+--------------------------------------------------------------------------------
+-- | Module containing the elements used in a template.  A template is generally
+-- just a list of these elements.
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module Hakyll.Web.Template.Internal.Element
+    ( TemplateKey (..)
+    , TemplateExpr (..)
+    , TemplateElement (..)
+    , templateElems
+    , readTemplateElems
+    , readTemplateElemsFile
+    ) where
+
+
+--------------------------------------------------------------------------------
+import           Control.Applicative     ((<|>))
+import           Control.Monad           (void)
+import           Data.Binary             (Binary, get, getWord8, put, putWord8)
+import           Data.List               (intercalate)
+import           Data.Maybe              (isJust)
+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
+
+
+--------------------------------------------------------------------------------
+newtype TemplateKey = TemplateKey String
+    deriving (Binary, Show, Eq, Typeable)
+
+
+--------------------------------------------------------------------------------
+instance IsString TemplateKey where
+    fromString = TemplateKey
+
+
+--------------------------------------------------------------------------------
+-- | Elements of a template.
+data TemplateElement
+    = Chunk String
+    | Expr TemplateExpr
+    | Escaped
+      -- expr, then, else
+    | If TemplateExpr [TemplateElement] (Maybe [TemplateElement])
+      -- expr, body, separator
+    | For TemplateExpr [TemplateElement] (Maybe [TemplateElement])
+      -- filename
+    | Partial TemplateExpr
+    | TrimL
+    | TrimR
+    deriving (Show, Eq, Typeable)
+
+
+--------------------------------------------------------------------------------
+instance Binary TemplateElement where
+    put (Chunk string) = putWord8 0 >> put string
+    put (Expr e)       = putWord8 1 >> put e
+    put  Escaped       = putWord8 2
+    put (If e t f)     = putWord8 3 >> put e >> put t >> put f
+    put (For e b s)    = putWord8 4 >> put e >> put b >> put s
+    put (Partial e)    = putWord8 5 >> put e
+    put  TrimL         = putWord8 6
+    put  TrimR         = putWord8 7
+
+    get = getWord8 >>= \tag -> case tag of
+        0 -> Chunk <$> get
+        1 -> Expr <$> get
+        2 -> pure Escaped
+        3 -> If <$> get <*> get <*> get
+        4 -> For <$> get <*> get <*> get
+        5 -> Partial <$> get
+        6 -> pure TrimL
+        7 -> pure TrimR
+        _ -> error "Hakyll.Web.Template.Internal: Error reading cached template"
+
+
+--------------------------------------------------------------------------------
+-- | Expression in a template
+data TemplateExpr
+    = Ident TemplateKey
+    | Call TemplateKey [TemplateExpr]
+    | StringLiteral String
+    deriving (Eq, Typeable)
+
+
+--------------------------------------------------------------------------------
+instance Show TemplateExpr where
+    show (Ident (TemplateKey k))   = k
+    show (Call (TemplateKey k) as) =
+        k ++ "(" ++ intercalate ", " (map show as) ++ ")"
+    show (StringLiteral s)         = show s
+
+
+--------------------------------------------------------------------------------
+instance Binary TemplateExpr where
+    put (Ident k)         = putWord8 0 >> put k
+    put (Call k as)       = putWord8 1 >> put k >> put as
+    put (StringLiteral s) = putWord8 2 >> put s
+
+    get = getWord8 >>= \tag -> case tag of
+        0 -> Ident         <$> get
+        1 -> Call          <$> get <*> get
+        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
+
+
+--------------------------------------------------------------------------------
+templateElems :: P.Parser [TemplateElement]
+templateElems = mconcat <$> P.many (P.choice [ lift chunk
+                                             , lift escaped
+                                             , conditional
+                                             , for
+                                             , partial
+                                             , expr
+                                             ])
+    where lift = fmap (:[])
+
+
+--------------------------------------------------------------------------------
+chunk :: P.Parser TemplateElement
+chunk = Chunk <$> P.many1 (P.noneOf "$")
+
+
+--------------------------------------------------------------------------------
+expr :: P.Parser [TemplateElement]
+expr = P.try $ do
+    trimLExpr <- trimOpen
+    e <- expr'
+    trimRExpr <- trimClose
+    return $ [TrimL | trimLExpr] ++ [Expr e] ++ [TrimR | trimRExpr]
+
+
+--------------------------------------------------------------------------------
+expr' :: P.Parser TemplateExpr
+expr' = stringLiteral <|> call <|> ident
+
+
+--------------------------------------------------------------------------------
+escaped :: P.Parser TemplateElement
+escaped = Escaped <$ P.try (P.string "$$")
+
+
+--------------------------------------------------------------------------------
+trimOpen :: P.Parser Bool
+trimOpen = do
+    void $ P.char '$'
+    trimLIf <- P.optionMaybe $ P.try (P.char '-')
+    pure $ isJust trimLIf
+
+
+--------------------------------------------------------------------------------
+trimClose :: P.Parser Bool
+trimClose = do
+    trimIfR <- P.optionMaybe $ P.try (P.char '-')
+    void $ P.char '$'
+    pure $ isJust trimIfR
+
+
+--------------------------------------------------------------------------------
+conditional :: P.Parser [TemplateElement]
+conditional = P.try $ do
+    -- if
+    trimLIf <- trimOpen
+    void $ P.string "if("
+    e <- expr'
+    void $ P.char ')'
+    trimRIf <- trimClose
+    -- then
+    thenBranch <- templateElems
+    -- else
+    elseParse <- opt "else"
+    -- endif
+    trimLEnd <- trimOpen
+    void $ P.string "endif"
+    trimREnd <- trimClose
+
+    -- As else is optional we need to sort out where any Trim_s need to go.
+    let (thenBody, elseBody) = maybe (thenNoElse, Nothing) thenElse elseParse
+            where thenNoElse =
+                      [TrimR | trimRIf] ++ thenBranch ++ [TrimL | trimLEnd]
+
+                  thenElse (trimLElse, elseBranch, trimRElse) = (thenB, elseB)
+                      where thenB = [TrimR | trimRIf]
+                                 ++ thenBranch
+                                 ++ [TrimL | trimLElse]
+
+                            elseB = Just $ [TrimR | trimRElse]
+                                        ++ elseBranch
+                                        ++ [TrimL | trimLEnd]
+
+    pure $ [TrimL | trimLIf] ++ [If e thenBody elseBody] ++ [TrimR | trimREnd]
+
+
+--------------------------------------------------------------------------------
+for :: P.Parser [TemplateElement]
+for = P.try $ do
+    -- for
+    trimLFor <- trimOpen
+    void $ P.string "for("
+    e <- expr'
+    void $ P.char ')'
+    trimRFor <- trimClose
+    -- body
+    bodyBranch <- templateElems
+    -- sep
+    sepParse <- opt "sep"
+    -- endfor
+    trimLEnd <- trimOpen
+    void $ P.string "endfor"
+    trimREnd <- trimClose
+
+    -- As sep is optional we need to sort out where any Trim_s need to go.
+    let (forBody, sepBody) = maybe (forNoSep, Nothing) forSep sepParse
+            where forNoSep =
+                      [TrimR | trimRFor] ++ bodyBranch ++ [TrimL | trimLEnd]
+
+                  forSep (trimLSep, sepBranch, trimRSep) = (forB, sepB)
+                      where forB = [TrimR | trimRFor]
+                                ++ bodyBranch
+                                ++ [TrimL | trimLSep]
+
+                            sepB = Just $ [TrimR | trimRSep]
+                                       ++ sepBranch
+                                       ++ [TrimL | trimLEnd]
+
+    pure $ [TrimL | trimLFor] ++ [For e forBody sepBody] ++ [TrimR | trimREnd]
+
+
+--------------------------------------------------------------------------------
+partial :: P.Parser [TemplateElement]
+partial = P.try $ do
+    trimLPart <- trimOpen
+    void $ P.string "partial("
+    e <- expr'
+    void $ P.char ')'
+    trimRPart <- trimClose
+
+    pure $ [TrimL | trimLPart] ++ [Partial e] ++ [TrimR | trimRPart]
+
+
+--------------------------------------------------------------------------------
+ident :: P.Parser TemplateExpr
+ident = P.try $ Ident <$> key
+
+
+--------------------------------------------------------------------------------
+call :: P.Parser TemplateExpr
+call = P.try $ do
+    f <- key
+    void $ P.char '('
+    P.spaces
+    as <- P.sepBy expr' (P.spaces >> P.char ',' >> P.spaces)
+    P.spaces
+    void $ P.char ')'
+    return $ Call f as
+
+
+--------------------------------------------------------------------------------
+stringLiteral :: P.Parser TemplateExpr
+stringLiteral = do
+    void $ P.char '\"'
+    str <- P.many $ do
+        x <- P.noneOf "\""
+        if x == '\\' then P.anyChar else return x
+    void $ P.char '\"'
+    return $ StringLiteral str
+
+
+--------------------------------------------------------------------------------
+key :: P.Parser TemplateKey
+key = TemplateKey <$> metadataKey
+
+
+--------------------------------------------------------------------------------
+opt :: String -> P.Parser (Maybe (Bool, [TemplateElement], Bool))
+opt clause = P.optionMaybe $ P.try $ do
+    trimL <- trimOpen
+    void $ P.string clause
+    trimR <- trimClose
+    branch <- templateElems
+    pure (trimL, branch, trimR)
+
diff --git a/lib/Hakyll/Web/Template/Internal/Trim.hs b/lib/Hakyll/Web/Template/Internal/Trim.hs
new file mode 100644
index 0000000..e416ff2
--- /dev/null
+++ b/lib/Hakyll/Web/Template/Internal/Trim.hs
@@ -0,0 +1,95 @@
+--------------------------------------------------------------------------------
+-- | Module for trimming whitespace from tempaltes.
+module Hakyll.Web.Template.Internal.Trim
+    ( trim
+    ) where
+
+
+--------------------------------------------------------------------------------
+import           Data.Char                            (isSpace)
+import           Data.List                            (dropWhileEnd)
+
+
+--------------------------------------------------------------------------------
+import           Hakyll.Web.Template.Internal.Element
+
+
+--------------------------------------------------------------------------------
+trim :: [TemplateElement] -> [TemplateElement]
+trim = cleanse . canonicalize
+
+
+--------------------------------------------------------------------------------
+-- | Apply the Trim nodes to the Chunks.
+cleanse :: [TemplateElement] -> [TemplateElement]
+cleanse = recurse cleanse . process
+    where process [] = []
+          process (TrimR:Chunk str:ts) = let str' = dropWhile isSpace str
+                                         in if null str'
+                                                then process ts
+                                                -- Might need to TrimL.
+                                                else process $ Chunk str':ts
+
+          process (Chunk str:TrimL:ts) = let str' = dropWhileEnd isSpace str
+                                         in if null str'
+                                                then process ts
+                                                else Chunk str':process ts
+
+          process (t:ts) = t:process ts
+
+--------------------------------------------------------------------------------
+-- | Enforce the invariant that:
+--
+--     * Every 'TrimL' has a 'Chunk' to its left.
+--     * Every 'TrimR' has a 'Chunk' to its right.
+--
+canonicalize :: [TemplateElement] -> [TemplateElement]
+canonicalize = go
+    where go t = let t' = redundant . swap $ dedupe t
+                 in if t == t' then t else go t'
+
+
+--------------------------------------------------------------------------------
+-- | Remove the 'TrimR' and 'TrimL's that are no-ops.
+redundant :: [TemplateElement] -> [TemplateElement]
+redundant = recurse redundant . process
+    where -- Remove the leading 'TrimL's.
+          process (TrimL:ts) = process ts
+          -- Remove trailing 'TrimR's.
+          process ts = foldr trailing [] ts
+              where trailing TrimR [] = []
+                    trailing x xs     = x:xs
+
+
+--------------------------------------------------------------------------------
+-- >>> swap $ [TrimR, TrimL]
+-- [TrimL, TrimR]
+swap :: [TemplateElement] -> [TemplateElement]
+swap = recurse swap . process
+    where process []               = []
+          process (TrimR:TrimL:ts) = TrimL:process (TrimR:ts)
+          process (t:ts)           = t:process ts
+
+
+--------------------------------------------------------------------------------
+-- | Remove 'TrimR' and 'TrimL' duplication.
+dedupe :: [TemplateElement] -> [TemplateElement]
+dedupe = recurse dedupe . process
+    where process []               = []
+          process (TrimR:TrimR:ts) = process (TrimR:ts)
+          process (TrimL:TrimL:ts) = process (TrimL:ts)
+          process (t:ts)           = t:process ts
+
+
+--------------------------------------------------------------------------------
+-- | @'recurse' f t@ applies f to every '[TemplateElement]' in t.
+recurse :: ([TemplateElement] -> [TemplateElement])
+        -> [TemplateElement]
+        -> [TemplateElement]
+recurse _ []     = []
+recurse f (x:xs) = process x:recurse f xs
+    where process y = case y of
+                          If e tb eb -> If e (f tb) (f <$> eb)
+                          For e t s  -> For e (f t) (f <$> s)
+                          _          -> y
+
diff --git a/lib/Hakyll/Web/Template/List.hs b/lib/Hakyll/Web/Template/List.hs
new file mode 100644
index 0000000..4d769fc
--- /dev/null
+++ b/lib/Hakyll/Web/Template/List.hs
@@ -0,0 +1,91 @@
+--------------------------------------------------------------------------------
+-- | Provides an easy way to combine several items in a list. The applications
+-- are obvious:
+--
+-- * A post list on a blog
+--
+-- * An image list in a gallery
+--
+-- * A sitemap
+{-# LANGUAGE TupleSections #-}
+module Hakyll.Web.Template.List
+    ( applyTemplateList
+    , applyJoinTemplateList
+    , chronological
+    , recentFirst
+    , sortChronological
+    , sortRecentFirst
+    ) where
+
+
+--------------------------------------------------------------------------------
+import           Control.Monad               (liftM)
+import           Data.List                   (intersperse, sortBy)
+import           Data.Ord                    (comparing)
+import           Data.Time.Locale.Compat     (defaultTimeLocale)
+
+
+--------------------------------------------------------------------------------
+import           Hakyll.Core.Compiler
+import           Hakyll.Core.Identifier
+import           Hakyll.Core.Item
+import           Hakyll.Core.Metadata
+import           Hakyll.Web.Template
+import           Hakyll.Web.Template.Context
+
+
+--------------------------------------------------------------------------------
+-- | Generate a string of a listing of pages, after applying a template to each
+-- page.
+applyTemplateList :: Template
+                  -> Context a
+                  -> [Item a]
+                  -> Compiler String
+applyTemplateList = applyJoinTemplateList ""
+
+
+--------------------------------------------------------------------------------
+-- | Join a listing of pages with a string in between, after applying a template
+-- to each page.
+applyJoinTemplateList :: String
+                      -> Template
+                      -> Context a
+                      -> [Item a]
+                      -> Compiler String
+applyJoinTemplateList delimiter tpl context items = do
+    items' <- mapM (applyTemplate tpl context) items
+    return $ concat $ intersperse delimiter $ map itemBody items'
+
+
+--------------------------------------------------------------------------------
+-- | Sort pages chronologically. Uses the same method as 'dateField' for
+-- extracting the date.
+chronological :: MonadMetadata m => [Item a] -> m [Item a]
+chronological =
+    sortByM $ getItemUTC defaultTimeLocale . itemIdentifier
+  where
+    sortByM :: (Monad m, Ord k) => (a -> m k) -> [a] -> m [a]
+    sortByM f xs = liftM (map fst . sortBy (comparing snd)) $
+                   mapM (\x -> liftM (x,) (f x)) xs
+
+
+--------------------------------------------------------------------------------
+-- | The reverse of 'chronological'
+recentFirst :: MonadMetadata m => [Item a] -> m [Item a]
+recentFirst = liftM reverse . chronological
+
+
+--------------------------------------------------------------------------------
+-- | Version of 'chronological' which doesn't need the actual items.
+sortChronological
+    :: MonadMetadata m => [Identifier] -> m [Identifier]
+sortChronological ids =
+    liftM (map itemIdentifier) $ chronological [Item i () | i <- ids]
+
+
+--------------------------------------------------------------------------------
+-- | Version of 'recentFirst' which doesn't need the actual items.
+sortRecentFirst
+    :: MonadMetadata m => [Identifier] -> m [Identifier]
+sortRecentFirst ids =
+    liftM (map itemIdentifier) $ recentFirst [Item i () | i <- ids]