From 2b87d130694a815bec6e2d3c862b356e93e9580e Mon Sep 17 00:00:00 2001
From: Bergi <a.d.bergi@web.de>
Date: Thu, 4 Aug 2016 16:08:28 +0200
Subject: [PATCH 01/19] Better error messages for context fields

Closes #461
---
 src/Hakyll/Core/Compiler/Internal.hs |  4 ++--
 src/Hakyll/Web/Template/Context.hs   | 23 +++++++++++++++--------
 2 files changed, 17 insertions(+), 10 deletions(-)

diff --git a/src/Hakyll/Core/Compiler/Internal.hs b/src/Hakyll/Core/Compiler/Internal.hs
index 7b1df8327..85d3f468b 100644
--- a/src/Hakyll/Core/Compiler/Internal.hs
+++ b/src/Hakyll/Core/Compiler/Internal.hs
@@ -31,7 +31,7 @@ module Hakyll.Core.Compiler.Internal
 import           Control.Applicative            (Alternative (..))
 import           Control.Exception              (SomeException, handle)
 import           Control.Monad                  (forM_)
-import           Control.Monad.Except            (MonadError (..))
+import           Control.Monad.Except           (MonadError (..))
 import           Data.Set                       (Set)
 import qualified Data.Set                       as S
 
@@ -182,7 +182,7 @@ instance Alternative Compiler where
         logger <- compilerLogger <$> compilerAsk
         forM_ es $ \e -> compilerUnsafeIO $ Logger.debug logger $
             "Hakyll.Core.Compiler.Internal: Alternative failed: " ++ e
-        y
+        compilerCatch y $ compilerThrow . (es++)
     {-# INLINE (<|>) #-}
 
 
diff --git a/src/Hakyll/Web/Template/Context.hs b/src/Hakyll/Web/Template/Context.hs
index b6c799452..15d1bf798 100644
--- a/src/Hakyll/Web/Template/Context.hs
+++ b/src/Hakyll/Web/Template/Context.hs
@@ -85,7 +85,10 @@ 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 fail $ "Tried field " ++ key
 
 
 --------------------------------------------------------------------------------
@@ -106,7 +109,7 @@ boolField
     -> Context a
 boolField name f = field name (\i -> if f i
     then pure (error $ unwords ["no string value for bool field:",name])
-    else empty)
+    else fail $ "Field " ++ name ++ " is false")
 
 
 --------------------------------------------------------------------------------
@@ -131,7 +134,7 @@ 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
+        else fail $ "Tried function field " ++ name
 
 
 --------------------------------------------------------------------------------
@@ -157,7 +160,7 @@ snippetField :: Context String
 snippetField = functionField "snippet" f
   where
     f [contentsPath] _ = loadBody (fromFilePath contentsPath)
-    f _              i = error $
+    f _              i = fail $
         "Too many arguments to function 'snippet()' in item " ++
             show (itemIdentifier i)
 
@@ -198,15 +201,19 @@ 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' = fail $ "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
 
 
 --------------------------------------------------------------------------------

From 8ac7949eaa903244a607fdf1f567c200f347b6d4 Mon Sep 17 00:00:00 2001
From: Bergi <a.d.bergi@web.de>
Date: Thu, 4 Aug 2016 22:35:23 +0200
Subject: [PATCH 02/19] Better error messages for template applications

---
 src/Hakyll/Core/Logger.hs                   | 12 +++-
 src/Hakyll/Web/Template.hs                  |  1 +
 src/Hakyll/Web/Template/Context.hs          |  8 +--
 src/Hakyll/Web/Template/Internal.hs         | 63 ++++++++++++++-------
 src/Hakyll/Web/Template/Internal/Element.hs |  7 ---
 tests/Hakyll/Web/Template/Tests.hs          | 13 +++--
 6 files changed, 62 insertions(+), 42 deletions(-)

diff --git a/src/Hakyll/Core/Logger.hs b/src/Hakyll/Core/Logger.hs
index 6f950a6df..9b7de1748 100644
--- a/src/Hakyll/Core/Logger.hs
+++ b/src/Hakyll/Core/Logger.hs
@@ -18,6 +18,7 @@ import           Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)
 import           Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar)
 import           Control.Monad           (forever)
 import           Control.Monad.Trans     (MonadIO, liftIO)
+import           Data.List               (intercalate)
 import           Prelude                 hiding (error)
 
 
@@ -79,7 +80,7 @@ string l v m
 
 --------------------------------------------------------------------------------
 error :: MonadIO m => Logger -> String -> m ()
-error l m = string l Error $ "  [ERROR] " ++ m
+error l m = string l Error $ "  [ERROR] " ++ indent m
 
 
 --------------------------------------------------------------------------------
@@ -89,9 +90,14 @@ header l = string l Message
 
 --------------------------------------------------------------------------------
 message :: MonadIO m => Logger -> String -> m ()
-message l m = string l Message $ "  " ++ m
+message l m = string l Message $ "  " ++ indent m
 
 
 --------------------------------------------------------------------------------
 debug :: MonadIO m => Logger -> String -> m ()
-debug l m = string l Debug $ "  [DEBUG] " ++ m
+debug l m = string l Debug $ "  [DEBUG] " ++ indent m
+
+
+--------------------------------------------------------------------------------
+indent :: String -> String
+indent = intercalate "\n    " . lines
diff --git a/src/Hakyll/Web/Template.hs b/src/Hakyll/Web/Template.hs
index 2a9684bd1..6726dbd12 100644
--- a/src/Hakyll/Web/Template.hs
+++ b/src/Hakyll/Web/Template.hs
@@ -146,6 +146,7 @@ module Hakyll.Web.Template
     , loadAndApplyTemplate
     , applyAsTemplate
     , readTemplate
+    , readTemplateItem
     , unsafeReadTemplateFile
     ) where
 
diff --git a/src/Hakyll/Web/Template/Context.hs b/src/Hakyll/Web/Template/Context.hs
index 15d1bf798..053a572c2 100644
--- a/src/Hakyll/Web/Template/Context.hs
+++ b/src/Hakyll/Web/Template/Context.hs
@@ -182,8 +182,7 @@ defaultContext =
     metadataField            `mappend`
     urlField      "url"      `mappend`
     pathField     "path"     `mappend`
-    titleField    "title"    `mappend`
-    missingField
+    titleField    "title"
 
 
 --------------------------------------------------------------------------------
@@ -374,9 +373,8 @@ teaserFieldWithSeparator separator key snapshot = field key $ \item -> do
 
 --------------------------------------------------------------------------------
 missingField :: Context a
-missingField = Context $ \k _ i -> fail $
-    "Missing field $" ++ k ++ "$ in context for item " ++
-    show (itemIdentifier i)
+missingField = Context $ \k _ _ -> fail $
+    "Missing field '" ++ k ++ "' in context"
 
 parseTimeM :: Bool -> TimeLocale -> String -> String -> Maybe UTCTime
 #if MIN_VERSION_time(1,5,0)
diff --git a/src/Hakyll/Web/Template/Internal.hs b/src/Hakyll/Web/Template/Internal.hs
index d0e4d47cb..263615717 100644
--- a/src/Hakyll/Web/Template/Internal.hs
+++ b/src/Hakyll/Web/Template/Internal.hs
@@ -1,15 +1,20 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE DeriveAnyClass             #-}
+{-# LANGUAGE DeriveGeneric              #-}
+
 module Hakyll.Web.Template.Internal
-    ( Template (..)
+    ( Template
     , template
+    , unTemplate
+    , getOrigin
     , templateBodyCompiler
     , templateCompiler
     , applyTemplate
-    , applyTemplate'
     , loadAndApplyTemplate
     , applyAsTemplate
     , readTemplate
+    , readTemplateItem
     , unsafeReadTemplateFile
 
     , module Hakyll.Web.Template.Internal.Element
@@ -23,6 +28,7 @@ import           Data.Binary                          (Binary)
 import           Data.List                            (intercalate)
 import           Data.Typeable                        (Typeable)
 import           GHC.Exts                             (IsString (..))
+import           GHC.Generics                         (Generic)
 import           Prelude                              hiding (id)
 
 
@@ -38,9 +44,10 @@ import           Hakyll.Web.Template.Internal.Trim
 
 --------------------------------------------------------------------------------
 -- | Datatype used for template substitutions.
-newtype Template = Template
+data Template = Template
     { unTemplate :: [TemplateElement]
-    } deriving (Show, Eq, Binary, Typeable)
+    , getOrigin  :: FilePath
+    } deriving (Show, Eq, Generic, Binary, Typeable)
 
 
 --------------------------------------------------------------------------------
@@ -56,13 +63,22 @@ 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
 
 
 --------------------------------------------------------------------------------
 readTemplate :: String -> Template
-readTemplate = Template . trim . readTemplateElems
+readTemplate = readTemplateFile "{literal}"
+
+--------------------------------------------------------------------------------
+readTemplateItem :: Item String -> Template
+readTemplateItem item = let file = show $ itemIdentifier item
+                        in readTemplateFile file (itemBody item)
+
+--------------------------------------------------------------------------------
+readTemplateFile :: FilePath -> String -> Template
+readTemplateFile origin =  template origin . readTemplateElemsFile origin
 
 --------------------------------------------------------------------------------
 -- | Read a template, without metadata header
@@ -70,7 +86,7 @@ templateBodyCompiler :: Compiler (Item Template)
 templateBodyCompiler = cached "Hakyll.Web.Template.templateBodyCompiler" $ do
     item <- getResourceBody
     file <- getResourceFilePath
-    return $ fmap (template . readTemplateElemsFile file) item
+    return $ fmap (readTemplateFile file) item
 
 --------------------------------------------------------------------------------
 -- | Read complete file contents as a template
@@ -78,7 +94,7 @@ templateCompiler :: Compiler (Item Template)
 templateCompiler = cached "Hakyll.Web.Template.templateCompiler" $ do
     item <- getResourceString
     file <- getResourceFilePath
-    return $ fmap (template . readTemplateElemsFile file) item
+    return $ fmap (readTemplateFile file) item
 
 
 --------------------------------------------------------------------------------
@@ -87,7 +103,7 @@ applyTemplate :: Template                -- ^ Template
               -> Item a                  -- ^ Page
               -> Compiler (Item String)  -- ^ Resulting item
 applyTemplate tpl context item = do
-    body <- applyTemplate' (unTemplate tpl) context item
+    body <- applyTemplate' (unTemplate tpl) (getOrigin tpl) context item
     return $ itemSetBody body item
 
 
@@ -95,17 +111,25 @@ applyTemplate tpl context item = do
 applyTemplate'
     :: forall a.
        [TemplateElement] -- ^ Unwrapped Template
+    -> FilePath          -- ^ template name
     -> Context a         -- ^ Context
     -> Item a            -- ^ Page
     -> Compiler String   -- ^ Resulting item
-applyTemplate' tes context x = go tes
+applyTemplate' tes name context x = go tes `catchError` handler
   where
     context' :: String -> [String] -> Item a -> Compiler ContextField
     context' = unContext (context `mappend` missingField)
 
+    itemName = show $ itemIdentifier x
+    handler es = fail $ "Hakyll.Web.Template.applyTemplate: Failed to " ++
+        (if name == itemName
+          then "interpolate template in item " ++ name
+          else "apply template " ++ name ++ " to item " ++ itemName) ++
+        ":\n" ++ intercalate ",\n" es
+
     go = fmap concat . mapM applyElem
 
-    trimError = error $ "Hakyll.Web.Template.applyTemplate: template not " ++
+    trimError = fail $ "Hakyll.Web.Template.applyTemplate: template not " ++
         "fully trimmed."
 
     ---------------------------------------------------------------------------
@@ -134,13 +158,13 @@ applyTemplate' tes context x = go tes
             "got StringField for expr " ++ show e
         ListField c xs -> do
             sep <- maybe (return "") go s
-            bs  <- mapM (applyTemplate' b c) xs
+            bs  <- mapM (applyTemplate' b name c) xs
             return $ intercalate sep bs
 
     applyElem (Partial e) = do
-        p             <- applyExpr e >>= getString e
-        Template tpl' <- loadBody (fromFilePath p)
-        applyTemplate' tpl' context x
+        p    <- applyExpr e >>= getString e
+        tpl' <- loadBody (fromFilePath p)
+        applyTemplate' (unTemplate tpl') (getOrigin tpl') context x
 
     ---------------------------------------------------------------------------
 
@@ -189,15 +213,12 @@ 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 = applyTemplate (readTemplateItem item) context item
 
 
 --------------------------------------------------------------------------------
 unsafeReadTemplateFile :: FilePath -> Compiler Template
 unsafeReadTemplateFile file = do
     tpl <- unsafeCompiler $ readFile file
-    pure $ template $ readTemplateElemsFile file tpl
+    pure $ readTemplateFile file tpl
 
diff --git a/src/Hakyll/Web/Template/Internal/Element.hs b/src/Hakyll/Web/Template/Internal/Element.hs
index f564355f8..dabc8a2a9 100644
--- a/src/Hakyll/Web/Template/Internal/Element.hs
+++ b/src/Hakyll/Web/Template/Internal/Element.hs
@@ -7,7 +7,6 @@ module Hakyll.Web.Template.Internal.Element
     , TemplateExpr (..)
     , TemplateElement (..)
     , templateElems
-    , readTemplateElems
     , readTemplateElemsFile
     ) where
 
@@ -107,12 +106,6 @@ 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
diff --git a/tests/Hakyll/Web/Template/Tests.hs b/tests/Hakyll/Web/Template/Tests.hs
index 994d9ca0b..9b4781ee0 100644
--- a/tests/Hakyll/Web/Template/Tests.hs
+++ b/tests/Hakyll/Web/Template/Tests.hs
@@ -20,6 +20,7 @@ import           Hakyll.Web.Pandoc
 import           Hakyll.Web.Template
 import           Hakyll.Web.Template.Context
 import           Hakyll.Web.Template.Internal
+import           Hakyll.Web.Template.Internal.Element
 import           Hakyll.Web.Template.List
 import           TestSuite.Util
 
@@ -34,9 +35,9 @@ tests = testGroup "Hakyll.Core.Template.Tests" $ concat
 
     , fromAssertions "readTemplate"
         [ [Chunk "Hello ", Expr (Call "guest" [])]
-            @=? readTemplateElems "Hello $guest()$"
+            @=? readTemplateElemsFile "" "Hello $guest()$"
         , [If (Call "a" [StringLiteral "bar"]) [Chunk "foo"] Nothing]
-            @=? readTemplateElems "$if(a(\"bar\"))$foo$endif$"
+            @=? readTemplateElemsFile "" "$if(a(\"bar\"))$foo$endif$"
         -- 'If' trim check.
         , [ TrimL
           , If (Ident (TemplateKey "body"))
@@ -54,7 +55,7 @@ tests = testGroup "Hakyll.Core.Template.Tests" $ concat
                      ])
           , TrimR
           ]
-          @=? readTemplateElems "$-if(body)-$\n$body$\n$-else-$\n$body$\n$-endif-$"
+          @=? readTemplateElemsFile "" "$-if(body)-$\n$body$\n$-else-$\n$body$\n$-endif-$"
         -- 'For' trim check.
         , [ TrimL
           , For (Ident (TemplateKey "authors"))
@@ -62,19 +63,19 @@ tests = testGroup "Hakyll.Core.Template.Tests" $ concat
                 Nothing
           , TrimR
           ]
-          @=? readTemplateElems "$-for(authors)-$\n   body   \n$-endfor-$"
+          @=? readTemplateElemsFile "" "$-for(authors)-$\n   body   \n$-endfor-$"
         -- 'Partial' trim check.
         , [ TrimL
           , Partial (StringLiteral "path")
           , TrimR
           ]
-          @=? readTemplateElems "$-partial(\"path\")-$"
+          @=? readTemplateElemsFile "" "$-partial(\"path\")-$"
         -- 'Expr' trim check.
         , [ TrimL
           , Expr (Ident (TemplateKey "foo"))
           , TrimR
           ]
-          @=? readTemplateElems "$-foo-$"
+          @=? readTemplateElemsFile "" "$-foo-$"
         ]
     ]
 

From 9ec43a6ed46c5daea7688cee12e84997cde4f54c Mon Sep 17 00:00:00 2001
From: Bergi <a.d.bergi@web.de>
Date: Fri, 5 Aug 2016 00:11:47 +0200
Subject: [PATCH 03/19] Better error messages for template parsing

Force templates to be consumed completely,
propagate error appropriately
---
 src/Hakyll/Web/Template/Internal.hs         | 14 +++++++---
 src/Hakyll/Web/Template/Internal/Element.hs | 14 +++++-----
 tests/Hakyll/Web/Template/Tests.hs          | 30 ++++++++++++---------
 3 files changed, 34 insertions(+), 24 deletions(-)

diff --git a/src/Hakyll/Web/Template/Internal.hs b/src/Hakyll/Web/Template/Internal.hs
index 263615717..7adb9afbe 100644
--- a/src/Hakyll/Web/Template/Internal.hs
+++ b/src/Hakyll/Web/Template/Internal.hs
@@ -78,7 +78,13 @@ readTemplateItem item = let file = show $ itemIdentifier item
 
 --------------------------------------------------------------------------------
 readTemplateFile :: FilePath -> String -> Template
-readTemplateFile origin =  template origin . readTemplateElemsFile origin
+readTemplateFile origin = either error (template origin)
+                        . parseTemplateElemsFile origin
+
+--------------------------------------------------------------------------------
+compileTemplateFile :: FilePath -> String -> Compiler Template
+compileTemplateFile origin = either fail (return . template origin)
+                           . parseTemplateElemsFile origin
 
 --------------------------------------------------------------------------------
 -- | Read a template, without metadata header
@@ -86,7 +92,7 @@ templateBodyCompiler :: Compiler (Item Template)
 templateBodyCompiler = cached "Hakyll.Web.Template.templateBodyCompiler" $ do
     item <- getResourceBody
     file <- getResourceFilePath
