From d5edfa37e30a7505efa4ae67709602835dd72cba Mon Sep 17 00:00:00 2001 From: Kari Pahula Date: Tue, 14 Jan 2020 21:09:07 +0200 Subject: [PATCH] Add deferManyElse and deferEither to Heist.Compiled --- CONTRIBUTORS | 1 + src/Heist/Compiled.hs | 2 ++ src/Heist/Compiled/Internal.hs | 41 ++++++++++++++++++++++++++++++++-- 3 files changed, 42 insertions(+), 2 deletions(-) diff --git a/CONTRIBUTORS b/CONTRIBUTORS index c5dbd80..62e3526 100644 --- a/CONTRIBUTORS +++ b/CONTRIBUTORS @@ -4,5 +4,6 @@ Carl Howells Edward Kmett Will Langstroth Shane O'Brien +Kari Pahula James Sanders Mark Wright diff --git a/src/Heist/Compiled.hs b/src/Heist/Compiled.hs index d6c9fad..4f31e70 100644 --- a/src/Heist/Compiled.hs +++ b/src/Heist/Compiled.hs @@ -28,7 +28,9 @@ module Heist.Compiled , pureSplice , deferMany + , deferManyElse , defer + , deferEither , deferMap , mayDeferMap , bindLater diff --git a/src/Heist/Compiled/Internal.hs b/src/Heist/Compiled/Internal.hs index 706cbaf..b2b48c5 100644 --- a/src/Heist/Compiled/Internal.hs +++ b/src/Heist/Compiled/Internal.hs @@ -37,6 +37,7 @@ import qualified Text.XmlHtml.HTML.Meta as X ------------------------------------------------------------------------------ #if !MIN_VERSION_base(4,8,0) import Data.Foldable (Foldable) +import Data.Monoid #endif import qualified Data.Foldable as Foldable ------------------------------------------------------------------------------ @@ -749,12 +750,31 @@ deferMany :: (Foldable f, Monad n) => (RuntimeSplice n a -> Splice n) -> RuntimeSplice n (f a) -> Splice n -deferMany f getItems = do +deferMany = deferManyElse $ return mempty + + +------------------------------------------------------------------------------ +-- | A version of 'deferMany' which has a default splice to run in the case +-- when there are no elements in the given list. +deferManyElse :: (Foldable f, Monad n) + => Splice n + -> (RuntimeSplice n a -> Splice n) + -> RuntimeSplice n (f a) + -> Splice n +deferManyElse def f getItems = do promise <- newEmptyPromise chunks <- f $ getPromise promise + defaultChunk <- def return $ yieldRuntime $ do items <- getItems - foldMapM (\item -> putPromise promise item >> codeGen chunks) items + if nullGeneric items + then codeGen defaultChunk + else foldMapM (\item -> putPromise promise item >> + codeGen chunks) items + where + -- Use this instead of null for compatibility with pre 4.8 base + nullGeneric = foldrGeneric (\_ _ -> False) True + foldrGeneric f' z t = appEndo (foldMap (Endo . f') t) z ------------------------------------------------------------------------------ @@ -773,6 +793,23 @@ defer pf n = do return $ action `mappend` res +------------------------------------------------------------------------------ +-- | Much like 'either', takes a runtime computation and branches to the +-- respective splice depending on the runtime value. +deferEither :: Monad n + => (RuntimeSplice n a -> Splice n) + -> (RuntimeSplice n b -> Splice n) + -> RuntimeSplice n (Either a b) -> Splice n +deferEither pfa pfb n = do + pa <- newEmptyPromise + pb <- newEmptyPromise + failureChunk <- pfa $ getPromise pa + successChunk <- pfb $ getPromise pb + return $ yieldRuntime $ n >>= either + (\x -> putPromise pa x >> codeGen failureChunk) + (\x -> putPromise pb x >> codeGen successChunk) + + ------------------------------------------------------------------------------ -- | A version of defer which applies a function on the runtime value. deferMap :: Monad n