diff --git a/project_template/default/foo.cabal b/project_template/default/foo.cabal
--- a/project_template/default/foo.cabal
+++ b/project_template/default/foo.cabal
@@ -24,7 +24,7 @@
Build-depends:
bytestring >= 0.9.1 && < 0.11,
- heist >= 0.13 && < 0.14,
+ heist >= 0.14 && < 0.15,
MonadCatchIO-transformers >= 0.2.1 && < 0.4,
mtl >= 2 && < 3,
snap >= 0.13 && < 0.14,
diff --git a/snap.cabal b/snap.cabal
--- a/snap.cabal
+++ b/snap.cabal
@@ -1,5 +1,5 @@
name: snap
-version: 0.13.2.9
+version: 0.13.3
synopsis: Top-level package for the Snap Web Framework
description:
This is the top-level package for the official Snap Framework libraries.
@@ -160,7 +160,7 @@
filepath >= 1.1 && < 1.4,
-- Blacklist bad versions of hashable
hashable (>= 1.1 && < 1.2) || (>= 1.2.0.6 && <1.3),
- heist >= 0.13 && < 0.14,
+ heist >= 0.14 && < 0.15,
logict >= 0.4.2 && < 0.7,
mtl > 2.0 && < 2.3,
mwc-random >= 0.8 && < 0.14,
diff --git a/src/Snap/Snaplet/Auth/SpliceHelpers.hs b/src/Snap/Snaplet/Auth/SpliceHelpers.hs
--- a/src/Snap/Snaplet/Auth/SpliceHelpers.hs
+++ b/src/Snap/Snaplet/Auth/SpliceHelpers.hs
@@ -24,6 +24,8 @@
, cLoggedInUser
) where
+------------------------------------------------------------------------------
+import Control.Lens
import Control.Monad.Trans
import Data.Maybe
import Data.Monoid
@@ -34,12 +36,12 @@
import qualified Heist.Interpreted as I
import qualified Heist.Compiled as C
import Heist.Splices
-
import Snap.Snaplet
import Snap.Snaplet.Auth.AuthManager
import Snap.Snaplet.Auth.Handlers
import Snap.Snaplet.Auth.Types
import Snap.Snaplet.Heist
+------------------------------------------------------------------------------
------------------------------------------------------------------------------
@@ -55,13 +57,16 @@
-> SnapletLens b (AuthManager b)
-- ^ A lens reference to 'AuthManager'
-> Initializer b v ()
-addAuthSplices h auth = addConfig h $ mempty
- { hcInterpretedSplices = do
- "ifLoggedIn" ## ifLoggedIn auth
- "ifLoggedOut" ## ifLoggedOut auth
- "loggedInUser" ## loggedInUser auth
- , hcCompiledSplices = compiledAuthSplices auth
- }
+addAuthSplices h auth = addConfig h sc
+ where
+ sc = mempty & scInterpretedSplices .~ is
+ & scCompiledSplices .~ cs
+ is = do
+ "ifLoggedIn" ## ifLoggedIn auth
+ "ifLoggedOut" ## ifLoggedOut auth
+ "loggedInUser" ## loggedInUser auth
+ cs = compiledAuthSplices auth
+
------------------------------------------------------------------------------
@@ -99,7 +104,7 @@
userCSplices :: Monad m => Splices (RuntimeSplice m AuthUser -> C.Splice m)
userCSplices = fields `mappend` ifs
where
- fields = mapS (C.pureSplice . C.textSplice) $ do
+ fields = mapV (C.pureSplice . C.textSplice) $ do
"userId" ## maybe "-" unUid . userId
"userLogin" ## userLogin
"userEmail" ## fromMaybe "-" . userEmail
@@ -136,11 +141,11 @@
-- > Show this when there is a logged in user
cIfLoggedIn :: SnapletLens b (AuthManager b) -> SnapletCSplice b
cIfLoggedIn auth = do
- children <- C.runChildren
+ cs <- C.runChildren
return $ C.yieldRuntime $ do
chk <- lift $ withTop auth isLoggedIn
case chk of
- True -> C.codeGen children
+ True -> C.codeGen cs
False -> mempty
@@ -164,11 +169,11 @@
-- > Show this when there is a logged in user
cIfLoggedOut :: SnapletLens b (AuthManager b) -> SnapletCSplice b
cIfLoggedOut auth = do
- children <- C.runChildren
+ cs <- C.runChildren
return $ C.yieldRuntime $ do
chk <- lift $ withTop auth isLoggedIn
case chk of
- False -> C.codeGen children
+ False -> C.codeGen cs
True -> mempty
diff --git a/src/Snap/Snaplet/Heist/Internal.hs b/src/Snap/Snaplet/Heist/Internal.hs
--- a/src/Snap/Snaplet/Heist/Internal.hs
+++ b/src/Snap/Snaplet/Heist/Internal.hs
@@ -54,7 +54,8 @@
]
return hs
where
- defaultConfig = mempty { hcLoadTimeSplices = defaultLoadTimeSplices }
+ sc = set scLoadTimeSplices defaultLoadTimeSplices mempty
+ defaultConfig = HeistConfig sc "" True
------------------------------------------------------------------------------
@@ -74,8 +75,8 @@
, "templates from"
, tDir
]
- let config = initialConfig `mappend`
- mempty { hcTemplateLocations = [loadTemplates tDir] }
+ let config = over hcTemplateLocations (<> [loadTemplates tDir])
+ initialConfig
ref <- liftIO $ newIORef (config, Compiled)
-- FIXME This runs after all the initializers, but before post init
diff --git a/src/Snap/Snaplet/HeistNoClass.hs b/src/Snap/Snaplet/HeistNoClass.hs
--- a/src/Snap/Snaplet/HeistNoClass.hs
+++ b/src/Snap/Snaplet/HeistNoClass.hs
@@ -206,9 +206,9 @@
, fullPrefix ++ "/"
]
let locations = [liftM addPrefix $ loadTemplates templateDir]
- hc' = mempty { hcTemplateLocations = locations }
- liftIO $ atomicModifyIORef (_heistConfig $ view snapletValue h)
- (\(hc,dm) -> ((hc `mappend` hc', dm), ()))
+ add (hc, dm) =
+ ((over hcTemplateLocations (mappend locations) hc, dm), ())
+ liftIO $ atomicModifyIORef (_heistConfig $ view snapletValue h) add
getCurHeistConfig :: Snaplet (Heist b)
@@ -263,15 +263,17 @@
-- there. This is the preferred method for adding all four kinds of splices
-- as well as new templates.
addConfig :: Snaplet (Heist b)
- -> HeistConfig (Handler b b)
+ -> SpliceConfig (Handler b b)
-> Initializer b v ()
-addConfig h hc = case view snapletValue h of
+addConfig h sc = case view snapletValue h of
Configuring ref ->
- liftIO $ atomicModifyIORef ref
- (\(hc1,dm) -> ((hc1 `mappend` hc, dm), ()))
+ liftIO $ atomicModifyIORef ref add
Running _ _ _ _ -> do
printInfo "finalLoadHook called while running"
error "this shouldn't happen"
+ where
+ add (hc, dm) =
+ ((over hcSpliceConfig (`mappend` sc) hc, dm), ())
-----------------------
diff --git a/test/snap-testsuite.cabal b/test/snap-testsuite.cabal
--- a/test/snap-testsuite.cabal
+++ b/test/snap-testsuite.cabal
@@ -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.13 && < 0.14,
+ heist >= 0.14 && < 0.15,
logict >= 0.4.2 && < 0.7,
mtl > 2.0 && < 2.3,
mwc-random >= 0.8 && < 0.14,
@@ -113,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.13 && < 0.14,
+ heist >= 0.14 && < 0.15,
logict >= 0.4.2 && < 0.7,
mtl > 2.0 && < 2.3,
mwc-random >= 0.8 && < 0.14,
@@ -195,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.13 && < 0.14,
+ heist >= 0.14 && < 0.15,
logict >= 0.4.2 && < 0.7,
mtl > 2.0 && < 2.3,
mwc-random >= 0.8 && < 0.14,
diff --git a/test/suite/Blackbox/App.hs b/test/suite/Blackbox/App.hs
--- a/test/suite/Blackbox/App.hs
+++ b/test/suite/Blackbox/App.hs
@@ -53,10 +53,10 @@
initCookieSessionManager "sitekey.txt" "_session" (Just (30 * 60))
ns <- embedSnaplet "embed" embedded embeddedInit
_lens <- getLens
- addConfig hs $ mempty
- { hcInterpretedSplices = do
+ let splices = do
"appsplice" ## textSplice "contents of the app splice"
- "appconfig" ## shConfigSplice _lens }
+ "appconfig" ## shConfigSplice _lens
+ addConfig hs $ mempty & scInterpretedSplices .~ splices
addRoutes [ ("/hello", writeText "hello world")
, ("/routeWithSplice", routeWithSplice)
, ("/routeWithConfig", routeWithConfig)
diff --git a/test/suite/Blackbox/FooSnaplet.hs b/test/suite/Blackbox/FooSnaplet.hs
--- a/test/suite/Blackbox/FooSnaplet.hs
+++ b/test/suite/Blackbox/FooSnaplet.hs
@@ -4,6 +4,7 @@
module Blackbox.FooSnaplet where
import Prelude hiding (lookup)
+import Control.Lens
import Control.Monad.State
import Data.Configurator
import Data.Maybe
@@ -28,11 +29,10 @@
fp <- getSnapletFilePath
name <- getSnapletName
_lens <- getLens
- addConfig h $ mempty
- { hcInterpretedSplices = do
+ let splices = do
"foosplice" ## textSplice "contents of the foo splice"
"fooconfig" ## shConfigSplice _lens
- }
+ addConfig h $ mempty & scInterpretedSplices .~ splices
addRoutes [("fooConfig", liftIO (lookup config "fooSnapletField") >>= writeLBS . fromJust)
,("fooRootUrl", writeBS rootUrl)
,("fooSnapletName", writeText $ fromMaybe "empty snaplet name" name)