Add compiled splice for FlashNotice

src/Snap/Extras/FlashNotice.hs

@@ -8,18 +8,22 @@ module Snap.Extras.FlashNotice
     , flashSuccess
     , flashError
     , flashSplice
+    , flashCSplice
     ) where
 
 -------------------------------------------------------------------------------
 import           Control.Monad
 import           Control.Monad.Trans
+import           Data.Maybe
+import           Data.Monoid
 import           Data.Text             (Text)
 import qualified Data.Text             as T
 import           Snap.Snaplet
 import           Snap.Snaplet.Heist
 import           Snap.Snaplet.Session
 import           Heist
 import           Heist.Interpreted
+import qualified Heist.Compiled        as C
 import           Text.XmlHtml
 -------------------------------------------------------------------------------
 
@@ -77,3 +81,31 @@ flashSplice session = do
       callTemplateWithText "_flash"
            [ ("type", typ') , ("message", msg') ]
 
+
+-------------------------------------------------------------------------------
+-- | A compiled splice for rendering a given flash notice dirctive.
+--
+-- Ex: <flash type='warning'/>
+-- Ex: <flash type='success'/>
+flashCSplice :: SnapletLens b SessionManager -> SnapletCSplice b
+flashCSplice session = do
+    n <- getParamNode
+    let typ = maybe "warning" id $ getAttribute "type" n
+        k = T.concat ["_", typ]
+        splice prom = do
+            flashTemplate <- C.withLocalSplices
+              [ ("type", return $ C.yieldPureText typ)
+              , ("message", return $ C.yieldRuntimeText $ liftM fromJust
+                                   $ C.getPromise prom) ]
+              [] (C.callTemplate "_flash")
+            return $ C.yieldRuntime $ do
+                msg <- C.getPromise prom
+                case msg of
+                  Nothing -> return mempty
+                  Just _ -> do
+                    lift $ withTop session $
+                      deleteFromSession k >> commitSession
+                    C.codeGen flashTemplate
+    C.defer splice (lift $ withTop session $ getFromSession k)
+
+