From 8ae8f525ce09bc220c8b8c3b624f3663c87cf943 Mon Sep 17 00:00:00 2001 From: iko Date: Sun, 25 Aug 2019 13:52:21 +0300 Subject: [PATCH 1/4] Made inner loops have access to outer loop values --- lib/Hakyll/Web/Template/Context.hs | 4 ++-- lib/Hakyll/Web/Template/Internal.hs | 8 +++++++- 2 files changed, 9 insertions(+), 3 deletions(-) diff --git a/lib/Hakyll/Web/Template/Context.hs b/lib/Hakyll/Web/Template/Context.hs index 803825324..d6fa60e9a 100644 --- a/lib/Hakyll/Web/Template/Context.hs +++ b/lib/Hakyll/Web/Template/Context.hs @@ -272,8 +272,8 @@ titleField = mapContext takeBaseName . pathField -- -- As another alternative, if none of the above matches, and the file has a -- path which contains nested directories specifying a date, then that date --- will be used. In other words, if the path is of the form --- @**//yyyy//mm//dd//**//main.extension@ . +-- will be used. In other words, if the path is of the form +-- @**//yyyy//mm//dd//**//main.extension@ . -- As above, in case of multiple matches, the rightmost one is used. dateField :: String -- ^ Key in which the rendered date should be placed diff --git a/lib/Hakyll/Web/Template/Internal.hs b/lib/Hakyll/Web/Template/Internal.hs index 154cee6f8..0b0a65d20 100644 --- a/lib/Hakyll/Web/Template/Internal.hs +++ b/lib/Hakyll/Web/Template/Internal.hs @@ -18,6 +18,7 @@ module Hakyll.Web.Template.Internal -------------------------------------------------------------------------------- +import Control.Applicative ((<|>)) import Control.Monad.Except (MonadError (..)) import Data.Binary (Binary) import Data.List (intercalate) @@ -134,8 +135,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 $ combineContexts context x c) xs return $ intercalate sep bs + where + combineContexts :: Context a -> Item a -> Context b -> Context b + combineContexts ca ia cb = Context $ \ k' args' ib' -> + unContext cb k' args' ib' + <|> unContext ca k' args' ia applyElem (Partial e) = do p <- applyExpr e >>= getString e From eff77cae4036cf0cb2a9340c18b5ecb5b33b6997 Mon Sep 17 00:00:00 2001 From: iko Date: Thu, 29 Aug 2019 14:14:08 +0300 Subject: [PATCH 2/4] Added `bindItem` --- lib/Hakyll/Web/Template/Context.hs | 9 +++++++++ lib/Hakyll/Web/Template/Internal.hs | 9 ++------- 2 files changed, 11 insertions(+), 7 deletions(-) diff --git a/lib/Hakyll/Web/Template/Context.hs b/lib/Hakyll/Web/Template/Context.hs index d6fa60e9a..906597741 100644 --- a/lib/Hakyll/Web/Template/Context.hs +++ b/lib/Hakyll/Web/Template/Context.hs @@ -1,6 +1,7 @@ -------------------------------------------------------------------------------- {-# LANGUAGE CPP #-} {-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE RankNTypes #-} module Hakyll.Web.Template.Context ( ContextField (..) , Context (..) @@ -28,6 +29,7 @@ module Hakyll.Web.Template.Context , teaserField , teaserFieldWithSeparator , missingField + , bindItem ) where @@ -396,3 +398,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 diff --git a/lib/Hakyll/Web/Template/Internal.hs b/lib/Hakyll/Web/Template/Internal.hs index 0b0a65d20..1ace40c47 100644 --- a/lib/Hakyll/Web/Template/Internal.hs +++ b/lib/Hakyll/Web/Template/Internal.hs @@ -18,7 +18,7 @@ module Hakyll.Web.Template.Internal -------------------------------------------------------------------------------- -import Control.Applicative ((<|>)) +import Control.Monad (forM) import Control.Monad.Except (MonadError (..)) import Data.Binary (Binary) import Data.List (intercalate) @@ -135,13 +135,8 @@ 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 $ combineContexts context x c) xs + bs <- forM xs $ applyTemplate' b $ c <> bindItem context x return $ intercalate sep bs - where - combineContexts :: Context a -> Item a -> Context b -> Context b - combineContexts ca ia cb = Context $ \ k' args' ib' -> - unContext cb k' args' ib' - <|> unContext ca k' args' ia applyElem (Partial e) = do p <- applyExpr e >>= getString e From cf61a95ff05b48c6e92c202fe4f469b496fcbab7 Mon Sep 17 00:00:00 2001 From: iko Date: Thu, 29 Aug 2019 14:33:05 +0300 Subject: [PATCH 3/4] Added docs --- lib/Hakyll/Web/Template/Context.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lib/Hakyll/Web/Template/Context.hs b/lib/Hakyll/Web/Template/Context.hs index 906597741..e00ef6443 100644 --- a/lib/Hakyll/Web/Template/Context.hs +++ b/lib/Hakyll/Web/Template/Context.hs @@ -135,6 +135,10 @@ listField key c xs = listFieldWith key c (const xs) -------------------------------------------------------------------------------- +-- | 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. listFieldWith :: String -> Context a -> (Item b -> Compiler [Item a]) -> Context b listFieldWith key c f = field' key $ fmap (ListField c) . f From 5b61ad2f2cda6050e6abedd22221ed07fb968d1c Mon Sep 17 00:00:00 2001 From: iko Date: Thu, 29 Aug 2019 20:52:28 +0300 Subject: [PATCH 4/4] Added loop value scope test --- tests/Hakyll/Web/Template/Context/Tests.hs | 28 ++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/tests/Hakyll/Web/Template/Context/Tests.hs b/tests/Hakyll/Web/Template/Context/Tests.hs index 3adedd883..cec577f27 100644 --- a/tests/Hakyll/Web/Template/Context/Tests.hs +++ b/tests/Hakyll/Web/Template/Context/Tests.hs @@ -13,9 +13,11 @@ 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 @@ -23,6 +25,7 @@ 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 = ListField _ _ -> error $ "Hakyll.Web.Template.Context.Tests.testContextDone: " ++ "Didn't expect ListField" + +-------------------------------------------------------------------------------- + +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'