-    return $ fmap (readTemplateFile file) item
+    withItemBody (compileTemplateFile file) item
 
 --------------------------------------------------------------------------------
 -- | Read complete file contents as a template
@@ -94,7 +100,7 @@ templateCompiler :: Compiler (Item Template)
 templateCompiler = cached "Hakyll.Web.Template.templateCompiler" $ do
     item <- getResourceString
     file <- getResourceFilePath
-    return $ fmap (readTemplateFile file) item
+    withItemBody (compileTemplateFile file) item
 
 
 --------------------------------------------------------------------------------
@@ -220,5 +226,5 @@ applyAsTemplate context item = applyTemplate (readTemplateItem item) context ite
 unsafeReadTemplateFile :: FilePath -> Compiler Template
 unsafeReadTemplateFile file = do
     tpl <- unsafeCompiler $ readFile file
-    pure $ readTemplateFile file tpl
+    compileTemplateFile file tpl
 
diff --git a/src/Hakyll/Web/Template/Internal/Element.hs b/src/Hakyll/Web/Template/Internal/Element.hs
index dabc8a2a9..fc7750136 100644
--- a/src/Hakyll/Web/Template/Internal/Element.hs
+++ b/src/Hakyll/Web/Template/Internal/Element.hs
@@ -7,13 +7,14 @@ module Hakyll.Web.Template.Internal.Element
     , TemplateExpr (..)
     , TemplateElement (..)
     , templateElems
-    , 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,10 +108,9 @@ instance Binary TemplateExpr where
         _ -> error "Hakyll.Web.Template.Internal: Error reading cached template"
 
 --------------------------------------------------------------------------------
-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
 
 
 --------------------------------------------------------------------------------
@@ -160,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
 
diff --git a/tests/Hakyll/Web/Template/Tests.hs b/tests/Hakyll/Web/Template/Tests.hs
index 9b4781ee0..597428892 100644
--- a/tests/Hakyll/Web/Template/Tests.hs
+++ b/tests/Hakyll/Web/Template/Tests.hs
@@ -8,8 +8,9 @@ module Hakyll.Web.Template.Tests
 --------------------------------------------------------------------------------
 import           Test.Framework                 (Test, testGroup)
 import           Test.Framework.Providers.HUnit (testCase)
-import           Test.HUnit                     (Assertion, (@=?), (@?=))
+import           Test.HUnit                     (Assertion, (@=?), (@?=), assertBool)
 
+import           Data.Either                    (isLeft)
 
 --------------------------------------------------------------------------------
 import           Hakyll.Core.Compiler
@@ -34,12 +35,12 @@ tests = testGroup "Hakyll.Core.Template.Tests" $ concat
       ]
 
     , fromAssertions "readTemplate"
-        [ [Chunk "Hello ", Expr (Call "guest" [])]
-            @=? readTemplateElemsFile "" "Hello $guest()$"
-        , [If (Call "a" [StringLiteral "bar"]) [Chunk "foo"] Nothing]
-            @=? readTemplateElemsFile "" "$if(a(\"bar\"))$foo$endif$"
+        [ Right [Chunk "Hello ", Expr (Call "guest" [])]
+            @=? parseTemplateElemsFile "" "Hello $guest()$"
+        , Right [If (Call "a" [StringLiteral "bar"]) [Chunk "foo"] Nothing]
+            @=? parseTemplateElemsFile "" "$if(a(\"bar\"))$foo$endif$"
         -- 'If' trim check.
-        , [ TrimL
+        , Right [ TrimL
           , If (Ident (TemplateKey "body"))
                [ TrimR
                , Chunk "\n"
@@ -55,27 +56,30 @@ tests = testGroup "Hakyll.Core.Template.Tests" $ concat
                      ])
           , TrimR
           ]
-          @=? readTemplateElemsFile "" "$-if(body)-$\n$body$\n$-else-$\n$body$\n$-endif-$"
+          @=? parseTemplateElemsFile "" "$-if(body)-$\n$body$\n$-else-$\n$body$\n$-endif-$"
         -- 'For' trim check.
-        , [ TrimL
+        , Right [ TrimL
           , For (Ident (TemplateKey "authors"))
                 [TrimR, Chunk "\n   body   \n", TrimL]
                 Nothing
           , TrimR
           ]
-          @=? readTemplateElemsFile "" "$-for(authors)-$\n   body   \n$-endfor-$"
+          @=? parseTemplateElemsFile "" "$-for(authors)-$\n   body   \n$-endfor-$"
         -- 'Partial' trim check.
-        , [ TrimL
+        , Right [ TrimL
           , Partial (StringLiteral "path")
           , TrimR
           ]
-          @=? readTemplateElemsFile "" "$-partial(\"path\")-$"
+          @=? parseTemplateElemsFile "" "$-partial(\"path\")-$"
         -- 'Expr' trim check.
-        , [ TrimL
+        , Right [ TrimL
           , Expr (Ident (TemplateKey "foo"))
           , TrimR
           ]
-          @=? readTemplateElemsFile "" "$-foo-$"
+          @=? parseTemplateElemsFile "" "$-foo-$"
+        -- fail on incomplete template.
+        , assertBool "did not yield error" $ isLeft $
+          parseTemplateElemsFile "" "a$b"
         ]
     ]
 

From 7031661d488e96f640f51a0b0b9a6f0de64880fb Mon Sep 17 00:00:00 2001
From: Bergi <a.d.bergi@web.de>
Date: Fri, 5 Aug 2016 04:08:05 +0200
Subject: [PATCH 04/19] docs, docs, docs! Full coverage for Template and
 Context

---
 src/Hakyll/Core/Compiler.hs         |  5 +++
 src/Hakyll/Web/Template.hs          |  2 +-
 src/Hakyll/Web/Template/Context.hs  | 66 ++++++++++++++++++++++++++---
 src/Hakyll/Web/Template/Internal.hs | 17 +++++---
 4 files changed, 77 insertions(+), 13 deletions(-)

diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs
index ae9fbf1f6..4ac14b9a8 100644
--- a/src/Hakyll/Core/Compiler.hs
+++ b/src/Hakyll/Core/Compiler.hs
@@ -62,6 +62,7 @@ getUnderlyingExtension = takeExtension . toFilePath <$> getUnderlying
 
 
 --------------------------------------------------------------------------------
+-- | Create an item from the underlying identifier and a given value.
 makeItem :: a -> Compiler (Item a)
 makeItem x = do
     identifier <- getUnderlying
@@ -141,6 +142,10 @@ saveSnapshot snapshot item = do
 
 
 --------------------------------------------------------------------------------
+-- | Turn on caching for a compilation value to avoid recomputing it
+-- on subsequent Hakyll runs.
+-- The storage key consists of the underlying identifier of the compiled
+-- ressource and the given name.
 cached :: (Binary a, Typeable a)
        => String
        -> Compiler a
diff --git a/src/Hakyll/Web/Template.hs b/src/Hakyll/Web/Template.hs
index 6726dbd12..62690bbb4 100644
--- a/src/Hakyll/Web/Template.hs
+++ b/src/Hakyll/Web/Template.hs
@@ -146,7 +146,7 @@ module Hakyll.Web.Template
     , loadAndApplyTemplate
     , applyAsTemplate
     , readTemplate
-    , readTemplateItem
+    , compileTemplateItem
     , unsafeReadTemplateFile
     ) where
 
diff --git a/src/Hakyll/Web/Template/Context.hs b/src/Hakyll/Web/Template/Context.hs
index 053a572c2..6fd0e25c0 100644
--- a/src/Hakyll/Web/Template/Context.hs
+++ b/src/Hakyll/Web/Template/Context.hs
@@ -1,3 +1,22 @@
+-- | 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 #-}
@@ -92,11 +111,15 @@ field' key value = Context $ \k _ i ->
 
 
 --------------------------------------------------------------------------------
--- | 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 returns an error ('fail', 'empty' etc), the field will be
+-- considered non-existent.
 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)
 
@@ -113,24 +136,38 @@ boolField name f = field name (\i -> if f i
 
 
 --------------------------------------------------------------------------------
--- | 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
@@ -138,6 +175,15 @@ functionField name value = Context $ \k args i ->
 
 
 --------------------------------------------------------------------------------
+-- | 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" <> constFied "y" "bc"
+--
 mapContext :: (String -> String) -> Context a -> Context a
 mapContext f (Context c) = Context $ \k a i -> do
     fld <- c k a i
@@ -154,7 +200,8 @@ 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
@@ -273,7 +320,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
@@ -327,6 +374,7 @@ getItemModificationTime identifier = do
 
 
 --------------------------------------------------------------------------------
+-- Creates a field with the last modification date of the underlying item.
 modificationTimeField :: String     -- ^ Key
                       -> String     -- ^ Format
                       -> Context  a -- ^ Resuting context
@@ -334,6 +382,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
@@ -372,6 +422,8 @@ 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 _ _ -> fail $
     "Missing field '" ++ k ++ "' in context"
diff --git a/src/Hakyll/Web/Template/Internal.hs b/src/Hakyll/Web/Template/Internal.hs
index 7adb9afbe..5f06084ee 100644
--- a/src/Hakyll/Web/Template/Internal.hs
+++ b/src/Hakyll/Web/Template/Internal.hs
@@ -14,7 +14,7 @@ module Hakyll.Web.Template.Internal
     , loadAndApplyTemplate
     , applyAsTemplate
     , readTemplate
-    , readTemplateItem
+    , compileTemplateItem
     , unsafeReadTemplateFile
 
     , module Hakyll.Web.Template.Internal.Element
@@ -68,13 +68,17 @@ template p = flip Template p . trim
 
 
 --------------------------------------------------------------------------------
+-- | Parse a string into a template.
+-- You should prefer 'compileTemplateItem' over this.
 readTemplate :: String -> Template
 readTemplate = readTemplateFile "{literal}"
 
 --------------------------------------------------------------------------------
-readTemplateItem :: Item String -> Template
-readTemplateItem item = let file = show $ itemIdentifier item
-                        in readTemplateFile file (itemBody item)
+-- | Parse an item body into a template.
+-- Provides useful error messages in the 'Compiler' monad.
+compileTemplateItem :: Item String -> Compiler Template
+compileTemplateItem item = let file = show $ itemIdentifier item
+                           in compileTemplateFile file (itemBody item)
 
 --------------------------------------------------------------------------------
 readTemplateFile :: FilePath -> String -> Template
@@ -104,6 +108,7 @@ templateCompiler = cached "Hakyll.Web.Template.templateCompiler" $ do
 
 
 --------------------------------------------------------------------------------
+-- | Interpolate template expressions from context values in a page
 applyTemplate :: Template                -- ^ Template
               -> Context a               -- ^ Context
               -> Item a                  -- ^ Page
@@ -219,7 +224,9 @@ loadAndApplyTemplate identifier context item = do
 applyAsTemplate :: Context String          -- ^ Context
                 -> Item String             -- ^ Item and template
                 -> Compiler (Item String)  -- ^ Resulting item
-applyAsTemplate context item = applyTemplate (readTemplateItem item) context item
+applyAsTemplate context item = do
+    tpl <- compileTemplateItem item
+    applyTemplate tpl context item
 
 
 --------------------------------------------------------------------------------

From f98a2204653b37f4c47b608ab432b13e0585bc86 Mon Sep 17 00:00:00 2001
From: Bergi <a.d.bergi@web.de>
Date: Thu, 11 Aug 2016 08:37:21 +0200
Subject: [PATCH 05/19] Less debug messages from templates

...makes better error messages :-)

Notice the breaking change in 'applyElem', where $if(...)$ conditions
in templates now will throw errors if their field 'fail'ed (instead of just
being 'empty')!
---
 src/Hakyll/Core/Compiler/Internal.hs  | 44 ++++++++++++++++-----------
 src/Hakyll/Core/Runtime.hs            |  4 +--
 src/Hakyll/Web/Template/Context.hs    | 14 ++++-----
 src/Hakyll/Web/Template/Internal.hs   | 18 ++++++-----
 tests/Hakyll/Core/UnixFilter/Tests.hs |  5 +--
 tests/TestSuite/Util.hs               |  2 +-
 6 files changed, 51 insertions(+), 36 deletions(-)

diff --git a/src/Hakyll/Core/Compiler/Internal.hs b/src/Hakyll/Core/Compiler/Internal.hs
index 85d3f468b..3d51fc739 100644
--- a/src/Hakyll/Core/Compiler/Internal.hs
+++ b/src/Hakyll/Core/Compiler/Internal.hs
@@ -17,6 +17,7 @@ module Hakyll.Core.Compiler.Internal
     , compilerTell
     , compilerAsk
     , compilerThrow
+    , compilerFail
     , compilerCatch
     , compilerResult
     , compilerUnsafeIO
@@ -41,7 +42,7 @@ import           Hakyll.Core.Configuration
 import           Hakyll.Core.Dependencies
 import           Hakyll.Core.Identifier
 import           Hakyll.Core.Identifier.Pattern
-import           Hakyll.Core.Logger             (Logger)
+import           Hakyll.Core.Logger             (Logger, Verbosity)
 import qualified Hakyll.Core.Logger             as Logger
 import           Hakyll.Core.Metadata
 import           Hakyll.Core.Provider
@@ -93,7 +94,7 @@ instance Monoid CompilerWrite where
 data CompilerResult a where
     CompilerDone     :: a -> CompilerWrite -> CompilerResult a
     CompilerSnapshot :: Snapshot -> Compiler a -> CompilerResult a
-    CompilerError    :: [String] -> CompilerResult a
+    CompilerError    :: Verbosity -> [String] -> CompilerResult a
     CompilerRequire  :: (Identifier, Snapshot) -> Compiler a -> CompilerResult a
 
 
@@ -112,7 +113,7 @@ instance Functor Compiler where
         return $ case res of
             CompilerDone x w      -> CompilerDone (f x) w
             CompilerSnapshot s c' -> CompilerSnapshot s (fmap f c')
-            CompilerError e       -> CompilerError e
+            CompilerError v e     -> CompilerError v e
             CompilerRequire i c'  -> CompilerRequire i (fmap f c')
     {-# INLINE fmap #-}
 
@@ -132,13 +133,13 @@ instance Monad Compiler where
                     CompilerSnapshot s c' -> CompilerSnapshot s $ do
                         compilerTell w  -- Save dependencies!
                         c'
-                    CompilerError e       -> CompilerError e
+                    CompilerError v e     -> CompilerError v e
                     CompilerRequire i c'  -> CompilerRequire i $ do
                         compilerTell w  -- Save dependencies!
                         c'
 
             CompilerSnapshot s c' -> return $ CompilerSnapshot s (c' >>= f)
