Made inner loops have access to outer loop values

lib/Hakyll/Web/Template/Context.hs

@@ -21,6 +21,7 @@
 --------------------------------------------------------------------------------
 {-# LANGUAGE CPP                       #-}
 {-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE RankNTypes                #-}
 module Hakyll.Web.Template.Context
     ( ContextField (..)
     , Context (..)
@@ -48,6 +49,7 @@ module Hakyll.Web.Template.Context
     , teaserField
     , teaserFieldWithSeparator
     , missingField
+    , bindItem
     ) where
 
 
@@ -176,7 +178,11 @@ listField key c xs = listFieldWith key c (const xs)
 
 
 --------------------------------------------------------------------------------
--- | Creates a list field like 'listField', but supplies the current page
+-- | Produces a new 'Context' which has list field 'key'. All fields from
+-- 'c' are also accessible from the produced context.
+-- Be careful when doing @listFieldWith k ca f <> cb@ as any fields in @ca@
+-- will override fields in @cb@ with the same name.
+-- 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
@@ -466,3 +472,10 @@ parseTimeM = TF.parseTimeM
 #else
 parseTimeM _ = TF.parseTime
 #endif
+
+--------------------------------------------------------------------------------
+
+-- | Binds an 'Item' to a given 'Context', allowing it to be combined with any
+-- other 'Context' of any type.
+bindItem :: Context a -> Item a -> forall b. Context b
+bindItem (Context ctx) ia = Context $ \k args _ -> ctx k args ia

lib/Hakyll/Web/Template/Internal.hs

@@ -21,7 +21,8 @@ module Hakyll.Web.Template.Internal
 
 
 --------------------------------------------------------------------------------
-import           Control.Monad.Except                 (catchError)
+import           Control.Monad                        (forM)
+import           Control.Monad.Except                 (MonadError (..), catchError)
 import           Data.Binary                          (Binary)
 import           Data.List                            (intercalate)
 import qualified Data.List.NonEmpty                   as NonEmpty
@@ -171,7 +172,7 @@ applyTemplate' tes context x = go tes
         StringField _  -> expected "list" "string" typeMsg
         ListField c xs -> withErrorMessage bodyMsg $ do
             sep <- maybe (return "") go s
-            bs  <- mapM (applyTemplate' b c) xs
+            bs  <- forM xs $ applyTemplate' b $ c <> bindItem context x
             return $ intercalate sep bs
       where
         headMsg = "In expr '$for(" ++ show e ++ ")$'"

tests/Hakyll/Web/Template/Context/Tests.hs

@@ -13,16 +13,19 @@ import           Test.Tasty.HUnit            (Assertion, testCase, (@=?))
 --------------------------------------------------------------------------------
 import           Hakyll.Core.Compiler
 import           Hakyll.Core.Identifier
+import           Hakyll.Core.Item
 import           Hakyll.Core.Provider
 import           Hakyll.Core.Store           (Store)
 import           Hakyll.Web.Template.Context
+import           Hakyll.Web.Template.Internal
 import           TestSuite.Util
 
 
 --------------------------------------------------------------------------------
 tests :: TestTree
 tests = testGroup "Hakyll.Web.Template.Context.Tests"
     [ testCase "testDateField" testDateField
+    , testCase "testOuerLoopContextAccess" testOuerLoopContextAccess
     ]
 
 
@@ -65,3 +68,28 @@ testContextDone store provider identifier key context =
             _               -> error $
                 "Hakyll.Web.Template.Context.Tests.testContextDone: " ++
                 "expected StringField"
+
+--------------------------------------------------------------------------------
+
+testOuerLoopContextAccess :: Assertion
+testOuerLoopContextAccess = do
+    store    <- newTestStore
+    provider <- newTestProvider store
+    test store provider ctx "baz"
+    test store provider (ctx' <> ctx) "not baz"
+    test store provider (ctx <> ctx') "baz"
+
+    cleanTestEnv
+    where
+        tpl = readTemplate "$for(foo)$$for(bar)$$qux$$endfor$$endfor$"
+        ctx = mconcat [
+            field "qux" $ const $ return "baz"
+            , listField "foo" (listField "bar" mempty $ return [mockItem])
+                $ return [mockItem]
+            ]
+        ctx' = field "qux" $ const $ return "not baz"
+        mockItem = Item "" ()
+        test store provider context str = do
+            str' <- testCompilerDone store provider ""
+                $ applyTemplate tpl context mockItem
+            str @=? itemBody str'