snap 0.12.1 → 0.13.0

raw patch · 19 files changed

+208/−166 lines, 19 filesdep ~heist

Dependency ranges changed: heist

Files

• project_template/default/foo.cabal +2/−2
• project_template/default/src/Site.hs +2/−2
• snap.cabal +2/−2
• src/Snap/Snaplet.hs +1/−0
• src/Snap/Snaplet/Auth/SpliceHelpers.hs +49/−51
• src/Snap/Snaplet/Heist.hs +2/−3
• src/Snap/Snaplet/Heist/Compiled.hs +15/−1
• src/Snap/Snaplet/Heist/Generic.hs +0/−2
• src/Snap/Snaplet/Heist/Internal.hs +86/−1
• src/Snap/Snaplet/HeistNoClass.hs +5/−71
• src/Snap/Snaplet/Internal/Initializer.hs +8/−0
• src/Snap/Snaplet/Test.hs +13/−9
• test/snap-testsuite.cabal +3/−9
• test/suite/Blackbox/App.hs +6/−5
• test/suite/Blackbox/BarSnaplet.hs +4/−4
• test/suite/Blackbox/EmbeddedSnaplet.hs +2/−1
• test/suite/Blackbox/FooSnaplet.hs +3/−2
• test/suite/NestTest.hs +2/−1
• test/suite/Snap/Snaplet/Internal/Tests.hs +3/−0

@@ -24,10 +24,10 @@    Build-depends:     bytestring                >= 0.9.1   && < 0.11,-    heist                     >= 0.12    && < 0.13,+    heist                     >= 0.13    && < 0.14,     MonadCatchIO-transformers >= 0.2.1   && < 0.4,     mtl                       >= 2       && < 3,-    snap                      >= 0.11    && < 0.13,+    snap                      >= 0.13    && < 0.14,     snap-core                 >= 0.9     && < 0.11,     snap-server               >= 0.9     && < 0.11,     snap-loader-static        >= 0.9     && < 0.10,

@@ -11,7 +11,6 @@ ------------------------------------------------------------------------------ import           Control.Applicative import           Data.ByteString (ByteString)-import           Data.Maybe import qualified Data.Text as T import           Snap.Core import           Snap.Snaplet@@ -31,7 +30,8 @@ handleLogin :: Maybe T.Text -> Handler App (AuthManager App) () handleLogin authError = heistLocal (I.bindSplices errs) $ render "login"   where-    errs = [("loginError", I.textSplice c) | c <- maybeToList authError]+    errs = maybe noSplices splice authError+    splice err = "loginError" ## I.textSplice err   ------------------------------------------------------------------------------

@@ -1,5 +1,5 @@ name:           snap-version:        0.12.1+version:        0.13.0 synopsis:       Top-level package for the Snap Web Framework description:     This is the top-level package for the official Snap Framework libraries.@@ -159,7 +159,7 @@     filepath                  >= 1.1      && < 1.4,     -- Blacklist bad versions of hashable     hashable                  (>= 1.1 && < 1.2) || (>= 1.2.0.6 && <1.3),-    heist                     >= 0.12     && < 0.13,+    heist                     >= 0.13     && < 0.14,     logict                    >= 0.4.2    && < 0.7,     mtl                       >  2.0      && < 2.2,     mwc-random                >= 0.8      && < 0.13,

@@ -93,6 +93,7 @@   , addPostInitHookBase   , printInfo   , getRoutes+  , getEnvironment    -- * Routes   -- $routes