-            CompilerError e       -> return $ CompilerError e
+            CompilerError v e     -> return $ CompilerError v e
             CompilerRequire i c'  -> return $ CompilerRequire i (c' >>= f)
     {-# INLINE (>>=) #-}
 
@@ -164,7 +165,10 @@ instance MonadMetadata Compiler where
 --------------------------------------------------------------------------------
 instance MonadError [String] Compiler where
   throwError = compilerThrow
-  catchError = compilerCatch
+  catchError = (. matchErr) . compilerCatch
+    where
+      matchErr f Logger.Error es = f es
+      matchErr f _            _  = f []
 
 
 --------------------------------------------------------------------------------
@@ -172,17 +176,17 @@ runCompiler :: Compiler a -> CompilerRead -> IO (CompilerResult a)
 runCompiler compiler read' = handle handler $ unCompiler compiler read'
   where
     handler :: SomeException -> IO (CompilerResult a)
-    handler e = return $ CompilerError [show e]
+    handler e = return $ CompilerError Logger.Error [show e]
 
 
 --------------------------------------------------------------------------------
 instance Alternative Compiler where
-    empty   = compilerThrow []
-    x <|> y = compilerCatch x $ \es -> do
-        logger <- compilerLogger <$> compilerAsk
-        forM_ es $ \e -> compilerUnsafeIO $ Logger.debug logger $
-            "Hakyll.Core.Compiler.Internal: Alternative failed: " ++ e
-        compilerCatch y $ compilerThrow . (es++)
+    empty   = compilerError Logger.Debug []
+    x <|> y = compilerCatch x $ \vx es -> compilerCatch y $ \vy ->
+        case vx `compare` vy of
+            LT -> compilerError vx . const es
+            EQ -> compilerError vx . (es++)
+            GT -> compilerError vy
     {-# INLINE (<|>) #-}
 
 
@@ -199,19 +203,25 @@ compilerTell deps = Compiler $ \_ -> return $ CompilerDone () deps
 
 
 --------------------------------------------------------------------------------
+compilerError :: Verbosity -> [String] -> Compiler a
+compilerError v es = Compiler $ \_ -> return $ CompilerError v es
+{-# INLINE compilerError #-}
+
 compilerThrow :: [String] -> Compiler a
-compilerThrow es = Compiler $ \_ -> return $ CompilerError es
-{-# INLINE compilerThrow #-}
+compilerThrow = compilerError Logger.Error
+
+compilerFail :: String -> Compiler a
+compilerFail = compilerError Logger.Message . return
 
 
 --------------------------------------------------------------------------------
-compilerCatch :: Compiler a -> ([String] -> Compiler a) -> Compiler a
+compilerCatch :: Compiler a -> (Verbosity -> [String] -> Compiler a) -> Compiler a
 compilerCatch (Compiler x) f = Compiler $ \r -> do
     res <- x r
     case res of
         CompilerDone res' w  -> return (CompilerDone res' w)
         CompilerSnapshot s c -> return (CompilerSnapshot s (compilerCatch c f))
-        CompilerError e      -> unCompiler (f e) r
+        CompilerError v e    -> unCompiler (f v e) r
         CompilerRequire i c  -> return (CompilerRequire i (compilerCatch c f))
 {-# INLINE compilerCatch #-}
 
diff --git a/src/Hakyll/Core/Runtime.hs b/src/Hakyll/Core/Runtime.hs
index 16a5d9e5f..eecb013bd 100644
--- a/src/Hakyll/Core/Runtime.hs
+++ b/src/Hakyll/Core/Runtime.hs
@@ -199,9 +199,9 @@ chase trail id'
         result <- liftIO $ runCompiler compiler read'
         case result of
             -- Rethrow error
-            CompilerError [] -> throwError
+            CompilerError _ [] -> throwError $
                 "Compiler failed but no info given, try running with -v?"
-            CompilerError es -> throwError $ intercalate "; " es
+            CompilerError _ es -> throwError $ intercalate "; " es
 
             -- Signal that a snapshot was saved ->
             CompilerSnapshot snapshot c -> do
diff --git a/src/Hakyll/Web/Template/Context.hs b/src/Hakyll/Web/Template/Context.hs
index 6fd0e25c0..f18a7e86d 100644
--- a/src/Hakyll/Web/Template/Context.hs
+++ b/src/Hakyll/Web/Template/Context.hs
@@ -107,15 +107,15 @@ field' :: String -> (Item a -> Compiler ContextField) -> Context a
 field' key value = Context $ \k _ i ->
     if k == key
         then value i
-        else fail $ "Tried field " ++ key
+        else compilerFail $ "Tried field " ++ key
 
 
 --------------------------------------------------------------------------------
 -- | 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 returns an error ('fail', 'empty' etc), the field will be
--- considered non-existent.
+-- If the compiler returns 'empty', the field will be considered non-existent.
+-- If the compiler throws an error ('fail'), the template breaks.
 field
     :: String                      -- ^ Key
     -> (Item a -> Compiler String) -- ^ Function that constructs a value based
@@ -132,7 +132,7 @@ boolField
     -> Context a
 boolField name f = field name (\i -> if f i
     then pure (error $ unwords ["no string value for bool field:",name])
-    else fail $ "Field " ++ name ++ " is false")
+    else compilerFail $ "Field " ++ name ++ " is false")
 
 
 --------------------------------------------------------------------------------
@@ -171,7 +171,7 @@ functionField :: String                                  -- ^ Key
 functionField name value = Context $ \k args i ->
     if k == name
         then StringField <$> value args i
-        else fail $ "Tried function field " ++ name
+        else compilerFail $ "Tried function field " ++ name
 
 
 --------------------------------------------------------------------------------
@@ -248,7 +248,7 @@ bodyField key = field key $ return . itemBody
 metadataField :: Context a
 metadataField = Context $ \k _ i -> do
     let id = itemIdentifier i
-        empty' = fail $ "No '" ++ k ++ "' field in metadata of item " ++ show id
+        empty' = compilerFail $ "No '" ++ k ++ "' field in metadata of item " ++ show id
     value <- getMetadataField id k
     maybe empty' (return . StringField) value
 
@@ -425,7 +425,7 @@ 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 _ _ -> fail $
+missingField = Context $ \k _ _ -> compilerFail $
     "Missing field '" ++ k ++ "' in context"
 
 parseTimeM :: Bool -> TimeLocale -> String -> String -> Maybe UTCTime
diff --git a/src/Hakyll/Web/Template/Internal.hs b/src/Hakyll/Web/Template/Internal.hs
index 5f06084ee..2c4880f4e 100644
--- a/src/Hakyll/Web/Template/Internal.hs
+++ b/src/Hakyll/Web/Template/Internal.hs
@@ -23,7 +23,6 @@ module Hakyll.Web.Template.Internal
 
 
 --------------------------------------------------------------------------------
-import           Control.Monad.Except                 (MonadError (..))
 import           Data.Binary                          (Binary)
 import           Data.List                            (intercalate)
 import           Data.Typeable                        (Typeable)
@@ -34,8 +33,10 @@ import           Prelude                              hiding (id)
 
 --------------------------------------------------------------------------------
 import           Hakyll.Core.Compiler
+import           Hakyll.Core.Compiler.Internal
 import           Hakyll.Core.Identifier
 import           Hakyll.Core.Item
+import           Hakyll.Core.Logger                   (Verbosity (Error))
 import           Hakyll.Core.Writable
 import           Hakyll.Web.Template.Context
 import           Hakyll.Web.Template.Internal.Element
@@ -126,13 +127,13 @@ applyTemplate'
     -> Context a         -- ^ Context
     -> Item a            -- ^ Page
     -> Compiler String   -- ^ Resulting item
-applyTemplate' tes name context x = go tes `catchError` handler
+applyTemplate' tes name context x = go tes `compilerCatch` handler
   where
     context' :: String -> [String] -> Item a -> Compiler ContextField
     context' = unContext (context `mappend` missingField)
 
     itemName = show $ itemIdentifier x
-    handler es = fail $ "Hakyll.Web.Template.applyTemplate: Failed to " ++
+    handler _ es = fail $ "Hakyll.Web.Template.applyTemplate: Failed to " ++
         (if name == itemName
           then "interpolate template in item " ++ name
           else "apply template " ++ name ++ " to item " ++ itemName) ++
@@ -157,11 +158,14 @@ applyTemplate' tes name context x = go tes `catchError` handler
 
     applyElem Escaped = return "$"
 
-    applyElem (If e t mf) = (applyExpr e >> go t) `catchError` handler
+    applyElem (If e t mf) = do
+        c <- (applyExpr e >> return True) `compilerCatch` handler
+        if c
+            then go t
+            else maybe (return "") go mf
       where
-        handler _ = case mf of
-            Nothing -> return ""
-            Just f  -> go f
+        handler Error es = compilerThrow es
+        handler _     _  = return False
 
     applyElem (For e b s) = applyExpr e >>= \cf -> case cf of
         StringField _  -> fail $
diff --git a/tests/Hakyll/Core/UnixFilter/Tests.hs b/tests/Hakyll/Core/UnixFilter/Tests.hs
index 92c290426..2421f0327 100644
--- a/tests/Hakyll/Core/UnixFilter/Tests.hs
+++ b/tests/Hakyll/Core/UnixFilter/Tests.hs
@@ -16,6 +16,7 @@ import qualified Test.HUnit                     as H
 import           Hakyll.Core.Compiler
 import           Hakyll.Core.Compiler.Internal
 import           Hakyll.Core.Item
+import           Hakyll.Core.Logger
 import           Hakyll.Core.UnixFilter
 import           TestSuite.Util
 
@@ -49,8 +50,8 @@ unixFilterFalse = do
     provider <- newTestProvider store
     result   <- testCompiler store provider "russian.md" compiler
     H.assert $ case result of
-        CompilerError es -> any ("exit code" `isInfixOf`) es
-        _                -> False
+        CompilerError Error es -> any ("exit code" `isInfixOf`) es
+        _                      -> False
     cleanTestEnv
   where
     compiler = getResourceString >>= withItemBody (unixFilter "false" [])
diff --git a/tests/TestSuite/Util.hs b/tests/TestSuite/Util.hs
index e727ecbb1..b9ba985a0 100644
--- a/tests/TestSuite/Util.hs
+++ b/tests/TestSuite/Util.hs
@@ -77,7 +77,7 @@ testCompilerDone store provider underlying compiler = do
     result <- testCompiler store provider underlying compiler
     case result of
         CompilerDone x _    -> return x
-        CompilerError e     -> error $
+        CompilerError _ e   -> error $
             "TestSuite.Util.testCompilerDone: compiler " ++ show underlying ++
             " threw: " ++ intercalate "; " e
         CompilerRequire i _ -> error $

From 0ec007e4438da20b9add1cc793de3b73e5e26ba5 Mon Sep 17 00:00:00 2001
From: Bergi <a.d.bergi@web.de>
Date: Wed, 17 Aug 2016 12:55:04 +0200
Subject: [PATCH 06/19] Better error messages from Alternative fails

...when a more important error prevails.

Also not throwing from 'if' conditions any more,
only logging those errors to the debug screen
---
 src/Hakyll/Core/Compiler/Internal.hs | 22 +++++++++++++++-------
 src/Hakyll/Web/Template/Internal.hs  |  4 +++-
 2 files changed, 18 insertions(+), 8 deletions(-)

diff --git a/src/Hakyll/Core/Compiler/Internal.hs b/src/Hakyll/Core/Compiler/Internal.hs
index 3d51fc739..6f11056ef 100644
--- a/src/Hakyll/Core/Compiler/Internal.hs
+++ b/src/Hakyll/Core/Compiler/Internal.hs
@@ -21,6 +21,7 @@ module Hakyll.Core.Compiler.Internal
     , compilerCatch
     , compilerResult
     , compilerUnsafeIO
+    , compilerDebugLog
 
       -- * Utilities
     , compilerTellDependencies
@@ -182,11 +183,14 @@ runCompiler compiler read' = handle handler $ unCompiler compiler read'
 --------------------------------------------------------------------------------
 instance Alternative Compiler where
     empty   = compilerError Logger.Debug []
-    x <|> y = compilerCatch x $ \vx es -> compilerCatch y $ \vy ->
+    x <|> y = compilerCatch x $ \vx exs -> compilerCatch y $ \vy eys ->
         case vx `compare` vy of
-            LT -> compilerError vx . const es
-            EQ -> compilerError vx . (es++)
-            GT -> compilerError vy
+            LT -> log eys >> compilerError vx exs
+            EQ ->            compilerError vx (exs ++ eys)
+            GT -> log exs >> compilerError vy eys
+      where
+        log = compilerDebugLog . map
+            ("Hakyll.Core.Compiler.Internal: Alternative fail suppressed: " ++)
     {-# INLINE (<|>) #-}
 
 
@@ -240,13 +244,17 @@ compilerUnsafeIO io = Compiler $ \_ -> do
     return $ CompilerDone x mempty
 {-# INLINE compilerUnsafeIO #-}
 
+--------------------------------------------------------------------------------
+compilerDebugLog :: [String] -> Compiler ()
+compilerDebugLog ms = do
+  logger <- compilerLogger <$> compilerAsk
+  compilerUnsafeIO $ forM_ ms $ Logger.debug logger
 
 --------------------------------------------------------------------------------
 compilerTellDependencies :: [Dependency] -> Compiler ()
 compilerTellDependencies ds = do
-  logger <- compilerLogger <$> compilerAsk
-  forM_ ds $ \d -> compilerUnsafeIO $ Logger.debug logger $
-      "Hakyll.Core.Compiler.Internal: Adding dependency: " ++ show d
+  compilerDebugLog $ map (\d ->
+      "Hakyll.Core.Compiler.Internal: Adding dependency: " ++ show d) ds
   compilerTell mempty {compilerDependencies = ds}
 {-# INLINE compilerTellDependencies #-}
 
diff --git a/src/Hakyll/Web/Template/Internal.hs b/src/Hakyll/Web/Template/Internal.hs
index 2c4880f4e..3787ce2b9 100644
--- a/src/Hakyll/Web/Template/Internal.hs
+++ b/src/Hakyll/Web/Template/Internal.hs
@@ -164,7 +164,9 @@ applyTemplate' tes name context x = go tes `compilerCatch` handler
             then go t
             else maybe (return "") go mf
       where
-        handler Error es = compilerThrow es
+        handler Error es = compilerDebugLog (map (\err ->
+            "Hakyll.Web.Template.applyTemplate: [ERROR] in 'if' condition " ++
+            "for expr " ++ show e ++ ": " ++ err) es) >> return False
         handler _     _  = return False
 
     applyElem (For e b s) = applyExpr e >>= \cf -> case cf of

From 458e78d6ebbc6971abd82ccf30c63874d48ce586 Mon Sep 17 00:00:00 2001
From: Bergi <a.d.bergi@web.de>
Date: Wed, 17 Aug 2016 13:56:17 +0200
Subject: [PATCH 07/19] Better error messages for templates

* boolFields used outside of 'if'-conditions now get a "stack trace"
  using a new 'NoField' they don't have to rely on 'error' any more
* templates applied to their own file get proper description
  (did use incompatible paths/identifiers before)
* renamed 'compilerFail' to more descriptive name
---
 src/Hakyll/Core/Compiler/Internal.hs |  6 ++--
 src/Hakyll/Web/Feed.hs               |  2 +-
 src/Hakyll/Web/Template/Context.hs   | 28 +++++++++--------
 src/Hakyll/Web/Template/Internal.hs  | 46 ++++++++++++++--------------
 4 files changed, 43 insertions(+), 39 deletions(-)

diff --git a/src/Hakyll/Core/Compiler/Internal.hs b/src/Hakyll/Core/Compiler/Internal.hs
index 6f11056ef..8a64009ba 100644
--- a/src/Hakyll/Core/Compiler/Internal.hs
+++ b/src/Hakyll/Core/Compiler/Internal.hs
@@ -17,7 +17,7 @@ module Hakyll.Core.Compiler.Internal
     , compilerTell
     , compilerAsk
     , compilerThrow
-    , compilerFail
+    , compilerFailMessage
     , compilerCatch
     , compilerResult
     , compilerUnsafeIO
@@ -214,8 +214,8 @@ compilerError v es = Compiler $ \_ -> return $ CompilerError v es
 compilerThrow :: [String] -> Compiler a
 compilerThrow = compilerError Logger.Error
 
-compilerFail :: String -> Compiler a
-compilerFail = compilerError Logger.Message . return
+compilerFailMessage :: String -> Compiler a
+compilerFailMessage = compilerError Logger.Message . return
 
 
 --------------------------------------------------------------------------------
diff --git a/src/Hakyll/Web/Feed.hs b/src/Hakyll/Web/Feed.hs
index f40fa8af6..b999bb788 100644
--- a/src/Hakyll/Web/Feed.hs
+++ b/src/Hakyll/Web/Feed.hs
@@ -96,8 +96,8 @@ renderFeed feedPath itemPath 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
+            _             -> fail "Hakyll.Web.Feed.renderFeed: Internal error"
 
 
 --------------------------------------------------------------------------------
diff --git a/src/Hakyll/Web/Template/Context.hs b/src/Hakyll/Web/Template/Context.hs
index f18a7e86d..1eb28626f 100644
--- a/src/Hakyll/Web/Template/Context.hs
+++ b/src/Hakyll/Web/Template/Context.hs
@@ -72,7 +72,8 @@ import           System.FilePath               (splitDirectories, takeBaseName)
 --------------------------------------------------------------------------------
 -- | Mostly for internal usage
 data ContextField
-    = StringField String
+    = NoField
+    | StringField String
     | forall a. ListField (Context a) [Item a]
 
 
@@ -107,7 +108,7 @@ field' :: String -> (Item a -> Compiler ContextField) -> Context a
 field' key value = Context $ \k _ i ->
     if k == key
         then value i
-        else compilerFail $ "Tried field " ++ key
+        else compilerFailMessage $ "Tried field " ++ key
 
 
 --------------------------------------------------------------------------------
@@ -130,9 +131,9 @@ 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 compilerFail $ "Field " ++ name ++ " is false")
+boolField name f = field' name (\i -> if f i
+    then return NoField
+    else compilerFailMessage $ "Field " ++ name ++ " is false")
 
 
 --------------------------------------------------------------------------------
@@ -171,7 +172,7 @@ functionField :: String                                  -- ^ Key
 functionField name value = Context $ \k args i ->
     if k == name
         then StringField <$> value args i
-        else compilerFail $ "Tried function field " ++ name
+        else compilerFailMessage $ "Tried function field " ++ name
 
 
 --------------------------------------------------------------------------------
@@ -182,16 +183,18 @@ functionField name value = Context $ \k args i ->
 --
 -- is equivalent to
 --
--- > constField "x" "ac" <> constFied "y" "bc"
+-- > 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
+        NoField         -> wrongType "boolField"
         StringField str -> return $ StringField (f str)
-        ListField _ _   -> fail $
-            "Hakyll.Web.Template.Context.mapContext: " ++
-            "can't map over a ListField!"
+        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:
@@ -248,7 +251,8 @@ bodyField key = field key $ return . itemBody
 metadataField :: Context a
 metadataField = Context $ \k _ i -> do
     let id = itemIdentifier i
-        empty' = compilerFail $ "No '" ++ k ++ "' field in metadata of item " ++ show id
+        empty' = compilerFailMessage $ "No '" ++ k ++ "' field in metadata " ++
+            "of item " ++ show id
     value <- getMetadataField id k
     maybe empty' (return . StringField) value
 
@@ -425,7 +429,7 @@ 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 _ _ -> compilerFail $
+missingField = Context $ \k _ _ -> compilerFailMessage $
     "Missing field '" ++ k ++ "' in context"
 
 parseTimeM :: Bool -> TimeLocale -> String -> String -> Maybe UTCTime
diff --git a/src/Hakyll/Web/Template/Internal.hs b/src/Hakyll/Web/Template/Internal.hs
index 3787ce2b9..20fca57a8 100644
--- a/src/Hakyll/Web/Template/Internal.hs
+++ b/src/Hakyll/Web/Template/Internal.hs
@@ -72,31 +72,30 @@ template p = flip Template p . trim
 -- | Parse a string into a template.
 -- You should prefer 'compileTemplateItem' over this.
 readTemplate :: String -> Template
-readTemplate = readTemplateFile "{literal}"
+readTemplate = either error (template origin) . parseTemplateElemsFile origin
+  where
+    origin = "{literal}"
 
 --------------------------------------------------------------------------------
 -- | Parse an item body into a template.
 -- Provides useful error messages in the 'Compiler' monad.
 compileTemplateItem :: Item String -> Compiler Template
-compileTemplateItem item = let file = show $ itemIdentifier item
+compileTemplateItem item = let file = itemIdentifier item
                            in compileTemplateFile file (itemBody item)
 
 --------------------------------------------------------------------------------
-readTemplateFile :: FilePath -> String -> Template
-readTemplateFile origin = either error (template origin)
-                        . parseTemplateElemsFile origin
-
---------------------------------------------------------------------------------
-compileTemplateFile :: FilePath -> String -> Compiler Template
-compileTemplateFile origin = either fail (return . template origin)
-                           . parseTemplateElemsFile origin
+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
+    file <- getUnderlying
     withItemBody (compileTemplateFile file) item
 
 --------------------------------------------------------------------------------
@@ -104,7 +103,7 @@ templateBodyCompiler = cached "Hakyll.Web.Template.templateBodyCompiler" $ do
 templateCompiler :: Compiler (Item Template)
 templateCompiler = cached "Hakyll.Web.Template.templateCompiler" $ do
     item <- getResourceString
-    file <- getResourceFilePath
+    file <- getUnderlying
     withItemBody (compileTemplateFile file) item
 
 
@@ -141,9 +140,6 @@ applyTemplate' tes name context x = go tes `compilerCatch` handler
 
     go = fmap concat . mapM applyElem
 
-    trimError = fail $ "Hakyll.Web.Template.applyTemplate: template not " ++
-        "fully trimmed."
-
     ---------------------------------------------------------------------------
 
     applyElem :: TemplateElement -> Compiler String
@@ -170,9 +166,8 @@ applyTemplate' tes name context x = go tes `compilerCatch` handler
         handler _     _  = return False
 
     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
+        NoField        -> expected "ListField" "boolField" e
+        StringField _  -> expected "ListField" "StringField" e
         ListField c xs -> do
             sep <- maybe (return "") go s
             bs  <- mapM (applyTemplate' b name c) xs
@@ -197,10 +192,16 @@ applyTemplate' tes name context x = go tes `compilerCatch` handler
 
     ----------------------------------------------------------------------------
 
+    getString e NoField         = expected "StringField" "boolField" e
     getString _ (StringField s) = return s
-    getString e (ListField _ _) = fail $
-        "Hakyll.Web.Template.applyTemplateWith: expected StringField but " ++
-        "got ListField for expr " ++ show e
+    getString e (ListField _ _) = expected "StringField" "ListField" e
+
+    expected typ act e = fail $ unwords ["Hakyll.Web.Template.applyTemplate:",
+        "expected", typ, "but got", act, "for expr", show e]
+
+    -- expected to never happen with all templates constructed by 'template'
+    trimError = fail $
+        "Hakyll.Web.Template.applyTemplate: template not fully trimmed."
 
 
 --------------------------------------------------------------------------------
@@ -239,5 +240,4 @@ applyAsTemplate context item = do
 unsafeReadTemplateFile :: FilePath -> Compiler Template
 unsafeReadTemplateFile file = do
     tpl <- unsafeCompiler $ readFile file
-    compileTemplateFile file tpl
-
+    compileTemplateFile (fromFilePath file) tpl

From f546381f26726db8a537a71d60eb44898a5cecd2 Mon Sep 17 00:00:00 2001
From: Bergi <a.d.bergi@web.de>
Date: Thu, 8 Mar 2018 22:37:58 +0100
Subject: [PATCH 08/19] test case for mismatched template syntax

Closes #507 (actually was fixed by 9ec43a6ed46 already, this just adds the test)
---
 tests/Hakyll/Web/Template/Tests.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/tests/Hakyll/Web/Template/Tests.hs b/tests/Hakyll/Web/Template/Tests.hs
index 257a6d683..4d4394cd1 100644
--- a/tests/Hakyll/Web/Template/Tests.hs
+++ b/tests/Hakyll/Web/Template/Tests.hs
@@ -81,6 +81,9 @@ tests = testGroup "Hakyll.Core.Template.Tests" $ concat
         -- fail on incomplete template.
         , assertBool "did not yield error" $ isLeft $
           parseTemplateElemsFile "" "a$b"
+        -- fail on mismatched template syntax.
+        , assertBool "did not fail to parse" $ isLeft $
+          parseTemplateElemsFile "" "$for(xs)$\n  <p>foo</p>\n$endif$"
         ]
     ]
 

From 7f1b00eda0d8b0d2ca05f3477ded2b8599d3a3d9 Mon Sep 17 00:00:00 2001
From: Bergi <a.d.bergi@web.de>
Date: Sat, 10 Mar 2018 20:01:29 +0100
Subject: [PATCH 09/19] Cleanup of CompilerResult, use extra data type instead
 of Verbosity

See https://github.com/jaspervdj/hakyll/pull/462#issuecomment-371687707
and below for detailed explanation

Also abstracted out `testCompilerError` in the test suite,
and added a `compilerTry` that is much easier to use (and specifically, to
branch on) than `compilerCatch`
---
 lib/Hakyll/Core/Compiler/Internal.hs  | 92 +++++++++++++++++----------
 lib/Hakyll/Core/Runtime.hs            |  6 +-
 lib/Hakyll/Web/Template/Context.hs    |  1 +
 lib/Hakyll/Web/Template/Internal.hs   | 22 +++----
 tests/Hakyll/Core/UnixFilter/Tests.hs | 13 +---
 tests/Hakyll/Web/Template/Tests.hs    |  1 -
 tests/TestSuite/Util.hs               | 14 +++-
 7 files changed, 86 insertions(+), 63 deletions(-)

diff --git a/lib/Hakyll/Core/Compiler/Internal.hs b/lib/Hakyll/Core/Compiler/Internal.hs
index 8a64009ba..2c1aadc1d 100644
--- a/lib/Hakyll/Core/Compiler/Internal.hs
+++ b/lib/Hakyll/Core/Compiler/Internal.hs
@@ -9,6 +9,7 @@ module Hakyll.Core.Compiler.Internal
       Snapshot
     , CompilerRead (..)
     , CompilerWrite (..)
+    , Reason (..)
     , CompilerResult (..)
     , Compiler (..)
     , runCompiler
@@ -18,12 +19,14 @@ module Hakyll.Core.Compiler.Internal
     , compilerAsk
     , compilerThrow
     , compilerFailMessage
+    , compilerTry
     , compilerCatch
     , compilerResult
     , compilerUnsafeIO
     , compilerDebugLog
 
       -- * Utilities
+    , getReason
     , compilerTellDependencies
     , compilerTellCacheHits
     ) where
@@ -43,7 +46,6 @@ import           Hakyll.Core.Configuration
 import           Hakyll.Core.Dependencies
 import           Hakyll.Core.Identifier
 import           Hakyll.Core.Identifier.Pattern
-import           Hakyll.Core.Logger             (Logger, Verbosity)
 import qualified Hakyll.Core.Logger             as Logger
 import           Hakyll.Core.Metadata
 import           Hakyll.Core.Provider
@@ -73,7 +75,7 @@ data CompilerRead = CompilerRead
     , -- | Compiler store
       compilerStore      :: Store
     , -- | Logger
-      compilerLogger     :: Logger
+      compilerLogger     :: Logger.Logger
     }
 
 
@@ -91,11 +93,25 @@ instance Monoid CompilerWrite where
         CompilerWrite (d1 ++ d2) (h1 + h2)
 
 
+--------------------------------------------------------------------------------
+data Reason a
+    -- | An exception occured during compilation
+    = CompilationFailure a
+    -- | Absence of any result, most notably in template contexts
+    | NoCompilationResult a
+
+
+-- | Unwrap a `Reason`
+getReason :: Reason a -> a
+getReason (CompilationFailure x)  = x
+getReason (NoCompilationResult x) = x
+
+
 --------------------------------------------------------------------------------
 data CompilerResult a where
     CompilerDone     :: a -> CompilerWrite -> CompilerResult a
     CompilerSnapshot :: Snapshot -> Compiler a -> CompilerResult a
-    CompilerError    :: Verbosity -> [String] -> CompilerResult a
+    CompilerError    :: Reason [String] -> CompilerResult a
     CompilerRequire  :: (Identifier, Snapshot) -> Compiler a -> CompilerResult a
 
 
@@ -114,8 +130,8 @@ instance Functor Compiler where
         return $ case res of
             CompilerDone x w      -> CompilerDone (f x) w
             CompilerSnapshot s c' -> CompilerSnapshot s (fmap f c')
-            CompilerError v e     -> CompilerError v e
             CompilerRequire i c'  -> CompilerRequire i (fmap f c')
+            CompilerError e       -> CompilerError e
     {-# INLINE fmap #-}
 
 
@@ -134,14 +150,14 @@ instance Monad Compiler where
                     CompilerSnapshot s c' -> CompilerSnapshot s $ do
                         compilerTell w  -- Save dependencies!
                         c'
-                    CompilerError v e     -> CompilerError v e
                     CompilerRequire i c'  -> CompilerRequire i $ do
                         compilerTell w  -- Save dependencies!
                         c'
+                    CompilerError e       -> CompilerError e
 
             CompilerSnapshot s c' -> return $ CompilerSnapshot s (c' >>= f)
-            CompilerError v e     -> return $ CompilerError v e
             CompilerRequire i c'  -> return $ CompilerRequire i (c' >>= f)
+            CompilerError e       -> return $ CompilerError e
     {-# INLINE (>>=) #-}
 
     fail = compilerThrow . return
@@ -166,10 +182,7 @@ instance MonadMetadata Compiler where
 --------------------------------------------------------------------------------
 instance MonadError [String] Compiler where
   throwError = compilerThrow
-  catchError = (. matchErr) . compilerCatch
-    where
-      matchErr f Logger.Error es = f es
-      matchErr f _            _  = f []
+  catchError c = compilerCatch c . (. getReason)
 
 
 --------------------------------------------------------------------------------
@@ -177,19 +190,21 @@ runCompiler :: Compiler a -> CompilerRead -> IO (CompilerResult a)
 runCompiler compiler read' = handle handler $ unCompiler compiler read'
   where
     handler :: SomeException -> IO (CompilerResult a)
-    handler e = return $ CompilerError Logger.Error [show e]
+    handler e = return $ CompilerError $ CompilationFailure [show e]
 
 
 --------------------------------------------------------------------------------
 instance Alternative Compiler where
-    empty   = compilerError Logger.Debug []
-    x <|> y = compilerCatch x $ \vx exs -> compilerCatch y $ \vy eys ->
-        case vx `compare` vy of
-            LT -> log eys >> compilerError vx exs
-            EQ ->            compilerError vx (exs ++ eys)
-            GT -> log exs >> compilerError vy eys
+    empty   = compilerMissing []
+    x <|> y = x `compilerCatch` (\rx -> y `compilerCatch` (\ry ->
+        case (rx, ry) of
+          (CompilationFailure xs,  CompilationFailure ys)  -> compilerThrow $ xs ++ ys
+          (CompilationFailure xs,  NoCompilationResult ys) -> debug ys >> compilerThrow xs
+          (NoCompilationResult xs, CompilationFailure ys)  -> debug xs >> compilerThrow ys
+          (NoCompilationResult xs, NoCompilationResult ys) -> compilerMissing $ xs ++ ys
+        ))
       where
-        log = compilerDebugLog . map
+        debug = compilerDebugLog . map
             ("Hakyll.Core.Compiler.Internal: Alternative fail suppressed: " ++)
     {-# INLINE (<|>) #-}
 
@@ -202,41 +217,52 @@ compilerAsk = Compiler $ \r -> return $ CompilerDone r mempty
 
 --------------------------------------------------------------------------------
 compilerTell :: CompilerWrite -> Compiler ()
-compilerTell deps = Compiler $ \_ -> return $ CompilerDone () deps
+compilerTell = compilerResult . CompilerDone ()
 {-# INLINE compilerTell #-}
 
 
 --------------------------------------------------------------------------------
-compilerError :: Verbosity -> [String] -> Compiler a
-compilerError v es = Compiler $ \_ -> return $ CompilerError v es
-{-# INLINE compilerError #-}
+-- | Put the result back in a compiler
+compilerResult :: CompilerResult a -> Compiler a
+compilerResult x = Compiler $ \_ -> return x
+{-# INLINE compilerResult #-}
 
+
+--------------------------------------------------------------------------------
 compilerThrow :: [String] -> Compiler a
-compilerThrow = compilerError Logger.Error
+compilerThrow = compilerResult . CompilerError . CompilationFailure
+
+compilerMissing :: [String] -> Compiler a
+compilerMissing = compilerResult . CompilerError . NoCompilationResult
 
 compilerFailMessage :: String -> Compiler a
-compilerFailMessage = compilerError Logger.Message . return
+compilerFailMessage = compilerMissing . return
 
 
 --------------------------------------------------------------------------------
-compilerCatch :: Compiler a -> (Verbosity -> [String] -> Compiler a) -> Compiler a
+compilerTry :: Compiler a -> Compiler (Either (Reason [String]) a)
+compilerTry (Compiler x) = Compiler $ \r -> do
+    res <- x r
+    case res of
+        CompilerDone res' w  -> return (CompilerDone (Right res') w)
+        CompilerSnapshot s c -> return (CompilerSnapshot s (compilerTry c))
+        CompilerRequire i c  -> return (CompilerRequire i (compilerTry c))
+        CompilerError e      -> return (CompilerDone (Left e) mempty)
+{-# INLINE compilerTry #-}
+
+--------------------------------------------------------------------------------
+-- compilerCatch f = compilerTry >=> either f return
+compilerCatch :: Compiler a -> (Reason [String] -> Compiler a) -> Compiler a
 compilerCatch (Compiler x) f = Compiler $ \r -> do
     res <- x r
     case res of
         CompilerDone res' w  -> return (CompilerDone res' w)
         CompilerSnapshot s c -> return (CompilerSnapshot s (compilerCatch c f))
-        CompilerError v e    -> unCompiler (f v e) r
         CompilerRequire i c  -> return (CompilerRequire i (compilerCatch c f))
+        CompilerError e      -> unCompiler (f e) r
 {-# INLINE compilerCatch #-}
 
 
---------------------------------------------------------------------------------
--- | Put the result back in a compiler
-compilerResult :: CompilerResult a -> Compiler a
-compilerResult x = Compiler $ \_ -> return x
-{-# INLINE compilerResult #-}
-
-
 --------------------------------------------------------------------------------
 compilerUnsafeIO :: IO a -> Compiler a
 compilerUnsafeIO io = Compiler $ \_ -> do
diff --git a/lib/Hakyll/Core/Runtime.hs b/lib/Hakyll/Core/Runtime.hs
index eecb013bd..4fb513832 100644
--- a/lib/Hakyll/Core/Runtime.hs
+++ b/lib/Hakyll/Core/Runtime.hs
@@ -199,9 +199,9 @@ chase trail id'
         result <- liftIO $ runCompiler compiler read'
         case result of
             -- Rethrow error
-            CompilerError _ [] -> throwError $
-                "Compiler failed but no info given, try running with -v?"
-            CompilerError _ es -> throwError $ intercalate "; " es
+            CompilerError e -> throwError $ case getReason e of
+                [] -> "Compiler failed but no info given, try running with -v?"
+                es -> intercalate "; " es
 
             -- Signal that a snapshot was saved ->
             CompilerSnapshot snapshot c -> do
diff --git a/lib/Hakyll/Web/Template/Context.hs b/lib/Hakyll/Web/Template/Context.hs
index 1eb28626f..cc5657726 100644
--- a/lib/Hakyll/Web/Template/Context.hs
+++ b/lib/Hakyll/Web/Template/Context.hs
@@ -67,6 +67,7 @@ import           Hakyll.Core.Provider
 import           Hakyll.Core.Util.String       (needlePrefix, splitAll)
 import           Hakyll.Web.Html
 import           System.FilePath               (splitDirectories, takeBaseName)
+import           Prelude                       hiding (id)
 
 
 --------------------------------------------------------------------------------
diff --git a/lib/Hakyll/Web/Template/Internal.hs b/lib/Hakyll/Web/Template/Internal.hs
index 20fca57a8..90d4d8f51 100644
--- a/lib/Hakyll/Web/Template/Internal.hs
+++ b/lib/Hakyll/Web/Template/Internal.hs
@@ -28,7 +28,7 @@ import           Data.List                            (intercalate)
 import           Data.Typeable                        (Typeable)
 import           GHC.Exts                             (IsString (..))
 import           GHC.Generics                         (Generic)
-import           Prelude                              hiding (id)
+import           Control.Monad.Except                 (catchError)
 
 
 --------------------------------------------------------------------------------
@@ -36,7 +36,6 @@ import           Hakyll.Core.Compiler
 import           Hakyll.Core.Compiler.Internal
 import           Hakyll.Core.Identifier
 import           Hakyll.Core.Item
-import           Hakyll.Core.Logger                   (Verbosity (Error))
 import           Hakyll.Core.Writable
 import           Hakyll.Web.Template.Context
 import           Hakyll.Web.Template.Internal.Element
@@ -126,13 +125,13 @@ applyTemplate'
     -> Context a         -- ^ Context
     -> Item a            -- ^ Page
     -> Compiler String   -- ^ Resulting item
-applyTemplate' tes name context x = go tes `compilerCatch` handler
+applyTemplate' tes name context x = go tes `catchError` handler
   where
     context' :: String -> [String] -> Item a -> Compiler ContextField
     context' = unContext (context `mappend` missingField)
 
     itemName = show $ itemIdentifier x
-    handler _ es = fail $ "Hakyll.Web.Template.applyTemplate: Failed to " ++
+    handler es = fail $ "Hakyll.Web.Template.applyTemplate: Failed to " ++
         (if name == itemName
           then "interpolate template in item " ++ name
           else "apply template " ++ name ++ " to item " ++ itemName) ++
@@ -154,16 +153,15 @@ applyTemplate' tes name context x = go tes `compilerCatch` handler
 
     applyElem Escaped = return "$"
 
-    applyElem (If e t mf) = do
-        c <- (applyExpr e >> return True) `compilerCatch` handler
-        if c
-            then go t
-            else maybe (return "") go mf
+    applyElem (If e t mf) = compilerTry (applyExpr e) >>= handle
       where
-        handler Error es = compilerDebugLog (map (\err ->
+        f = maybe (return "") go mf
+        handle (Right _)                      = go t
+        handle (Left (NoCompilationResult _)) = f
+        handle (Left (CompilationFailure es)) = debug es >> f
+        debug es = compilerDebugLog (map (\err ->
             "Hakyll.Web.Template.applyTemplate: [ERROR] in 'if' condition " ++
-            "for expr " ++ show e ++ ": " ++ err) es) >> return False
-        handler _     _  = return False
+            "for expr " ++ show e ++ ": " ++ err) es)
 
     applyElem (For e b s) = applyExpr e >>= \cf -> case cf of
         NoField        -> expected "ListField" "boolField" e
diff --git a/tests/Hakyll/Core/UnixFilter/Tests.hs b/tests/Hakyll/Core/UnixFilter/Tests.hs
index 9a9d57b35..2b8400467 100644
--- a/tests/Hakyll/Core/UnixFilter/Tests.hs
+++ b/tests/Hakyll/Core/UnixFilter/Tests.hs
@@ -6,7 +6,6 @@ module Hakyll.Core.UnixFilter.Tests
 
 
 --------------------------------------------------------------------------------
-import           Data.List                     (isInfixOf)
 import           Test.Tasty                    (TestTree, testGroup)
 import           Test.Tasty.HUnit              (testCase)
 import qualified Test.Tasty.HUnit              as H
@@ -14,9 +13,7 @@ import qualified Test.Tasty.HUnit              as H
 
 --------------------------------------------------------------------------------
 import           Hakyll.Core.Compiler
-import           Hakyll.Core.Compiler.Internal
 import           Hakyll.Core.Item
-import           Hakyll.Core.Logger
 import           Hakyll.Core.UnixFilter
 import           Hakyll.Core.Identifier
 import           TestSuite.Util
@@ -52,10 +49,7 @@ unixFilterFalse :: H.Assertion
 unixFilterFalse = do
     store    <- newTestStore
     provider <- newTestProvider store
-    result   <- testCompiler store provider testMarkdown compiler
-    case result of
-        CompilerError Error es -> any ("exit code" `isInfixOf`) es H.@? "Expecting exit code error"
-        _                      -> H.assertFailure "Expecting CompilerError"
+    testCompilerError store provider testMarkdown compiler "exit code"
     cleanTestEnv
   where
     compiler = getResourceString >>= withItemBody (unixFilter "false" [])
@@ -66,10 +60,7 @@ unixFilterError :: H.Assertion
 unixFilterError = do
     store    <- newTestStore
     provider <- newTestProvider store
-    result   <- testCompiler store provider testMarkdown compiler
-    case result of
-        CompilerError Error es -> any ("option" `isInfixOf`) es H.@? "Expecting option error"
-        _                      -> H.assertFailure "Expecting CompilerError"
+    testCompilerError store provider testMarkdown compiler "option"
     cleanTestEnv
   where
     compiler = getResourceString >>= withItemBody (unixFilter "head" ["-#"])
diff --git a/tests/Hakyll/Web/Template/Tests.hs b/tests/Hakyll/Web/Template/Tests.hs
index 4d4394cd1..25bf7ff36 100644
--- a/tests/Hakyll/Web/Template/Tests.hs
+++ b/tests/Hakyll/Web/Template/Tests.hs
@@ -21,7 +21,6 @@ import           Hakyll.Web.Pandoc
 import           Hakyll.Web.Template
 import           Hakyll.Web.Template.Context
 import           Hakyll.Web.Template.Internal
-import           Hakyll.Web.Template.Internal.Element
 import           Hakyll.Web.Template.List
 import           TestSuite.Util
 
diff --git a/tests/TestSuite/Util.hs b/tests/TestSuite/Util.hs
index e3aaba6d4..43b727901 100644
--- a/tests/TestSuite/Util.hs
+++ b/tests/TestSuite/Util.hs
@@ -6,13 +6,14 @@ module TestSuite.Util
     , newTestProvider
     , testCompiler
     , testCompilerDone
+    , testCompilerError
     , testConfiguration
     , cleanTestEnv
     ) where
 
 
 --------------------------------------------------------------------------------
-import           Data.List                     (intercalate)
+import           Data.List                     (intercalate, isInfixOf)
 import           Data.Monoid                   (mempty)
 import qualified Data.Set                      as S
 import           Test.Tasty
@@ -76,15 +77,22 @@ testCompilerDone store provider underlying compiler = do
     result <- testCompiler store provider underlying compiler
     case result of
         CompilerDone x _    -> return x
-        CompilerError _ e   -> fail $
+        CompilerError e     -> fail $
             "TestSuite.Util.testCompilerDone: compiler " ++ show underlying ++
-            " threw: " ++ intercalate "; " e
+            " threw: " ++ intercalate "; " (getReason e)
         CompilerRequire i _ -> fail $
             "TestSuite.Util.testCompilerDone: compiler " ++ show underlying ++
             " requires: " ++ show i
         CompilerSnapshot _ _ -> fail
             "TestSuite.Util.testCompilerDone: unexpected CompilerSnapshot"
 
+testCompilerError :: Store -> Provider -> Identifier -> Compiler a -> String -> IO ()
+testCompilerError store provider underlying compiler expectedMessage = do
+    result   <- testCompiler store provider underlying compiler
+    case result of
+        CompilerError e -> any (expectedMessage `isInfixOf`) (getReason e) @?
+                               "Expecting '" ++ expectedMessage ++ "' error"
+        _               -> assertFailure "Expecting CompilerError"
 
 --------------------------------------------------------------------------------
 testConfiguration :: Configuration

From 1e04f930dfef4c7d57258564e552b6623065f912 Mon Sep 17 00:00:00 2001
From: Bergi <a.d.bergi@web.de>
Date: Sat, 10 Mar 2018 20:24:16 +0100
Subject: [PATCH 10/19] Better names, some minor simplifications

---
 lib/Hakyll/Core/Compiler/Internal.hs       | 16 ++++++++--------
 lib/Hakyll/Web/Template/Context.hs         | 16 ++++++++--------
 lib/Hakyll/Web/Template/Internal.hs        |  4 ++--
 tests/Hakyll/Web/Template/Context/Tests.hs |  4 ++--
 tests/Hakyll/Web/Template/Tests.hs         | 18 ++++++++++--------
 5 files changed, 30 insertions(+), 28 deletions(-)

diff --git a/lib/Hakyll/Core/Compiler/Internal.hs b/lib/Hakyll/Core/Compiler/Internal.hs
index 2c1aadc1d..71fffd6da 100644
--- a/lib/Hakyll/Core/Compiler/Internal.hs
+++ b/lib/Hakyll/Core/Compiler/Internal.hs
@@ -18,7 +18,7 @@ module Hakyll.Core.Compiler.Internal
     , compilerTell
     , compilerAsk
     , compilerThrow
-    , compilerFailMessage
+    , compilerNoResult
     , compilerTry
     , compilerCatch
     , compilerResult
@@ -108,11 +108,11 @@ getReason (NoCompilationResult x) = x
 
 
 --------------------------------------------------------------------------------
-data CompilerResult a where
-    CompilerDone     :: a -> CompilerWrite -> CompilerResult a
-    CompilerSnapshot :: Snapshot -> Compiler a -> CompilerResult a
-    CompilerError    :: Reason [String] -> CompilerResult a
-    CompilerRequire  :: (Identifier, Snapshot) -> Compiler a -> CompilerResult a
+data CompilerResult a
+    = CompilerDone a CompilerWrite
+    | CompilerSnapshot Snapshot (Compiler a)
+    | CompilerRequire (Identifier, Snapshot) (Compiler a)
+    | CompilerError (Reason [String])
 
 
 --------------------------------------------------------------------------------
@@ -235,8 +235,8 @@ compilerThrow = compilerResult . CompilerError . CompilationFailure
 compilerMissing :: [String] -> Compiler a
 compilerMissing = compilerResult . CompilerError . NoCompilationResult
 
-compilerFailMessage :: String -> Compiler a
-compilerFailMessage = compilerMissing . return
+compilerNoResult :: String -> Compiler a
+compilerNoResult = compilerMissing . return
 
 
 --------------------------------------------------------------------------------
diff --git a/lib/Hakyll/Web/Template/Context.hs b/lib/Hakyll/Web/Template/Context.hs
index cc5657726..0e190ec80 100644
--- a/lib/Hakyll/Web/Template/Context.hs
+++ b/lib/Hakyll/Web/Template/Context.hs
@@ -73,7 +73,7 @@ import           Prelude                       hiding (id)
 --------------------------------------------------------------------------------
 -- | Mostly for internal usage
 data ContextField
-    = NoField
+    = EmptyField
     | StringField String
     | forall a. ListField (Context a) [Item a]
 
@@ -109,7 +109,7 @@ field' :: String -> (Item a -> Compiler ContextField) -> Context a
 field' key value = Context $ \k _ i ->
     if k == key
         then value i
-        else compilerFailMessage $ "Tried field " ++ key
+        else compilerNoResult $ "Tried field " ++ key
 
 
 --------------------------------------------------------------------------------
@@ -133,8 +133,8 @@ boolField
     -> (Item a -> Bool)
     -> Context a
 boolField name f = field' name (\i -> if f i
-    then return NoField
-    else compilerFailMessage $ "Field " ++ name ++ " is false")
+    then return EmptyField
+    else compilerNoResult $ "Field " ++ name ++ " is false")
 
 
 --------------------------------------------------------------------------------
@@ -173,7 +173,7 @@ functionField :: String                                  -- ^ Key
 functionField name value = Context $ \k args i ->
     if k == name
         then StringField <$> value args i
-        else compilerFailMessage $ "Tried function field " ++ name
+        else compilerNoResult $ "Tried function field " ++ name
 
 
 --------------------------------------------------------------------------------
@@ -190,7 +190,7 @@ mapContext :: (String -> String) -> Context a -> Context a
 mapContext f (Context c) = Context $ \k a i -> do
     fld <- c k a i
     case fld of
-        NoField         -> wrongType "boolField"
+        EmptyField      -> wrongType "boolField"
         StringField str -> return $ StringField (f str)
         ListField _ _   -> wrongType "ListField"
   where
@@ -252,7 +252,7 @@ bodyField key = field key $ return . itemBody
 metadataField :: Context a
 metadataField = Context $ \k _ i -> do
     let id = itemIdentifier i
-        empty' = compilerFailMessage $ "No '" ++ k ++ "' field in metadata " ++
+        empty' = compilerNoResult $ "No '" ++ k ++ "' field in metadata " ++
             "of item " ++ show id
     value <- getMetadataField id k
     maybe empty' (return . StringField) value
@@ -430,7 +430,7 @@ 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 _ _ -> compilerFailMessage $
+missingField = Context $ \k _ _ -> compilerNoResult $
     "Missing field '" ++ k ++ "' in context"
 
 parseTimeM :: Bool -> TimeLocale -> String -> String -> Maybe UTCTime
diff --git a/lib/Hakyll/Web/Template/Internal.hs b/lib/Hakyll/Web/Template/Internal.hs
index 90d4d8f51..c0037eeb4 100644
--- a/lib/Hakyll/Web/Template/Internal.hs
+++ b/lib/Hakyll/Web/Template/Internal.hs
@@ -164,7 +164,7 @@ applyTemplate' tes name context x = go tes `catchError` handler
             "for expr " ++ show e ++ ": " ++ err) es)
 
     applyElem (For e b s) = applyExpr e >>= \cf -> case cf of