@@ -1,6 +1,6 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -27,7 +27,6 @@ import           Control.Monad.Trans import           Data.Maybe import           Data.Monoid-import           Data.Text (Text) import qualified Data.Text as T import           Data.Text.Encoding import qualified Text.XmlHtml as X@@ -57,10 +56,10 @@       -- ^ A lens reference to 'AuthManager'   -> Initializer b v () addAuthSplices h auth = addConfig h $ mempty-    { hcInterpretedSplices = [ ("ifLoggedIn", ifLoggedIn auth)-                             , ("ifLoggedOut", ifLoggedOut auth)-                             , ("loggedInUser", loggedInUser auth)-                             ]+    { hcInterpretedSplices = do+          "ifLoggedIn"   ## ifLoggedIn auth+          "ifLoggedOut"  ## ifLoggedOut auth+          "loggedInUser" ## loggedInUser auth     , hcCompiledSplices = compiledAuthSplices auth     } @@ -69,53 +68,52 @@ -- | List containing compiled splices for ifLoggedIn, ifLoggedOut, and -- loggedInUser. compiledAuthSplices :: SnapletLens b (AuthManager b)-                    -> [(Text, SnapletCSplice b)]-compiledAuthSplices auth =-    [ ("ifLoggedIn", cIfLoggedIn auth)-    , ("ifLoggedOut", cIfLoggedOut auth)-    , ("loggedInUser", cLoggedInUser auth)-    ]+                    -> Splices (SnapletCSplice b)+compiledAuthSplices auth = do+    "ifLoggedIn"   ## cIfLoggedIn auth+    "ifLoggedOut"  ## cIfLoggedOut auth+    "loggedInUser" ## cLoggedInUser auth   ------------------------------------------------------------------------------ -- | Function to generate interpreted splices from an AuthUser.-userISplices :: Monad m => AuthUser -> [(Text, I.Splice m)]-userISplices AuthUser{..} =-    [ ("userId", I.textSplice $ maybe "-" unUid userId)-    , ("userLogin", I.textSplice userLogin)-    , ("userEmail", I.textSplice $ fromMaybe "-" userEmail)-    , ("userActive", I.textSplice $ T.pack $ show $ isNothing userSuspendedAt)-    , ("userLoginCount", I.textSplice $ T.pack $ show userLoginCount)-    , ("userFailedCount", I.textSplice $ T.pack $ show userFailedLoginCount)-    , ("userLoginAt", I.textSplice $ maybe "-" (T.pack . show) userCurrentLoginAt)-    , ("userLastLoginAt", I.textSplice $ maybe "-" (T.pack . show) userLastLoginAt)-    , ("userSuspendedAt", I.textSplice $ maybe "-" (T.pack . show) userSuspendedAt)-    , ("userLoginIP", I.textSplice $ maybe "-" decodeUtf8 userCurrentLoginIp)-    , ("userLastLoginIP", I.textSplice $ maybe "-" decodeUtf8 userLastLoginIp)-    , ("userIfActive", ifISplice (isNothing userSuspendedAt))-    , ("userIfSuspended", ifISplice (isJust userSuspendedAt))-    ]+userISplices :: Monad m => AuthUser -> Splices (I.Splice m)+userISplices AuthUser{..} = do+    "userId"          ## I.textSplice $ maybe "-" unUid userId+    "userLogin"       ## I.textSplice userLogin+    "userEmail"       ## I.textSplice $ fromMaybe "-" userEmail+    "userActive"      ## I.textSplice $ T.pack $ show $ isNothing userSuspendedAt+    "userLoginCount"  ## I.textSplice $ T.pack $ show userLoginCount+    "userFailedCount" ## I.textSplice $ T.pack $ show userFailedLoginCount+    "userLoginAt"     ## I.textSplice $ maybe "-" (T.pack . show) userCurrentLoginAt+    "userLastLoginAt" ## I.textSplice $ maybe "-" (T.pack . show) userLastLoginAt+    "userSuspendedAt" ## I.textSplice $ maybe "-" (T.pack . show) userSuspendedAt+    "userLoginIP"     ## I.textSplice $ maybe "-" decodeUtf8 userCurrentLoginIp+    "userLastLoginIP" ## I.textSplice $ maybe "-" decodeUtf8 userLastLoginIp+    "userIfActive"    ## ifISplice $ isNothing userSuspendedAt+    "userIfSuspended" ## ifISplice $ isJust userSuspendedAt   ------------------------------------------------------------------------------ -- | Compiled splices for AuthUser.-userCSplices :: Monad m => [(Text, C.Promise AuthUser -> C.Splice m)]-userCSplices = (C.pureSplices $ C.textSplices-    [ ("userId", maybe "-" unUid . userId)-    , ("userLogin", userLogin)-    , ("userEmail", fromMaybe "-" . userEmail)-    , ("userActive", T.pack . show . isNothing . userSuspendedAt)-    , ("userLoginCount", T.pack . show . userLoginCount)-    , ("userFailedCount", T.pack . show . userFailedLoginCount)-    , ("userLoginAt", maybe "-" (T.pack . show) . userCurrentLoginAt)-    , ("userLastLoginAt", maybe "-" (T.pack . show) . userLastLoginAt)-    , ("userSuspendedAt", maybe "-" (T.pack . show) . userSuspendedAt)-    , ("userLoginIP", maybe "-" decodeUtf8 . userCurrentLoginIp)-    , ("userLastLoginIP", maybe "-" decodeUtf8 . userLastLoginIp)-    ]) ++-    [ ("userIfActive", ifCSplice (isNothing . userSuspendedAt))-    , ("userIfSuspended", ifCSplice (isJust . userSuspendedAt))-    ]+userCSplices :: Monad m => Splices (RuntimeSplice m AuthUser -> C.Splice m)+userCSplices = fields `mappend` ifs+  where+    fields = mapS (C.pureSplice . C.textSplice) $ do+        "userId"          ## maybe "-" unUid . userId+        "userLogin"       ## userLogin+        "userEmail"       ## fromMaybe "-" . userEmail+        "userActive"      ## T.pack . show . isNothing . userSuspendedAt+        "userLoginCount"  ## T.pack . show . userLoginCount+        "userFailedCount" ## T.pack . show . userFailedLoginCount+        "userLoginAt"     ## maybe "-" (T.pack . show) . userCurrentLoginAt+        "userLastLoginAt" ## maybe "-" (T.pack . show) . userLastLoginAt+        "userSuspendedAt" ## maybe "-" (T.pack . show) . userSuspendedAt+        "userLoginIP"     ## maybe "-" decodeUtf8 . userCurrentLoginIp+        "userLastLoginIP" ## maybe "-" decodeUtf8 . userLastLoginIp+    ifs = do+        "userIfActive"    ## ifCSplice (isNothing . userSuspendedAt)+        "userIfSuspended" ## ifCSplice (isJust . userSuspendedAt)   ------------------------------------------------------------------------------@@ -138,12 +136,12 @@ -- > <ifLoggedIn> Show this when there is a logged in user </ifLoggedIn> cIfLoggedIn :: SnapletLens b (AuthManager b) -> SnapletCSplice b cIfLoggedIn auth = do-    children <- C.promiseChildren+    children <- C.runChildren     return $ C.yieldRuntime $ do         chk <- lift $ withTop auth isLoggedIn         case chk of-          True -> children-          False -> return mempty+          True -> C.codeGen children+          False -> mempty   ------------------------------------------------------------------------------@@ -166,12 +164,12 @@ -- > <ifLoggedOut> Show this when there is a logged in user </ifLoggedOut> cIfLoggedOut :: SnapletLens b (AuthManager b) -> SnapletCSplice b cIfLoggedOut auth = do-    children <- C.promiseChildren+    children <- C.runChildren     return $ C.yieldRuntime $ do         chk <- lift $ withTop auth isLoggedIn         case chk of-          False -> children-          True -> return mempty+          False -> C.codeGen children+          True -> mempty   -------------------------------------------------------------------------------

@@ -56,7 +56,6 @@ import           Prelude hiding (id, (.)) import           Control.Monad.State import           Data.ByteString (ByteString)-import           Data.Text (Text) import           Heist ------------------------------------------------------------------------------ import           Snap.Snaplet@@ -296,7 +295,7 @@ renderWithSplices :: HasHeist b                   => ByteString                       -- ^ Template name-                  -> [(Text, Unclassed.SnapletISplice b)]+                  -> Splices (Unclassed.SnapletISplice b)                       -- ^ Splices to bind                   -> Handler b v () renderWithSplices = Unclassed.renderWithSplices' heistLens@@ -306,7 +305,7 @@ -- | Runs an action with additional splices bound into the Heist -- 'HeistState'. withSplices :: HasHeist b-            => [(Text, Unclassed.SnapletISplice b)]+            => Splices (Unclassed.SnapletISplice b)                 -- ^ Splices to bind             -> Handler b v a                 -- ^ Handler to run

@@ -14,8 +14,9 @@    -- * Initializer Functions   -- $initializerSection-  , H.heistInit+  , heistInit   , H.heistInit'+  , H.heistReloader   , H.addTemplates   , H.addTemplatesAt   , H.addConfig@@ -34,7 +35,20 @@  import           Data.ByteString (ByteString) import           Snap.Snaplet+import           Snap.Snaplet.Heist.Internal import qualified Snap.Snaplet.Heist as H+import qualified Snap.Snaplet.HeistNoClass as HNC+++------------------------------------------------------------------------------+-- | The 'Initializer' for 'Heist'. This function is a convenience wrapper+-- around `heistInit'` that uses defaultHeistState and sets up routes for all+-- the templates.  It sets up a \"heistReload\" route that reloads the heist+-- templates when you request it from localhost.+heistInit :: FilePath+             -- ^ Path to templates+          -> SnapletInit b (Heist b)+heistInit = gHeistInit HNC.cHeistServe   ------------------------------------------------------------------------------

@@ -15,8 +15,6 @@    -- * Initializer Functions   -- $initializerSection-  , heistInit-  , heistInit'   , addTemplates   , addTemplatesAt   , addConfig

@@ -1,11 +1,21 @@+{-# LANGUAGE TemplateHaskell #-} module Snap.Snaplet.Heist.Internal where -import           Prelude hiding ((.), id)+import           Prelude+import           Control.Error import           Control.Lens+import           Control.Monad.State+import qualified Data.HashMap.Strict as Map import           Data.IORef+import           Data.List+import           Data.Monoid+import           Data.Text (Text)+import qualified Data.Text as T import           Heist import           Heist.Splices.Cache+import           System.FilePath.Posix +import           Snap.Core import           Snap.Snaplet  @@ -28,3 +38,78 @@                  }  makeLenses ''Heist+++------------------------------------------------------------------------------+-- | Generic initializer function that allows compiled/interpreted template+-- serving to be specified by the caller.+gHeistInit :: Handler b (Heist b) ()+           -> FilePath+           -> SnapletInit b (Heist b)+gHeistInit serve templateDir = do+    makeSnaplet "heist" "" Nothing $ do+        hs <- heistInitWorker templateDir defaultConfig+        addRoutes [ ("", serve)+                  , ("heistReload", failIfNotLocal heistReloader)+                  ]+        return hs+  where+    defaultConfig = mempty { hcLoadTimeSplices = defaultLoadTimeSplices }+++------------------------------------------------------------------------------+-- | Internal worker function used by variants of heistInit.  This is+-- necessary because of the divide between SnapletInit and Initializer.+heistInitWorker :: FilePath+                -> HeistConfig (Handler b b)+                -> Initializer b (Heist b) (Heist b)+heistInitWorker templateDir initialConfig = do+    snapletPath <- getSnapletFilePath+    let tDir = snapletPath </> templateDir+    templates <- liftIO $ runEitherT (loadTemplates tDir) >>=+                          either (error . concat) return+    printInfo $ T.pack $ unwords+        [ "...loaded"+        , (show $ Map.size templates)+        , "templates from"+        , tDir+        ]+    let config = initialConfig `mappend`+                 mempty { hcTemplateLocations = [loadTemplates tDir] }+    ref <- liftIO $ newIORef (config, Compiled)++    -- FIXME This runs after all the initializers, but before post init+    -- hooks registered by other snaplets.+    addPostInitHook finalLoadHook+    return $ Configuring ref+++------------------------------------------------------------------------------+-- | Hook that converts the Heist type from Configuring to Running at the end+-- of initialization.+finalLoadHook :: Heist b -> EitherT Text IO (Heist b)+finalLoadHook (Configuring ref) = do+    (hc,dm) <- lift $ readIORef ref+    (hs,cts) <- toTextErrors $ initHeistWithCacheTag hc+    return $ Running hc hs cts dm+  where+    toTextErrors = bimapEitherT (T.pack . intercalate "\n") id+finalLoadHook (Running _ _ _ _) = left "finalLoadHook called while running"+++------------------------------------------------------------------------------+-- | Handler that triggers a template reload.  For large sites, this can be+-- desireable because it may be much quicker than the full site reload+-- provided at the /admin/reload route.  This allows you to reload only the+-- heist templates  This handler is automatically set up by heistInit, but if+-- you use heistInit', then you can create your own route with it.+heistReloader :: Handler b (Heist b) ()+heistReloader = do+    h <- get+    ehs <- liftIO $ runEitherT $ initHeist $ _masterConfig h+    either (writeText . T.pack . unlines)+           (\hs -> do writeText "Heist reloaded."+                      modifyMaster $ set heistState hs h)+           ehs++

@@ -71,9 +71,7 @@ import           Data.DList (DList) import qualified Data.HashMap.Strict as Map import           Data.IORef-import           Data.List import           Data.Monoid-import           Data.Text (Text) import qualified Data.Text as T import           Data.Text.Encoding import           System.FilePath.Posix@@ -105,22 +103,6 @@ clearHeistCache = clearCacheTagState . _heistCTS  ---------------------------------------------------------------------------------- | Handler that triggers a template reload.  For large sites, this can be--- desireable because it may be much quicker than the full site reload--- provided at the /admin/reload route.  This allows you to reload only the--- heist templates  This handler is automatically set up by heistInit, but if--- you use heistInit', then you can create your own route with it.-heistReloader :: Handler b (Heist b) ()-heistReloader = do-    h <- get-    ehs <- liftIO $ runEitherT $ initHeist $ _masterConfig h-    either (writeText . T.pack . unlines)-           (\hs -> do writeText "Heist reloaded."-                      modifyMaster $ set heistState hs h)-           ehs--                          -----------------------------                          -- SnapletSplice functions --                          -----------------------------@@ -150,15 +132,7 @@ heistInit :: FilePath               -- ^ Path to templates           -> SnapletInit b (Heist b)-heistInit templateDir = do-    makeSnaplet "heist" "" Nothing $ do-        hs <- heistInitWorker templateDir defaultConfig-        addRoutes [ ("", heistServe)-                  , ("heistReload", failIfNotLocal heistReloader)-                  ]-        return hs-  where-    defaultConfig = mempty { hcLoadTimeSplices = defaultLoadTimeSplices }+heistInit = gHeistInit heistServe   ------------------------------------------------------------------------------@@ -175,33 +149,6 @@   --------------------------------------------------------------------------------- | Internal worker function used by variants of heistInit.  This is--- necessary because of the divide between SnapletInit and Initializer.-heistInitWorker :: FilePath-                -> HeistConfig (Handler b b)-                -> Initializer b (Heist b) (Heist b)-heistInitWorker templateDir initialConfig = do-    snapletPath <- getSnapletFilePath-    let tDir = snapletPath </> templateDir-    templates <- liftIO $ runEitherT (loadTemplates tDir) >>=-                          either (error . concat) return-    printInfo $ T.pack $ unwords-        [ "...loaded"-        , (show $ Map.size templates)-        , "templates from"-        , tDir-        ]-    let config = initialConfig `mappend`-                 mempty { hcTemplateLocations = [loadTemplates tDir] }-    ref <- liftIO $ newIORef (config, Compiled)--    -- FIXME This runs after all the initializers, but before post init-    -- hooks registered by other snaplets.-    addPostInitHook finalLoadHook-    return $ Configuring ref--------------------------------------------------------------------------------- -- | Sets the snaplet to default to interpreted mode.  Initially, the -- initializer sets the value to compiled mode.  This function allows you to -- override that setting.  Note that this is just a default.  It only has an@@ -216,19 +163,6 @@   --------------------------------------------------------------------------------- | Hook that converts the Heist type from Configuring to Running at the end--- of initialization.-finalLoadHook :: Heist b -> EitherT Text IO (Heist b)-finalLoadHook (Configuring ref) = do-    (hc,dm) <- lift $ readIORef ref-    (hs,cts) <- toTextErrors $ initHeistWithCacheTag hc-    return $ Running hc hs cts dm-  where-    toTextErrors = bimapEitherT (T.pack . intercalate "\n") id-finalLoadHook (Running _ _ _ _) = left "finalLoadHook called while running"--------------------------------------------------------------------------------- -- | Adds templates to the Heist HeistConfig.  Other snaplets should use -- this function to add their own templates.  The templates are automatically -- read from the templates directory in the current snaplet's filesystem root.@@ -503,7 +437,7 @@  ------------------------------------------------------------------------------ withSplices' :: SnapletLens (Snaplet b) (Heist b)-             -> [(Text, SnapletISplice b)]+             -> Splices (SnapletISplice b)              -> Handler b v a              -> Handler b v a withSplices' heist splices m = do@@ -512,7 +446,7 @@  ------------------------------------------------------------------------------ withSplices :: SnapletLens b (Heist b)-            -> [(Text, SnapletISplice b)]+            -> Splices (SnapletISplice b)             -> Handler b v a             -> Handler b v a withSplices heist splices m = withSplices' (subSnaplet heist) splices m@@ -521,7 +455,7 @@ ------------------------------------------------------------------------------ renderWithSplices' :: SnapletLens (Snaplet b) (Heist b)                    -> ByteString-                   -> [(Text, SnapletISplice b)]+                   -> Splices (SnapletISplice b)                    -> Handler b v () renderWithSplices' heist t splices =     withSplices' heist splices $ withTop' heist $ render t@@ -530,7 +464,7 @@ ------------------------------------------------------------------------------ renderWithSplices :: SnapletLens b (Heist b)                   -> ByteString-                  -> [(Text, SnapletISplice b)]+                  -> Splices (SnapletISplice b)                   -> Handler b v () renderWithSplices heist t splices =     renderWithSplices' (subSnaplet heist) t splices

@@ -22,6 +22,7 @@   , loadAppConfig   , printInfo   , getRoutes+  , getEnvironment   , modifyMaster   ) where @@ -85,6 +86,13 @@ getRoutes :: Initializer b v [ByteString] getRoutes = liftM (map fst) $ iGets _handlers +------------------------------------------------------------------------------+-- | Return the current environment string.  This will be the+-- environment given to 'runSnaplet' or from the command line when+-- using 'serveSnaplet'.  Usefully for changing behavior during+-- development and testing.+getEnvironment :: Initializer b v String+getEnvironment = iGets _environment  ------------------------------------------------------------------------------ -- | Converts a plain hook into a Snaplet hook.

@@ -15,6 +15,7 @@ import           Control.Exception.Base (finally) import qualified Control.Exception as E import           Control.Monad.IO.Class+import           Data.Maybe (fromMaybe)  import           Data.Text import           System.Directory import           System.IO.Error@@ -56,12 +57,13 @@ -- 'runHandler' defined in Snap.Test, because due to the fact running -- the initializer inside 'SnapletInit' can throw an exception. runHandler :: MonadIO m-           => RequestBuilder m ()+           => Maybe String+           -> RequestBuilder m ()            -> Handler b b a            -> SnapletInit b b            -> m (Either Text Response)-runHandler rq h s = do-        app <- getSnaplet s+runHandler env rq h s = do+        app <- getSnaplet env s         case app of           (Left e) -> return $ Left e           (Right (a,_)) -> do@@ -81,12 +83,13 @@ -- 'evalHandler defined in Snap.Test, because due to the fact running -- the initializer inside 'SnapletInit' can throw an exception. evalHandler :: MonadIO m-            => RequestBuilder m ()+            => Maybe String +            -> RequestBuilder m ()             -> Handler b b a             -> SnapletInit b b             -> m (Either Text a)-evalHandler rq h s = do-    app <- getSnaplet s+evalHandler env rq h s = do+    app <- getSnaplet env s     case app of       (Left e) -> return $ Left e       (Right (a,_)) -> do@@ -99,10 +102,11 @@ -- a @Snaplet b@, or an error message whether the initializer threw an -- exception.                                                        getSnaplet :: MonadIO m-           => SnapletInit b b+           => Maybe String  +           -> SnapletInit b b            -> m (Either Text (Snaplet b, InitializerState b))-getSnaplet (SnapletInit initializer) = liftIO $ do+getSnaplet env (SnapletInit initializer) = liftIO $ do     mvar <- newEmptyMVar     let resetter f = modifyMVar_ mvar (return . f)-    runInitializer resetter "" initializer+    runInitializer resetter (fromMaybe "devel" env) initializer 

@@ -41,7 +41,7 @@     filepath                   >= 1.1      && < 1.4,     -- Blacklist bad versions of hashable     hashable                  (>= 1.1 && < 1.2) || (>= 1.2.0.6 && <1.3),-    heist                      >= 0.12     && < 0.13,+    heist                      >= 0.13     && < 0.14,     logict                     >= 0.4.2    && < 0.6,     mtl                        >  2.0      && < 2.2,     mwc-random                 >= 0.8      && < 0.13,@@ -52,8 +52,6 @@     stm                        >= 2.2      && < 2.5,     syb                        >= 0.1      && < 0.5,     text                       >= 0.11     && < 0.12,-    -- Without the tagged dependency we reach backtrack limits-    tagged                     < 0.5,     time                       >= 1.1      && < 1.5,     transformers               >= 0.2      && < 0.4,     unordered-containers       >= 0.1.4    && < 0.3,@@ -115,7 +113,7 @@     filepath                   >= 1.1      && < 1.4,     -- Blacklist bad versions of hashable     hashable                  (>= 1.1 && < 1.2) || (>= 1.2.0.6 && <1.3),-    heist                      >= 0.12     && < 0.13,+    heist                      >= 0.13     && < 0.14,     logict                     >= 0.4.2    && < 0.6,     mtl                        >  2.0      && < 2.2,     mwc-random                 >= 0.8      && < 0.13,@@ -125,8 +123,6 @@     snap-server                >= 0.9      && < 0.11,     stm                        >= 2.2      && < 2.5,     syb                        >= 0.1      && < 0.5,-    -- Without the tagged dependency we reach backtrack limits-    tagged                     < 0.5,     text                       >= 0.11     && < 0.12,     time                       >= 1.1      && < 1.5,     transformers               >= 0.2      && < 0.4,@@ -199,7 +195,7 @@     filepath                   >= 1.1      && < 1.4,     -- Blacklist bad versions of hashable     hashable                  (>= 1.1 && < 1.2) || (>= 1.2.0.6 && <1.3),-    heist                      >= 0.12     && < 0.13,+    heist                      >= 0.13     && < 0.14,     logict                     >= 0.4.2    && < 0.6,     mtl                        >  2.0      && < 2.2,     mwc-random                 >= 0.8      && < 0.13,@@ -209,8 +205,6 @@     snap-server                >= 0.9      && < 0.11,     stm                        >= 2.2      && < 2.5,     syb                        >= 0.1      && < 0.5,-    -- Without the tagged dependency we reach backtrack limits-    tagged                     < 0.5,     text                       >= 0.11     && < 0.12,     time                       >= 1.1      && < 1.5,     transformers               >= 0.2      && < 0.4,

@@ -54,8 +54,9 @@     ns <- embedSnaplet "embed" embedded embeddedInit     _lens <- getLens     addConfig hs $ mempty-        { hcInterpretedSplices = [("appsplice", textSplice "contents of the app splice")-                                 ,("appconfig", shConfigSplice _lens)] }+        { hcInterpretedSplices = do+            "appsplice" ## textSplice "contents of the app splice"+            "appconfig" ## shConfigSplice _lens }     addRoutes [ ("/hello", writeText "hello world")               , ("/routeWithSplice", routeWithSplice)               , ("/routeWithConfig", routeWithConfig)@@ -92,9 +93,9 @@       Just _ -> return ()   list <- with session $ (T.pack . show) `fmap` sessionToList   csrf <- with session $ (T.pack . show) `fmap` csrfToken-  HNC.renderWithSplices heist "session"-    [ ("session", textSplice list)-    , ("csrf", textSplice csrf) ]+  HNC.renderWithSplices heist "session" $ do+    "session" ## textSplice list+    "csrf" ## textSplice csrf   ------------------------------------------------------------------------------

@@ -12,10 +12,10 @@ import qualified Data.ByteString as B import Data.Configurator import Data.Maybe-import Data.Text (Text) import Snap.Snaplet import Snap.Snaplet.Heist import Snap.Core+import Heist import Heist.Interpreted  import Blackbox.Common@@ -28,8 +28,8 @@  makeLenses ''BarSnaplet -barsplice :: [(Text, SnapletISplice b)]-barsplice = [("barsplice", textSplice "contents of the bar splice")]+barsplice :: Splices (SnapletISplice b)+barsplice = "barsplice" ## textSplice "contents of the bar splice"  barInit :: HasHeist b         => Snaplet (Heist b)@@ -46,7 +46,7 @@               ,("bazpage3",   heistServeSingle "bazpage")               ,("bazpage4",   renderAs "text/html" "bazpage")               ,("bazpage5",   renderWithSplices "bazpage"-                                [("barsplice", shConfigSplice _lens)])+                                ("barsplice" ## shConfigSplice _lens))               ,("bazbadpage", heistServeSingle "cpyga")               ,("bar/handlerConfig", handlerConfig)               ]

@@ -18,6 +18,7 @@  import Snap.Snaplet import Snap.Snaplet.Heist+import Heist import Heist.Interpreted  -- If we universally quantify EmbeddedSnaplet to get rid of the type parameter@@ -43,7 +44,7 @@      embeddedLens <- getLens     addRoutes [("aoeuhtns", withSplices-                    [("asplice", embeddedSplice embeddedLens)]+                    ("asplice" ## embeddedSplice embeddedLens)                     (render "embeddedpage"))               ]     return $ EmbeddedSnaplet hs 42

@@ -29,8 +29,9 @@     name <- getSnapletName     _lens <- getLens     addConfig h $ mempty-        { hcInterpretedSplices = [("foosplice", textSplice "contents of the foo splice")-                                 ,("fooconfig", shConfigSplice _lens)]+        { hcInterpretedSplices = do+            "foosplice" ## textSplice "contents of the foo splice"+            "fooconfig" ## shConfigSplice _lens         }     addRoutes [("fooConfig", liftIO (lookup config "fooSnapletField") >>= writeLBS . fromJust)               ,("fooRootUrl", writeBS rootUrl)

@@ -20,6 +20,7 @@  import Snap.Snaplet import Snap.Snaplet.Heist+import Heist import Heist.Interpreted  -- If we universally quantify FooSnaplet to get rid of the type parameter@@ -42,7 +43,7 @@     fooLens <- getLens     addRoutes [("fooRootUrl", writeBS rootUrl)               ,("aoeuhtns", renderWithSplices "foo/foopage"-                    [("asplice", fooSplice fooLens)])+                    ("asplice" ## fooSplice fooLens))               ,("", heistServe)               ]     return $ FooSnaplet hs 42

@@ -82,6 +82,9 @@      configAssertions "root "         ([], cwd, Just "app", "Test application", "")++    assertGet "environment" getEnvironment "devel"+     f <- nestSnaplet "foo" foo $ fooInit     b <- nestSnaplet "bar" bar $ barInit     return $ App f b