-        NoField        -> expected "ListField" "boolField" e
+        EmptyField     -> expected "ListField" "boolField" e
         StringField _  -> expected "ListField" "StringField" e
         ListField c xs -> do
             sep <- maybe (return "") go s
@@ -190,7 +190,7 @@ applyTemplate' tes name context x = go tes `catchError` handler
 
     ----------------------------------------------------------------------------
 
-    getString e NoField         = expected "StringField" "boolField" e
+    getString e EmptyField      = expected "StringField" "boolField" e
     getString _ (StringField s) = return s
     getString e (ListField _ _) = expected "StringField" "ListField" e
 
diff --git a/tests/Hakyll/Web/Template/Context/Tests.hs b/tests/Hakyll/Web/Template/Context/Tests.hs
index f26339184..06f983613 100644
--- a/tests/Hakyll/Web/Template/Context/Tests.hs
+++ b/tests/Hakyll/Web/Template/Context/Tests.hs
@@ -53,6 +53,6 @@ testContextDone store provider identifier key context =
         cf   <- unContext context key [] item
         case cf of
             StringField str -> return str
-            ListField _ _   -> error $
+            _               -> error $
                 "Hakyll.Web.Template.Context.Tests.testContextDone: " ++
-                "Didn't expect ListField"
+                "expected StringField"
diff --git a/tests/Hakyll/Web/Template/Tests.hs b/tests/Hakyll/Web/Template/Tests.hs
index 25bf7ff36..6f03b9f47 100644
--- a/tests/Hakyll/Web/Template/Tests.hs
+++ b/tests/Hakyll/Web/Template/Tests.hs
@@ -36,9 +36,9 @@ tests = testGroup "Hakyll.Core.Template.Tests" $ concat
 
     , fromAssertions "parseTemplate"
         [ Right [Chunk "Hello ", Expr (Call "guest" [])]
-            @=? parseTemplateElemsFile "" "Hello $guest()$"
+            @=? parse "Hello $guest()$"
         , Right [If (Call "a" [StringLiteral "bar"]) [Chunk "foo"] Nothing]
-            @=? parseTemplateElemsFile "" "$if(a(\"bar\"))$foo$endif$"
+            @=? parse "$if(a(\"bar\"))$foo$endif$"
         -- 'If' trim check.
         , Right [ TrimL
           , If (Ident (TemplateKey "body"))
@@ -56,7 +56,7 @@ tests = testGroup "Hakyll.Core.Template.Tests" $ concat
                      ])
           , TrimR
           ]
-          @=? parseTemplateElemsFile "" "$-if(body)-$\n$body$\n$-else-$\n$body$\n$-endif-$"
+          @=? parse "$-if(body)-$\n$body$\n$-else-$\n$body$\n$-endif-$"
         -- 'For' trim check.
         , Right [ TrimL
           , For (Ident (TemplateKey "authors"))
@@ -64,27 +64,29 @@ tests = testGroup "Hakyll.Core.Template.Tests" $ concat
                 Nothing
           , TrimR
           ]
-          @=? parseTemplateElemsFile "" "$-for(authors)-$\n   body   \n$-endfor-$"
+          @=? parse "$-for(authors)-$\n   body   \n$-endfor-$"
         -- 'Partial' trim check.
         , Right [ TrimL
           , Partial (StringLiteral "path")
           , TrimR
           ]
-          @=? parseTemplateElemsFile "" "$-partial(\"path\")-$"
+          @=? parse "$-partial(\"path\")-$"
         -- 'Expr' trim check.
         , Right [ TrimL
           , Expr (Ident (TemplateKey "foo"))
           , TrimR
           ]
-          @=? parseTemplateElemsFile "" "$-foo-$"
+          @=? parse "$-foo-$"
         -- fail on incomplete template.
         , assertBool "did not yield error" $ isLeft $
-          parseTemplateElemsFile "" "a$b"
+          parse "a$b"
         -- fail on mismatched template syntax.
         , assertBool "did not fail to parse" $ isLeft $
-          parseTemplateElemsFile "" "$for(xs)$\n  <p>foo</p>\n$endif$"
+          parse "$for(xs)$\n  <p>foo</p>\n$endif$"
         ]
     ]
+  where
+    parse = parseTemplateElemsFile ""
 
 
 --------------------------------------------------------------------------------

From 2f6ef3aa74b59ca35e4eab538e9e23c5ab442b8d Mon Sep 17 00:00:00 2001
From: Bergi <a.d.bergi@web.de>
Date: Thu, 15 Mar 2018 01:50:22 +0100
Subject: [PATCH 11/19] Added useful exports and improved documenttion

---
 lib/Hakyll/Core/Compiler.hs          | 28 ++++++++-
 lib/Hakyll/Core/Compiler/Internal.hs | 89 +++++++++++++++++++---------
 lib/Hakyll/Core/Compiler/Require.hs  |  2 +
 lib/Hakyll/Web/Template/Context.hs   | 31 ++++++----
 lib/Hakyll/Web/Template/Internal.hs  | 10 ++--
 5 files changed, 113 insertions(+), 47 deletions(-)

diff --git a/lib/Hakyll/Core/Compiler.hs b/lib/Hakyll/Core/Compiler.hs
index 80f93cb0f..0e67b6b69 100644
--- a/lib/Hakyll/Core/Compiler.hs
+++ b/lib/Hakyll/Core/Compiler.hs
@@ -24,11 +24,13 @@ module Hakyll.Core.Compiler
     , cached
     , unsafeCompiler
     , debugCompiler
+    , failBranch
+    , mapError
     ) where
 
 
 --------------------------------------------------------------------------------
-import           Control.Monad                 (when, unless)
+import           Control.Monad                 (when, unless, (>=>))
 import           Data.Binary                   (Binary)
 import           Data.ByteString.Lazy          (ByteString)
 import           Data.Typeable                 (Typeable)
@@ -182,12 +184,34 @@ cached name compiler = do
 
 
 --------------------------------------------------------------------------------
+-- | Run an IO computation without dependencies in a Compiler
 unsafeCompiler :: IO a -> Compiler a
 unsafeCompiler = compilerUnsafeIO
 
 
 --------------------------------------------------------------------------------
--- | Compiler for debugging purposes
+-- | Fail so that it is treated as non-defined in an @\$if()\$@ branching
+-- "Hakyll.Web.Template" macro, and alternative
+-- 'Hakyll.Web.Template.Context.Context's are tried
+-- 
+-- @since 4.12.0
+failBranch :: String -> Compiler a
+failBranch = compilerFailBranch . return
+
+
+--------------------------------------------------------------------------------
+-- | Map over the error list from a failed compilation.
+-- Unlike @'`Control.Monad.Except.catchError`' ('Control.Monad.Except.throwError' . f)@,
+-- it keeps the distinction between 'fail' and 'failBranch'.
+-- 
+-- @since 4.12.0
+mapError :: ([String] -> [String]) -> Compiler a -> Compiler a
+mapError f = compilerTry >=> either (compilerResult . CompilerError . fmap f) return
+
+
+--------------------------------------------------------------------------------
+-- | Compiler for debugging purposes.
+-- Passes a message to the debug logger that is printed in verbose mode.
 debugCompiler :: String -> Compiler ()
 debugCompiler msg = do
     logger <- compilerLogger <$> compilerAsk
diff --git a/lib/Hakyll/Core/Compiler/Internal.hs b/lib/Hakyll/Core/Compiler/Internal.hs
index 71fffd6da..7c1fa53dc 100644
--- a/lib/Hakyll/Core/Compiler/Internal.hs
+++ b/lib/Hakyll/Core/Compiler/Internal.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GADTs                      #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveFunctor              #-}
 {-# LANGUAGE MultiParamTypeClasses      #-}
 module Hakyll.Core.Compiler.Internal
     ( -- * Types
@@ -15,18 +16,20 @@ module Hakyll.Core.Compiler.Internal
     , runCompiler
 
       -- * Core operations
+    , compilerResult
     , compilerTell
     , compilerAsk
+    , compilerUnsafeIO
+
+      -- * Error operations
     , compilerThrow
-    , compilerNoResult
-    , compilerTry
+    , compilerFailBranch
     , compilerCatch
-    , compilerResult
-    , compilerUnsafeIO
-    , compilerDebugLog
+    , compilerTry
+    , getReason
 
       -- * Utilities
-    , getReason
+    , compilerDebugEntries
     , compilerTellDependencies
     , compilerTellCacheHits
     ) where
@@ -94,11 +97,13 @@ instance Monoid CompilerWrite where
 
 
 --------------------------------------------------------------------------------
+-- | Distinguishes reasons in a 'CompilerError'
 data Reason a
     -- | An exception occured during compilation
     = CompilationFailure a
     -- | Absence of any result, most notably in template contexts
     | NoCompilationResult a
+    deriving Functor
 
 
 -- | Unwrap a `Reason`
@@ -108,6 +113,7 @@ getReason (NoCompilationResult x) = x
 
 
 --------------------------------------------------------------------------------
+-- | An intermediate result of a compilation step
 data CompilerResult a
     = CompilerDone a CompilerWrite
     | CompilerSnapshot Snapshot (Compiler a)
@@ -137,7 +143,7 @@ instance Functor Compiler where
 
 --------------------------------------------------------------------------------
 instance Monad Compiler where
-    return x = Compiler $ \_ -> return $ CompilerDone x mempty
+    return x = compilerResult $ CompilerDone x mempty
     {-# INLINE return #-}
 
     Compiler c >>= f = Compiler $ \r -> do
@@ -174,18 +180,22 @@ instance Applicative Compiler where
 
 
 --------------------------------------------------------------------------------
+-- | Access provided metadata from anywhere
 instance MonadMetadata Compiler where
     getMetadata = compilerGetMetadata
     getMatches  = compilerGetMatches
 
 
 --------------------------------------------------------------------------------
+-- | Compilation may fail with multiple error messages.
+-- 'catchError' handles errors from 'throwError', 'fail' and 'Hakyll.Core.Compiler.failBranch'
 instance MonadError [String] Compiler where
-  throwError = compilerThrow
-  catchError c = compilerCatch c . (. getReason)
+    throwError = compilerThrow
+    catchError c = compilerCatch c . (. getReason)
 
 
 --------------------------------------------------------------------------------
+-- | Like 'unCompiler' but treating IO exceptions as 'CompilerError's
 runCompiler :: Compiler a -> CompilerRead -> IO (CompilerResult a)
 runCompiler compiler read' = handle handler $ unCompiler compiler read'
   where
@@ -194,52 +204,68 @@ runCompiler compiler read' = handle handler $ unCompiler compiler read'
 
 
 --------------------------------------------------------------------------------
+-- | Trying alternative compilers if the first fails, regardless whether through
+-- 'fail', 'throwError' or 'Hakyll.Core.Compiler.failBranch'.
+-- Aggregates error messages if all fail.
 instance Alternative Compiler where
-    empty   = compilerMissing []
+    empty   = compilerFailBranch []
     x <|> y = x `compilerCatch` (\rx -> y `compilerCatch` (\ry ->
         case (rx, ry) of
           (CompilationFailure xs,  CompilationFailure ys)  -> compilerThrow $ xs ++ ys
           (CompilationFailure xs,  NoCompilationResult ys) -> debug ys >> compilerThrow xs
           (NoCompilationResult xs, CompilationFailure ys)  -> debug xs >> compilerThrow ys
-          (NoCompilationResult xs, NoCompilationResult ys) -> compilerMissing $ xs ++ ys
+          (NoCompilationResult xs, NoCompilationResult ys) -> compilerFailBranch $ xs ++ ys
         ))
       where
-        debug = compilerDebugLog . map
-            ("Hakyll.Core.Compiler.Internal: Alternative fail suppressed: " ++)
+        debug = compilerDebugEntries "Hakyll.Core.Compiler.Internal: Alternative fail suppressed"
     {-# INLINE (<|>) #-}
 
 
 --------------------------------------------------------------------------------
+-- | Put the result back in a compiler
+compilerResult :: CompilerResult a -> Compiler a
+compilerResult x = Compiler $ \_ -> return x
+{-# INLINE compilerResult #-}
+
+
+--------------------------------------------------------------------------------
+-- | Get the current environment
 compilerAsk :: Compiler CompilerRead
 compilerAsk = Compiler $ \r -> return $ CompilerDone r mempty
 {-# INLINE compilerAsk #-}
 
 
 --------------------------------------------------------------------------------
+-- | Put a 'CompilerWrite'
 compilerTell :: CompilerWrite -> Compiler ()
 compilerTell = compilerResult . CompilerDone ()
 {-# INLINE compilerTell #-}
 
 
 --------------------------------------------------------------------------------
--- | Put the result back in a compiler
-compilerResult :: CompilerResult a -> Compiler a
-compilerResult x = Compiler $ \_ -> return x
-{-# INLINE compilerResult #-}
+-- | Run an IO computation without dependencies in a Compiler
+compilerUnsafeIO :: IO a -> Compiler a
+compilerUnsafeIO io = Compiler $ \_ -> do
+    x <- io
+    return $ CompilerDone x mempty
+{-# INLINE compilerUnsafeIO #-}
 
 
 --------------------------------------------------------------------------------
+-- | Put a 'CompilerError' with  multiple error messages as 'CompilationFailure'
 compilerThrow :: [String] -> Compiler a
 compilerThrow = compilerResult . CompilerError . CompilationFailure
 
-compilerMissing :: [String] -> Compiler a
-compilerMissing = compilerResult . CompilerError . NoCompilationResult
 
-compilerNoResult :: String -> Compiler a
-compilerNoResult = compilerMissing . return
+-- | Put a 'CompilerError' with  multiple messages as 'NoCompilationResult'
+compilerFailBranch :: [String] -> Compiler a
+compilerFailBranch = compilerResult . CompilerError . NoCompilationResult
 
 
 --------------------------------------------------------------------------------
+-- | Allows to distinguish 'CompilerError's and branch on them with 'Either'
+-- 
+-- prop> compilerTry = (`compilerCatch` return . Left) . fmap Right
 compilerTry :: Compiler a -> Compiler (Either (Reason [String]) a)
 compilerTry (Compiler x) = Compiler $ \r -> do
     res <- x r
@@ -250,8 +276,12 @@ compilerTry (Compiler x) = Compiler $ \r -> do
         CompilerError e      -> return (CompilerDone (Left e) mempty)
 {-# INLINE compilerTry #-}
 
+
 --------------------------------------------------------------------------------
--- compilerCatch f = compilerTry >=> either f return
+-- | Allows you to recover from 'CompilerError's.
+-- Uses the same parameter order as 'catchError' so that it can be used infix.
+-- 
+-- prop> c `compilerCatch` f = compilerTry c >>= either f return
 compilerCatch :: Compiler a -> (Reason [String] -> Compiler a) -> Compiler a
 compilerCatch (Compiler x) f = Compiler $ \r -> do
     res <- x r
@@ -263,19 +293,20 @@ compilerCatch (Compiler x) f = Compiler $ \r -> do
 {-# INLINE compilerCatch #-}
 
 
---------------------------------------------------------------------------------
-compilerUnsafeIO :: IO a -> Compiler a
-compilerUnsafeIO io = Compiler $ \_ -> do
-    x <- io
-    return $ CompilerDone x mempty
-{-# INLINE compilerUnsafeIO #-}
-
 --------------------------------------------------------------------------------
 compilerDebugLog :: [String] -> Compiler ()
 compilerDebugLog ms = do
   logger <- compilerLogger <$> compilerAsk
   compilerUnsafeIO $ forM_ ms $ Logger.debug logger
 
+--------------------------------------------------------------------------------
+-- | Pass a list of messages with a heading to the debug logger
+compilerDebugEntries :: String -> [String] -> Compiler ()
+compilerDebugEntries msg = compilerDebugLog . (msg:) . map indent
+  where
+    indent = unlines . map ("    "++) . lines
+
+
 --------------------------------------------------------------------------------
 compilerTellDependencies :: [Dependency] -> Compiler ()
 compilerTellDependencies ds = do
diff --git a/lib/Hakyll/Core/Compiler/Require.hs b/lib/Hakyll/Core/Compiler/Require.hs
index c9373bf79..6222eb8a1 100644
--- a/lib/Hakyll/Core/Compiler/Require.hs
+++ b/lib/Hakyll/Core/Compiler/Require.hs
@@ -91,6 +91,7 @@ loadBody id' = loadSnapshotBody id' final
 
 
 --------------------------------------------------------------------------------
+-- | A shortcut for only requiring the body for a specific snapshot of an item
 loadSnapshotBody :: (Binary a, Typeable a)
                  => Identifier -> Snapshot -> Compiler a
 loadSnapshotBody id' snapshot = fmap itemBody $ loadSnapshot id' snapshot
@@ -103,6 +104,7 @@ loadAll pattern = loadAllSnapshots pattern final
 
 
 --------------------------------------------------------------------------------
+-- | Load a specific snapshot for each of dynamic list of items
 loadAllSnapshots :: (Binary a, Typeable a)
                  => Pattern -> Snapshot -> Compiler [Item a]
 loadAllSnapshots pattern snapshot = do
diff --git a/lib/Hakyll/Web/Template/Context.hs b/lib/Hakyll/Web/Template/Context.hs
index 0e190ec80..1044a6d48 100644
--- a/lib/Hakyll/Web/Template/Context.hs
+++ b/lib/Hakyll/Web/Template/Context.hs
@@ -17,6 +17,7 @@
 -- 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 #-}
@@ -99,6 +100,8 @@ newtype Context a = Context
 
 
 --------------------------------------------------------------------------------
+-- | Tries to find a key in the left context,
+-- or when that fails in the right context.
 instance Monoid (Context a) where
     mempty                          = missingField
     mappend (Context f) (Context g) = Context $ \k a i -> f k a i <|> g k a i
@@ -109,15 +112,19 @@ field' :: String -> (Item a -> Compiler ContextField) -> Context a
 field' key value = Context $ \k _ i ->
     if k == key
         then value i
-        else compilerNoResult $ "Tried field " ++ key
+        else failBranch $ "Tried field " ++ key
 
 
 --------------------------------------------------------------------------------
 -- | 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 returns 'empty', the field will be considered non-existent.
--- If the compiler throws an error ('fail'), the template breaks.
+-- 
+-- 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 'failBranch' 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
@@ -128,13 +135,14 @@ 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 return EmptyField
-    else compilerNoResult $ "Field " ++ name ++ " is false")
+    else failBranch $ "Field " ++ name ++ " is false")
 
 
 --------------------------------------------------------------------------------
@@ -173,7 +181,7 @@ functionField :: String                                  -- ^ Key
 functionField name value = Context $ \k args i ->
     if k == name
         then StringField <$> value args i
-        else compilerNoResult $ "Tried function field " ++ name
+        else failBranch $ "Tried function field " ++ name
 
 
 --------------------------------------------------------------------------------
@@ -211,9 +219,8 @@ snippetField :: Context String
 snippetField = functionField "snippet" f
   where
     f [contentsPath] _ = loadBody (fromFilePath contentsPath)
-    f _              i = fail $
-        "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)
@@ -252,7 +259,7 @@ bodyField key = field key $ return . itemBody
 metadataField :: Context a
 metadataField = Context $ \k _ i -> do
     let id = itemIdentifier i
-        empty' = compilerNoResult $ "No '" ++ k ++ "' field in metadata " ++
+        empty' = failBranch $ "No '" ++ k ++ "' field in metadata " ++
             "of item " ++ show id
     value <- getMetadataField id k
     maybe empty' (return . StringField) value
@@ -379,7 +386,7 @@ getItemModificationTime identifier = do
 
 
 --------------------------------------------------------------------------------
--- Creates a field with the last modification date of the underlying item.
+-- | Creates a field with the last modification date of the underlying item.
 modificationTimeField :: String     -- ^ Key
                       -> String     -- ^ Format
                       -> Context  a -- ^ Resuting context
@@ -387,7 +394,7 @@ modificationTimeField = modificationTimeFieldWith defaultTimeLocale
 
 
 --------------------------------------------------------------------------------
--- Creates a field with the last modification date of the underlying item
+-- | 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
@@ -430,7 +437,7 @@ 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 _ _ -> compilerNoResult $
+missingField = Context $ \k _ _ -> failBranch $
     "Missing field '" ++ k ++ "' in context"
 
 parseTimeM :: Bool -> TimeLocale -> String -> String -> Maybe UTCTime
diff --git a/lib/Hakyll/Web/Template/Internal.hs b/lib/Hakyll/Web/Template/Internal.hs
index c0037eeb4..0e7e85c30 100644
--- a/lib/Hakyll/Web/Template/Internal.hs
+++ b/lib/Hakyll/Web/Template/Internal.hs
@@ -149,7 +149,9 @@ applyTemplate' tes name context x = go tes `catchError` handler
 
     applyElem (Chunk c) = return c
 
-    applyElem (Expr e) = applyExpr e >>= getString e
+    applyElem (Expr e) = mapError (msg:) $ applyExpr e >>= getString e
+      where
+        msg = "In expr '$" ++ show e ++ "$'"
 
     applyElem Escaped = return "$"
 
@@ -159,9 +161,8 @@ applyTemplate' tes name context x = go tes `catchError` handler
         handle (Right _)                      = go t
         handle (Left (NoCompilationResult _)) = f
         handle (Left (CompilationFailure es)) = debug es >> f
-        debug es = compilerDebugLog (map (\err ->
-            "Hakyll.Web.Template.applyTemplate: [ERROR] in 'if' condition " ++
-            "for expr " ++ show e ++ ": " ++ err) es)
+        debug = compilerDebugEntries ("Hakyll.Web.Template.applyTemplate: " ++
+            "[ERROR] in 'if' condition for expr '" ++ show e ++ "':")
 
     applyElem (For e b s) = applyExpr e >>= \cf -> case cf of
         EmptyField     -> expected "ListField" "boolField" e
@@ -239,3 +240,4 @@ unsafeReadTemplateFile :: FilePath -> Compiler Template
 unsafeReadTemplateFile file = do
     tpl <- unsafeCompiler $ readFile file
     compileTemplateFile (fromFilePath file) tpl
+{-# DEPRECATED unsafeReadTemplateFile "Use templateCompiler" #-}

From e523fb7f6f17747564fec74b789e620bcd17bfd1 Mon Sep 17 00:00:00 2001
From: Bergi <a.d.bergi@web.de>
Date: Mon, 26 Mar 2018 00:53:35 +0200
Subject: [PATCH 12/19] better error messages for file system operations

---
 lib/Hakyll/Core/Provider/Metadata.hs |  5 ++--
 lib/Hakyll/Core/Store.hs             | 40 ++++++++++++++--------------
 2 files changed, 23 insertions(+), 22 deletions(-)

diff --git a/lib/Hakyll/Core/Provider/Metadata.hs b/lib/Hakyll/Core/Provider/Metadata.hs
index 6285ce17b..c74627b6e 100644
--- a/lib/Hakyll/Core/Provider/Metadata.hs
+++ b/lib/Hakyll/Core/Provider/Metadata.hs
@@ -27,6 +27,7 @@ import           Hakyll.Core.Identifier
 import           Hakyll.Core.Metadata
 import           Hakyll.Core.Provider.Internal
 import           System.IO                     as IO
+import           System.IO.Error               (modifyIOError, ioeSetLocation)
 
 
 --------------------------------------------------------------------------------
@@ -51,7 +52,7 @@ loadMetadata p identifier = do
 --------------------------------------------------------------------------------
 loadMetadataHeader :: FilePath -> IO (Metadata, String)
 loadMetadataHeader fp = do
-    fileContent <- readFile fp
+    fileContent <- modifyIOError (`ioeSetLocation` "loadMetadataHeader") $ readFile fp
     case parsePage fileContent of
         Right x   -> return x
         Left  err -> throwIO $ MetadataException fp err
@@ -60,7 +61,7 @@ loadMetadataHeader fp = do
 --------------------------------------------------------------------------------
 loadMetadataFile :: FilePath -> IO Metadata
 loadMetadataFile fp = do
-    fileContent <- B.readFile fp
+    fileContent <- modifyIOError (`ioeSetLocation` "loadMetadataFile") $ B.readFile fp
     let errOrMeta = Yaml.decodeEither' fileContent
     either (fail . show) return errOrMeta
 
diff --git a/lib/Hakyll/Core/Store.hs b/lib/Hakyll/Core/Store.hs
index fdbcf11f7..23299db5e 100644
--- a/lib/Hakyll/Core/Store.hs
+++ b/lib/Hakyll/Core/Store.hs
@@ -16,7 +16,6 @@ module Hakyll.Core.Store
 
 
 --------------------------------------------------------------------------------
-import           Control.Exception    (IOException, handle)
 import qualified Crypto.Hash.MD5      as MD5
 import           Data.Binary          (Binary, decode, encodeFile)
 import qualified Data.ByteString      as B
@@ -31,6 +30,8 @@ import           System.Directory     (createDirectoryIfMissing)
 import           System.Directory     (doesFileExist, removeFile)
 import           System.FilePath      ((</>))
 import           System.IO            (IOMode (..), hClose, openFile)
+import           System.IO.Error      (catchIOError, modifyIOError,
+                                       ioeSetFileName, ioeSetLocation)
 import           Text.Printf          (printf)
 
 
@@ -84,6 +85,14 @@ new inMemory directory = do
   where
     csize = Just 500
 
+--------------------------------------------------------------------------------
+withStore :: Store -> String -> (String -> FilePath -> IO a) -> [String] -> IO a
+withStore store loc run identifier = modifyIOError handle $ run key path
+  where
+    key = hash identifier
+    path = storeDirectory store </> key
+    handle e = e `ioeSetFileName` (path ++ " for " ++ intercalate "/" identifier)
+                 `ioeSetLocation` ("Store." ++ loc)
 
 --------------------------------------------------------------------------------
 -- | Auxiliary: add an item to the in-memory cache
@@ -124,17 +133,16 @@ cacheDelete (Store _ (Just lru)) key = do
 --------------------------------------------------------------------------------
 -- | Store an item
 set :: (Binary a, Typeable a) => Store -> [String] -> a -> IO ()
-set store identifier value = do
-    encodeFile (storeDirectory store </> key) value
+set store identifier value = withStore store "set" (\key path -> do
+    encodeFile path value
     cacheInsert store key value
-  where
-    key = hash identifier
+  ) identifier
 
 
 --------------------------------------------------------------------------------
 -- | Load an item
 get :: (Binary a, Typeable a) => Store -> [String] -> IO (Result a)
-get store identifier = do
+get store = withStore store "get" $ \key path -> do
     -- First check the in-memory map
     ref <- cacheLookup store key
     case ref of
@@ -146,17 +154,14 @@ get store identifier = do
                 then return NotFound
                 -- Found in the filesystem
                 else do
-                    v <- decodeClose
+                    v <- decodeClose path
                     cacheInsert store key v
                     return $ Found v
         -- Found in the in-memory map (or wrong type), just return
         s -> return s
   where
-    key  = hash identifier
-    path = storeDirectory store </> key
-
     -- 'decodeFile' from Data.Binary which closes the file ASAP
-    decodeClose = do
+    decodeClose path = do
         h   <- openFile path ReadMode
         lbs <- BL.hGetContents h
         BL.length lbs `seq` hClose h
@@ -166,28 +171,23 @@ get store identifier = do
 --------------------------------------------------------------------------------
 -- | Strict function
 isMember :: Store -> [String] -> IO Bool
-isMember store identifier = do
+isMember store = withStore store "isMember" $ \key path -> do
     inCache <- cacheIsMember store key
     if inCache then return True else doesFileExist path
-  where
-    key  = hash identifier
-    path = storeDirectory store </> key
 
 
 --------------------------------------------------------------------------------
 -- | Delete an item
 delete :: Store -> [String] -> IO ()
-delete store identifier = do
+delete store = withStore store "delete" $ \key path -> do
     cacheDelete store key
-    deleteFile $ storeDirectory store </> key
-  where
-    key  = hash identifier
+    deleteFile path
 
 
 --------------------------------------------------------------------------------
 -- | Delete a file unless it doesn't exist...
 deleteFile :: FilePath -> IO ()
-deleteFile = handle (\(_ :: IOException) -> return ()) . removeFile
+deleteFile = (`catchIOError` \_ -> return ()) . removeFile
 
 
 --------------------------------------------------------------------------------

From f6af7d4f71a6df74e7d6f3925932514ce1044a98 Mon Sep 17 00:00:00 2001
From: Bergi <a.d.bergi@web.de>
Date: Mon, 19 Mar 2018 23:43:55 +0100
Subject: [PATCH 13/19] more precise error messages for template application

---
 lib/Hakyll/Web/Template/Context.hs  |  2 +-
 lib/Hakyll/Web/Template/Internal.hs | 72 +++++++++++++++++------------
 2 files changed, 44 insertions(+), 30 deletions(-)

diff --git a/lib/Hakyll/Web/Template/Context.hs b/lib/Hakyll/Web/Template/Context.hs
index 1fde0c405..e92a7bf87 100644
--- a/lib/Hakyll/Web/Template/Context.hs
+++ b/lib/Hakyll/Web/Template/Context.hs
@@ -212,7 +212,7 @@ mapContext f (Context c) = Context $ \k a i -> do
     case fld of
         EmptyField      -> wrongType "boolField"
         StringField str -> return $ StringField (f str)
-        ListField _ _   -> wrongType "ListField"
+        _               -> wrongType "ListField"
   where
     wrongType typ = fail $ "Hakyll.Web.Template.Context.mapContext: " ++
         "can't map over a " ++ typ ++ "!"
diff --git a/lib/Hakyll/Web/Template/Internal.hs b/lib/Hakyll/Web/Template/Internal.hs
index 0e7e85c30..2d2133ca1 100644
--- a/lib/Hakyll/Web/Template/Internal.hs
+++ b/lib/Hakyll/Web/Template/Internal.hs
@@ -113,30 +113,31 @@ applyTemplate :: Template                -- ^ Template
               -> Item a                  -- ^ Page
               -> Compiler (Item String)  -- ^ Resulting item
 applyTemplate tpl context item = do
-    body <- applyTemplate' (unTemplate tpl) (getOrigin tpl) context item
+    body <- applyTemplate' (unTemplate tpl) context item `catchError` handler
     return $ itemSetBody body item
+  where
+    tplName = getOrigin 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
+
 
 
 --------------------------------------------------------------------------------
 applyTemplate'
     :: forall a.
        [TemplateElement] -- ^ Unwrapped Template
-    -> FilePath          -- ^ template name
     -> Context a         -- ^ Context
     -> Item a            -- ^ Page
     -> Compiler String   -- ^ Resulting item
-applyTemplate' tes name context x = go tes `catchError` handler
+applyTemplate' tes context x = go tes
   where
     context' :: String -> [String] -> Item a -> Compiler ContextField
     context' = unContext (context `mappend` missingField)
 
-    itemName = show $ itemIdentifier x
-    handler es = fail $ "Hakyll.Web.Template.applyTemplate: Failed to " ++
-        (if name == itemName
-          then "interpolate template in item " ++ name
-          else "apply template " ++ name ++ " to item " ++ itemName) ++
-        ":\n" ++ intercalate ",\n" es
-
     go = fmap concat . mapM applyElem
 
     ---------------------------------------------------------------------------
@@ -149,9 +150,10 @@ applyTemplate' tes name context x = go tes `catchError` handler
 
     applyElem (Chunk c) = return c
 
-    applyElem (Expr e) = mapError (msg:) $ applyExpr e >>= getString e
+    applyElem (Expr e) = applyStringExpr (evalMsg:) typeMsg e
       where
-        msg = "In expr '$" ++ show e ++ "$'"
+        evalMsg = "In expr '$" ++ show e ++ "$'"
+        typeMsg = "expr '$" ++ show e ++ "$'"
 
     applyElem Escaped = return "$"
 
@@ -162,20 +164,28 @@ applyTemplate' tes name context x = go tes `catchError` handler
         handle (Left (NoCompilationResult _)) = f
         handle (Left (CompilationFailure es)) = debug es >> f
         debug = compilerDebugEntries ("Hakyll.Web.Template.applyTemplate: " ++
-            "[ERROR] in 'if' condition for expr '" ++ show e ++ "':")
+            "[ERROR] in 'if' condition on expr '" ++ show e ++ "':")
 
-    applyElem (For e b s) = applyExpr e >>= \cf -> case cf of
-        EmptyField     -> expected "ListField" "boolField" e
-        StringField _  -> expected "ListField" "StringField" e
-        ListField c xs -> do
+    applyElem (For e b s) = mapError (headMsg:) (applyExpr e) >>= \cf -> case cf of
+        EmptyField     -> expected "list" "boolean" typeMsg
+        StringField _  -> expected "list" "string" typeMsg
+        ListField c xs -> mapError (bodyMsg:) $ do
             sep <- maybe (return "") go s
-            bs  <- mapM (applyTemplate' b name c) xs
+            bs  <- mapM (applyTemplate' b c) xs
             return $ intercalate sep bs
-
-    applyElem (Partial e) = do
-        p    <- applyExpr e >>= getString e
-        tpl' <- loadBody (fromFilePath p)
-        applyTemplate' (unTemplate tpl') (getOrigin 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) = applyStringExpr (headMsg:) typeMsg e >>= \p ->
+        mapError (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 ++ ")$'"
 
     ---------------------------------------------------------------------------
 
@@ -184,19 +194,23 @@ applyTemplate' tes name context x = go tes `catchError` handler
     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 id (typeMsg e) e) args
         context' k args' x
+      where
+        typeMsg e = "argument '" ++ show e ++ "'"
 
     applyExpr (StringLiteral s) = return (StringField s)
 
     ----------------------------------------------------------------------------
 
-    getString e EmptyField      = expected "StringField" "boolField" e
-    getString _ (StringField s) = return s
-    getString e (ListField _ _) = expected "StringField" "ListField" e
+    applyStringExpr wrap msg expr = mapError wrap (applyExpr expr) >>= getString
+      where
+        getString EmptyField      = expected "string" "boolean" msg
+        getString (StringField s) = return s
+        getString (ListField _ _) = expected "string" "list" msg
 
-    expected typ act e = fail $ unwords ["Hakyll.Web.Template.applyTemplate:",
-        "expected", typ, "but got", act, "for expr", show e]
+    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 $

From e263ccf01a87ac2b13bd2f1209f9f143d2701c76 Mon Sep 17 00:00:00 2001
From: Bergi <a.d.bergi@web.de>
Date: Mon, 9 Apr 2018 21:17:22 +0200
Subject: [PATCH 14/19] fix documentation syntax

---
 lib/Hakyll/Core/Compiler.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/lib/Hakyll/Core/Compiler.hs b/lib/Hakyll/Core/Compiler.hs
index 0e67b6b69..b7e15e799 100644
--- a/lib/Hakyll/Core/Compiler.hs
+++ b/lib/Hakyll/Core/Compiler.hs
@@ -201,7 +201,7 @@ failBranch = compilerFailBranch . return
 
 --------------------------------------------------------------------------------
 -- | Map over the error list from a failed compilation.
--- Unlike @'`Control.Monad.Except.catchError`' ('Control.Monad.Except.throwError' . f)@,
+-- Unlike @\``Control.Monad.Except.catchError`\` ('Control.Monad.Except.throwError' . f)@,
 -- it keeps the distinction between 'fail' and 'failBranch'.
 -- 
 -- @since 4.12.0

From 394cb08240d4db423427ac42902f49610b678546 Mon Sep 17 00:00:00 2001
From: Bergi <a.d.bergi@web.de>
Date: Tue, 13 Mar 2018 03:01:04 +0100
Subject: [PATCH 15/19] WIP

---
 lib/Hakyll/Web/Template/Context.hs | 57 ++++++++++++++++++++++--------
 1 file changed, 42 insertions(+), 15 deletions(-)

diff --git a/lib/Hakyll/Web/Template/Context.hs b/lib/Hakyll/Web/Template/Context.hs
index e92a7bf87..2085f2575 100644
--- a/lib/Hakyll/Web/Template/Context.hs
+++ b/lib/Hakyll/Web/Template/Context.hs
@@ -21,9 +21,13 @@
 --------------------------------------------------------------------------------
 {-# LANGUAGE CPP                       #-}
 {-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleInstances #-}
 module Hakyll.Web.Template.Context
     ( ContextField (..)
     , Context (..)
+    , context
+    , functionContext
+    , toContextField
     , field
     , boolField
     , constField
@@ -120,11 +124,39 @@ instance Monoid (Context a) where
 
 
 --------------------------------------------------------------------------------
-field' :: String -> (Item a -> Compiler ContextField) -> Context a
-field' key value = Context $ \k _ i ->
+class ToContextField a where
+    toContextField :: a -> Compiler ContextField
+
+instance ToContextField ContextField where
+    toContextField = return
+
+instance ToContextField a => ToContextField (Compiler a) where
+    toContextField = (>>= toContextField)
+
+instance ToContextField [Char] where
+    toContextField = return . StringField
+
+instance ToContextField Bool where
+    toContextField True  = return EmptyField
+    toContextField False = failBranch "False"
+
+instance ToContextField a => ToContextField (Maybe a) where
+    toContextField = maybe (failBranch "False") toContextField
+
+
+--------------------------------------------------------------------------------
+functionContext :: ToContextField c => String -> ([String] -> Item a -> c) -> Context a
+functionContext key value = Context $ \k args item ->
     if k == key
-        then value i
+        then mapError details $ toContextField $ value args item
         else failBranch $ "Tried field " ++ key
+  where
+    details []        = ["No result at field "++key]
+    details ["False"] = ["Field "++key++" is False"]
+    details errors    = ("In evaluation of field "++key) : errors
+
+context :: ToContextField c => String -> (Item a -> c) -> Context a
+context key = functionContext key . const
 
 
 --------------------------------------------------------------------------------
@@ -142,7 +174,7 @@ field
     -> (Item a -> Compiler String) -- ^ Function that constructs a value based
                                    -- on the item (e.g. accessing metadata)
     -> Context a
-field key value = field' key (fmap StringField . value)
+field = context
 
 
 --------------------------------------------------------------------------------
@@ -152,9 +184,7 @@ boolField
     :: String
     -> (Item a -> Bool)
     -> Context a
-boolField name f = field' name (\i -> if f i
-    then return EmptyField
-    else failBranch $ "Field " ++ name ++ " is false")
+boolField = context
 
 
 --------------------------------------------------------------------------------
@@ -163,7 +193,7 @@ boolField name f = field' name (\i -> if f i
 constField :: String     -- ^ Key
            -> String     -- ^ Value
            -> Context a
-constField key = field key . const . return
+constField key = context key . const
 
 
 --------------------------------------------------------------------------------
@@ -179,7 +209,7 @@ listField key c xs = listFieldWith key c (const xs)
 -- to the compiler.
 listFieldWith
     :: String -> Context a -> (Item b -> Compiler [Item a]) -> Context b
-listFieldWith key c f = field' key $ fmap (ListField c) . f
+listFieldWith key c f = context key $ fmap (ListField c) . f
 
 
 --------------------------------------------------------------------------------
@@ -190,10 +220,7 @@ listFieldWith key c f = field' key $ fmap (ListField c) . f
 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 failBranch $ "Tried function field " ++ name
+functionField = functionContext
 
 
 --------------------------------------------------------------------------------
@@ -263,7 +290,7 @@ teaserSeparator = "<!--more-->"
 --------------------------------------------------------------------------------
 -- | Constructs a 'field' that contains the body of the item.
 bodyField :: String -> Context String
-bodyField key = field key $ return . itemBody
+bodyField key = context key itemBody
 
 
 --------------------------------------------------------------------------------
@@ -289,7 +316,7 @@ urlField key = field key $ \i -> do
 --------------------------------------------------------------------------------
 -- | Filepath of the underlying file of the item
 pathField :: String -> Context a
-pathField key = field key $ return . toFilePath . itemIdentifier
+pathField key = context key $ toFilePath . itemIdentifier
 
 
 --------------------------------------------------------------------------------

From 78207aed80908bd5ffed0c613268f1df89c1fd47 Mon Sep 17 00:00:00 2001
From: Bergi <a.d.bergi@web.de>
Date: Sat, 17 Mar 2018 16:26:22 +0100
Subject: [PATCH 16/19] Do not consider .metadata files to be separate
 resources

but allow resources without a "body", consisting only of their metadata file
(Even if that sounds a bit crazy)
---
 lib/Hakyll/Core/Provider/Internal.hs      | 30 +++++++++++------------
 lib/Hakyll/Core/Provider/Metadata.hs      |  5 ++--
 lib/Hakyll/Core/Provider/MetadataCache.hs |  4 ++-
 3 files changed, 20 insertions(+), 19 deletions(-)

diff --git a/lib/Hakyll/Core/Provider/Internal.hs b/lib/Hakyll/Core/Provider/Internal.hs
index c298653af..a3f78fa7e 100644
--- a/lib/Hakyll/Core/Provider/Internal.hs
+++ b/lib/Hakyll/Core/Provider/Internal.hs
@@ -22,6 +22,7 @@ module Hakyll.Core.Provider.Internal
 --------------------------------------------------------------------------------
 import           Control.DeepSeq        (NFData (..), deepseq)
 import           Control.Monad          (forM)
+import           Control.Applicative    ((<|>))
 import           Data.Binary            (Binary (..))
 import qualified Data.ByteString.Lazy   as BL
 import           Data.Map               (Map)
@@ -32,7 +33,7 @@ import qualified Data.Set               as S
 import           Data.Time              (Day (..), UTCTime (..))
 import           Data.Typeable          (Typeable)
 import           System.Directory       (getModificationTime)
-import           System.FilePath        (addExtension, (</>))
+import           System.FilePath        (stripExtension, (</>))
 
 
 --------------------------------------------------------------------------------
@@ -106,10 +107,7 @@ newProvider :: Store                  -- ^ Store to use
             -> IO Provider            -- ^ Resulting provider
 newProvider store ignore directory = do
     list <- map fromFilePath <$> getRecursiveContents ignore directory
-    let universe = S.fromList list
-    files <- fmap (maxmtime . M.fromList) $ forM list $ \identifier -> do
-        rInfo <- getResourceInfo directory universe identifier
-        return (identifier, rInfo)
+    files <- M.fromListWith combine <$> mapM (getResourceInfo directory) list
 
     -- Get the old files from the store, and then immediately replace them by
     -- the new files.
@@ -120,20 +118,20 @@ newProvider store ignore directory = do
   where
     oldKey = ["Hakyll.Core.Provider.Internal.newProvider", "oldFiles"]
 
-    -- Update modified if metadata is modified
-    maxmtime files = flip M.map files $ \rInfo@(ResourceInfo mtime meta) ->
-        let metaMod = fmap resourceInfoModified $ meta >>= flip M.lookup files
-        in rInfo {resourceInfoModified = maybe mtime (max mtime) metaMod}
+    -- Combine a resource with its metadata file
+    combine (ResourceInfo xTime xMeta) (ResourceInfo yTime yMeta) =
+        ResourceInfo (xTime `max` yTime) (xMeta <|> yMeta)
 
 
 --------------------------------------------------------------------------------
-getResourceInfo :: FilePath -> Set Identifier -> Identifier -> IO ResourceInfo
-getResourceInfo directory universe identifier = do
-    mtime <- fileModificationTime $ directory </> toFilePath identifier
-    return $ ResourceInfo (BinaryTime mtime) $
-        if mdRsc `S.member` universe then Just mdRsc else Nothing
-  where
-    mdRsc = fromFilePath $ flip addExtension "metadata" $ toFilePath identifier
+getResourceInfo :: FilePath -> Identifier -> IO (Identifier, ResourceInfo)
+getResourceInfo directory identifier = do
+    let file = toFilePath identifier
+    mtime <- fileModificationTime $ directory </> file
+    let makeInfo m = ResourceInfo (BinaryTime mtime) m
+    return $ case stripExtension "metadata" file of
+        Nothing -> (identifier, makeInfo Nothing)
+        Just r -> (fromFilePath r, makeInfo (Just identifier))
 
 
 --------------------------------------------------------------------------------
diff --git a/lib/Hakyll/Core/Provider/Metadata.hs b/lib/Hakyll/Core/Provider/Metadata.hs
index c74627b6e..ee4caaa1f 100644
--- a/lib/Hakyll/Core/Provider/Metadata.hs
+++ b/lib/Hakyll/Core/Provider/Metadata.hs
@@ -27,13 +27,14 @@ import           Hakyll.Core.Identifier
 import           Hakyll.Core.Metadata
 import           Hakyll.Core.Provider.Internal
 import           System.IO                     as IO
-import           System.IO.Error               (modifyIOError, ioeSetLocation)
+import           System.IO.Error               (catchIOError, modifyIOError,
+                                                ioeSetLocation)
 
 
 --------------------------------------------------------------------------------
 loadMetadata :: Provider -> Identifier -> IO (Metadata, Maybe String)
 loadMetadata p identifier = do
-    hasHeader  <- probablyHasMetadataHeader fp
+    hasHeader  <- probablyHasMetadataHeader fp `catchIOError` \_ -> return False
     (md, body) <- if hasHeader
         then second Just <$> loadMetadataHeader fp
         else return (mempty, Nothing)
diff --git a/lib/Hakyll/Core/Provider/MetadataCache.hs b/lib/Hakyll/Core/Provider/MetadataCache.hs
index 46dbf3ed1..02f7cac35 100644
--- a/lib/Hakyll/Core/Provider/MetadataCache.hs
+++ b/lib/Hakyll/Core/Provider/MetadataCache.hs
@@ -18,7 +18,9 @@ import qualified Hakyll.Core.Store             as Store
 --------------------------------------------------------------------------------
 resourceMetadata :: Provider -> Identifier -> IO Metadata
 resourceMetadata p r
-    | not (resourceExists p r) = return mempty
+    | not (resourceExists p r) = fail $ unwords [
+        "Hakyll.Core.Provider.MetadataCache.resourceMetadata:",
+        "cannot read metadata,", show r, "does not exist"]
     | otherwise                = do
         -- TODO keep time in md cache
         load p r

From 87602fa49dc3938f28ae6e2120a1f053f359e877 Mon Sep 17 00:00:00 2001
From: Bergi <a.d.bergi@web.de>
Date: Sat, 17 Mar 2018 16:46:44 +0100
Subject: [PATCH 17/19] WIP

---
 lib/Hakyll/Web/Template/Context.hs | 60 ++++++++++++++++++++++++++++++
 1 file changed, 60 insertions(+)

diff --git a/lib/Hakyll/Web/Template/Context.hs b/lib/Hakyll/Web/Template/Context.hs
index 2085f2575..9ab9f797c 100644
--- a/lib/Hakyll/Web/Template/Context.hs
+++ b/lib/Hakyll/Web/Template/Context.hs
@@ -34,6 +34,7 @@ module Hakyll.Web.Template.Context
     , listField
     , listFieldWith
     , functionField
+    , dataField
     , mapContext
 
     , defaultContext
@@ -58,10 +59,17 @@ module Hakyll.Web.Template.Context
 --------------------------------------------------------------------------------
 import           Control.Applicative           (Alternative (..))
 import           Control.Monad                 (msum)
+import           Data.Char                     (toUpper)
+import           Text.Read                     (readMaybe)
 import           Data.List                     (intercalate)
 #if MIN_VERSION_base(4,9,0)
 import           Data.Semigroup                (Semigroup (..))
 #endif
+import           Data.Yaml                     (Value (..))
+import qualified Data.Text                     as T
+import qualified Data.HashMap.Strict           as H
+import qualified Data.Vector                   as V
+import           Data.Yaml.Extended            (toString)
 import           Data.Time.Clock               (UTCTime (..))
 import           Data.Time.Format              (formatTime)
 import qualified Data.Time.Format              as TF
@@ -261,6 +269,58 @@ snippetField = functionField "snippet" f
     f []             _ = fail "No argument to function 'snippet()'"
     f _              _ = fail "Too many arguments to function 'snippet()'"
 
+
+
+dataField :: String -> Value -> Context a
+dataField key val = Context $ \f a (Item i _) -> case splitAll "\\." f of
+    [k] | k == get    -> lookupNestedValue a  (Item i val)
+    (k:ks) | k == key -> lookupNestedValue ks (Item i val)
+    _                 -> failBranch $ "Tried field " ++ key -- and functionField get
+  where
+    get = let (h:rest) = key in "get" ++ toUpper h : rest
+
+pairContext :: Context (T.Text, Value)
+pairContext = Context $ \k a (Item i (key, value)) -> case splitAll "\\." k of
+    ["get"]      -> lookupNestedValue a    (Item i value)
+    ["key"]      -> return $ StringField $ T.unpack key
+    ("value":ks) -> lookupNestedValue ks   (Item i value)
+    []           -> fail "no supposted to happen" -- , right?
+    keys         -> lookupNestedValue keys (Item i value)
+
+indexContext :: Context (Int, Value)
+indexContext = Context $ \k a (Item i (index, value)) -> case splitAll "\\." k of
+    ["get"]      -> lookupNestedValue a    (Item i value)
+    ["index"]    -> return $ StringField $ show index
+    ("value":ks) -> lookupNestedValue ks   (Item i value)
+    []           -> fail "no supposted to happen" -- , right?
+    keys         -> lookupNestedValue keys (Item i value)
+
+lookupNestedValue :: [String] -> Item Value -> Compiler ContextField
+lookupNestedValue []     (Item i (Object o)) = return $ ListField pairContext $ map (Item i) $ H.toList o
+lookupNestedValue []     (Item i (Array a)) = return $ ListField indexContext $ map (Item i) $ V.toList $ V.indexed a
+lookupNestedValue []     (Item i v) = return $ let Just s = toString v in StringField s
+lookupNestedValue (k:ks) (Item i (Object m)) = case H.lookup (T.pack k) m of
+    Nothing -> failBranch $ "No '"++k++"' property in object" -- ++ debug m
+    Just v  -> lookupNestedValue ks (Item i v)
+lookupNestedValue (k:ks) (Item i (Array v)) = case readMaybe k :: Maybe Int of
+    Nothing -> failBranch $ "No '"++k++"' element in array" -- ++ debug v
+    Just n  -> case v V.!? n of
+        Nothing -> failBranch $ "No '"++k++"' index in array of size " ++ show (length v) -- ++ debug v
+        Just v  -> lookupNestedValue ks (Item i v)
+lookupNestedValue (k:_)  (Item i _) = failBranch $ "no '"++k++"' in primitive value" -- ++ debug p
+
+
+
+
+
+
+
+
+
+
+
+
+
 --------------------------------------------------------------------------------
 -- | A context that contains (in that order)
 --

From f49d972ccae47274d7f8d101237e2a480145ae49 Mon Sep 17 00:00:00 2001
From: Bergi <a.d.bergi@web.de>
Date: Mon, 19 Mar 2018 23:25:30 +0100
Subject: [PATCH 18/19] lexical scoping for list fields

---
 lib/Hakyll/Web/Template/Context.hs  | 64 ++++++++++++++++-------------
 lib/Hakyll/Web/Template/Internal.hs |  5 +++
 2 files changed, 40 insertions(+), 29 deletions(-)

diff --git a/lib/Hakyll/Web/Template/Context.hs b/lib/Hakyll/Web/Template/Context.hs
index 9ab9f797c..d985eafc7 100644
--- a/lib/Hakyll/Web/Template/Context.hs
+++ b/lib/Hakyll/Web/Template/Context.hs
@@ -22,6 +22,8 @@
 {-# LANGUAGE CPP                       #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE RankNTypes #-}
+
 module Hakyll.Web.Template.Context
     ( ContextField (..)
     , Context (..)
@@ -92,7 +94,7 @@ data ContextField
     = EmptyField
     | StringField String
     | forall a. ListField (Context a) [Item a]
-
+    | forall a. LexicalListField (forall b. Context b -> a -> Context b) [a]
 
 --------------------------------------------------------------------------------
 -- | The 'Context' monoid. Please note that the order in which you
@@ -272,42 +274,46 @@ snippetField = functionField "snippet" f
 
 
 dataField :: String -> Value -> Context a
-dataField key val = Context $ \f a (Item i _) -> case splitAll "\\." f of
-    [k] | k == get    -> lookupNestedValue a  (Item i val)
-    (k:ks) | k == key -> lookupNestedValue ks (Item i val)
+dataField key val = Context $ \f a _ -> case splitAll "\\." f of
+    [k] | k == get    -> lookupNestedValue a val
+    (k:ks) | k == key -> lookupNestedValue ks val
     _                 -> failBranch $ "Tried field " ++ key -- and functionField get
   where
     get = let (h:rest) = key in "get" ++ toUpper h : rest
 
-pairContext :: Context (T.Text, Value)
-pairContext = Context $ \k a (Item i (key, value)) -> case splitAll "\\." k of
-    ["get"]      -> lookupNestedValue a    (Item i value)
-    ["key"]      -> return $ StringField $ T.unpack key
-    ("value":ks) -> lookupNestedValue ks   (Item i value)
-    []           -> fail "no supposted to happen" -- , right?
-    keys         -> lookupNestedValue keys (Item i value)
-
-indexContext :: Context (Int, Value)
-indexContext = Context $ \k a (Item i (index, value)) -> case splitAll "\\." k of
-    ["get"]      -> lookupNestedValue a    (Item i value)
-    ["index"]    -> return $ StringField $ show index
-    ("value":ks) -> lookupNestedValue ks   (Item i value)
-    []           -> fail "no supposted to happen" -- , right?
-    keys         -> lookupNestedValue keys (Item i value)
-
-lookupNestedValue :: [String] -> Item Value -> Compiler ContextField
-lookupNestedValue []     (Item i (Object o)) = return $ ListField pairContext $ map (Item i) $ H.toList o
-lookupNestedValue []     (Item i (Array a)) = return $ ListField indexContext $ map (Item i) $ V.toList $ V.indexed a
-lookupNestedValue []     (Item i v) = return $ let Just s = toString v in StringField s
-lookupNestedValue (k:ks) (Item i (Object m)) = case H.lookup (T.pack k) m of
+makePairContext :: Context a -> (T.Text, Value) -> Context a
+makePairContext c (key, value) = pairContext <> c
+  where
+    pairContext = Context $ \k a _ -> case splitAll "\\." k of
+        ["get"]      -> lookupNestedValue a value
+        ["key"]      -> return $ StringField $ T.unpack key
+        ("value":ks) -> lookupNestedValue ks value
+        []           -> fail "no supposted to happen" -- , right?
+        keys         -> lookupNestedValue keys value
+
+makeIndexContext :: Context a -> (Int, Value) -> Context a
+makeIndexContext c (index, value) = indexContext <> c
+  where
+    indexContext = Context $ \k a _ -> case splitAll "\\." k of
+        ["get"]      -> lookupNestedValue a value
+        ["index"]    -> return $ StringField $ show index
+        ("value":ks) -> lookupNestedValue ks value
+        []           -> fail "no supposted to happen" -- , right?
+        keys         -> lookupNestedValue keys value
+
+lookupNestedValue :: [String] -> Value -> Compiler ContextField
+lookupNestedValue []     (Object o) = return $ LexicalListField makePairContext $ H.toList o
+lookupNestedValue []     (Array a)  = return $ LexicalListField makeIndexContext $ V.toList $ V.indexed a
+lookupNestedValue []     v          = return $ let Just s = toString v in StringField s
+lookupNestedValue (k:ks) (Object m) = case H.lookup (T.pack k) m of
     Nothing -> failBranch $ "No '"++k++"' property in object" -- ++ debug m
-    Just v  -> lookupNestedValue ks (Item i v)
-lookupNestedValue (k:ks) (Item i (Array v)) = case readMaybe k :: Maybe Int of
+    Just v  -> lookupNestedValue ks v
+lookupNestedValue (k:ks) (Array v)  = case readMaybe k :: Maybe Int of
     Nothing -> failBranch $ "No '"++k++"' element in array" -- ++ debug v
     Just n  -> case v V.!? n of
         Nothing -> failBranch $ "No '"++k++"' index in array of size " ++ show (length v) -- ++ debug v
-        Just v  -> lookupNestedValue ks (Item i v)
-lookupNestedValue (k:_)  (Item i _) = failBranch $ "no '"++k++"' in primitive value" -- ++ debug p
+        Just v  -> lookupNestedValue ks v
+lookupNestedValue (k:_)  _          = failBranch $ "no '"++k++"' in primitive value" -- ++ debug p
 
 
 
diff --git a/lib/Hakyll/Web/Template/Internal.hs b/lib/Hakyll/Web/Template/Internal.hs
index 2d2133ca1..5f2d3dd11 100644
--- a/lib/Hakyll/Web/Template/Internal.hs
+++ b/lib/Hakyll/Web/Template/Internal.hs
@@ -23,6 +23,7 @@ module Hakyll.Web.Template.Internal
 
 
 --------------------------------------------------------------------------------
+import           Data.Monoid                          ((<>))
 import           Data.Binary                          (Binary)
 import           Data.List                            (intercalate)
 import           Data.Typeable                        (Typeable)
@@ -173,6 +174,10 @@ applyTemplate' tes context x = go tes
             sep <- maybe (return "") go s
             bs  <- mapM (applyTemplate' b c) xs
             return $ intercalate sep bs
+        LexicalListField mc vs -> mapError (bodyMsg:) do
+            sep <- maybe (return "") go s
+            bs  <- mapM (\v -> applyTemplate' b (mc context v) x) vs
+            return $ intercalate sep bs
       where
         headMsg = "In expr '$for(" ++ show e ++ ")$'"
         typeMsg = "loop expr '" ++ show e ++ "'"

From 6663735695e4bf023dd1492a4a86259e42f22c77 Mon Sep 17 00:00:00 2001
From: Bergi <a.d.bergi@web.de>
Date: Sat, 7 Apr 2018 21:29:51 +0200
Subject: [PATCH 19/19] more dry code

---
 lib/Hakyll/Web/Template/Internal.hs | 25 +++++++++++++------------
 1 file changed, 13 insertions(+), 12 deletions(-)

diff --git a/lib/Hakyll/Web/Template/Internal.hs b/lib/Hakyll/Web/Template/Internal.hs
index 5f2d3dd11..0eea92a77 100644
--- a/lib/Hakyll/Web/Template/Internal.hs
+++ b/lib/Hakyll/Web/Template/Internal.hs
@@ -167,23 +167,24 @@ applyTemplate' tes context x = go tes
         debug = compilerDebugEntries ("Hakyll.Web.Template.applyTemplate: " ++
             "[ERROR] in 'if' condition on expr '" ++ show e ++ "':")
 
-    applyElem (For e b s) = mapError (headMsg:) (applyExpr e) >>= \cf -> case cf of
-        EmptyField     -> expected "list" "boolean" typeMsg
-        StringField _  -> expected "list" "string" typeMsg
-        ListField c xs -> mapError (bodyMsg:) $ do
-            sep <- maybe (return "") go s
-            bs  <- mapM (applyTemplate' b c) xs
-            return $ intercalate sep bs
-        LexicalListField mc vs -> mapError (bodyMsg:) do
-            sep <- maybe (return "") go s
-            bs  <- mapM (\v -> applyTemplate' b (mc context v) x) vs
-            return $ intercalate sep bs
+    applyElem (For e b s) = do
+        bs <- mapError (headMsg:) (applyExpr e) >>= getList
+        sep <- maybe (return "") go s
+        return $ intercalate sep bs
       where
+        getList EmptyField               = expected "list" "boolean" typeMsg
+        getList (StringField _)          = expected "list" "string" typeMsg
+        getList (ListField c xs)         = mapError (bodyMsg:) $
+            mapM (applyTemplate' b c) xs
+        getList (LexicalListField mc vs) = mapError (bodyMsg:) $
+            mapM (\v -> applyTemplate' b (mc context v) x) vs
+
         headMsg = "In expr '$for(" ++ show e ++ ")$'"
         typeMsg = "loop expr '" ++ show e ++ "'"
         bodyMsg = "In loop context of '$for(" ++ show e ++ ")$'"
 
-    applyElem (Partial e) = applyStringExpr (headMsg:) typeMsg e >>= \p ->
+    applyElem (Partial e) = do
+        p <- applyStringExpr (headMsg:) typeMsg e
         mapError (inclMsg:) $ do
             tpl' <- loadBody (fromFilePath p)
             itemBody <$> applyTemplate tpl' context x