diff --git a/project_template/default/snaplets/heist/templates/_login.tpl b/project_template/default/snaplets/heist/templates/_login.tpl
new file mode 100644
--- /dev/null
+++ b/project_template/default/snaplets/heist/templates/_login.tpl
@@ -0,0 +1,9 @@
+Snap Example App Login
+
+
+
+/login
+Login
+
+
+Don't have a login yet? Create a new user
diff --git a/project_template/default/snaplets/heist/templates/_new_user.tpl b/project_template/default/snaplets/heist/templates/_new_user.tpl
new file mode 100644
--- /dev/null
+++ b/project_template/default/snaplets/heist/templates/_new_user.tpl
@@ -0,0 +1,5 @@
+Register a new user
+
+/new_user
+Add User
+
diff --git a/project_template/default/snaplets/heist/templates/index.tpl b/project_template/default/snaplets/heist/templates/index.tpl
--- a/project_template/default/snaplets/heist/templates/index.tpl
+++ b/project_template/default/snaplets/heist/templates/index.tpl
@@ -13,7 +13,7 @@
-
+
diff --git a/project_template/default/snaplets/heist/templates/login.tpl b/project_template/default/snaplets/heist/templates/login.tpl
--- a/project_template/default/snaplets/heist/templates/login.tpl
+++ b/project_template/default/snaplets/heist/templates/login.tpl
@@ -1,11 +1,3 @@
- Snap Example App Login
-
-
-
- /login
- Login
-
-
- Don't have a login yet? Create a new user
+
diff --git a/project_template/default/snaplets/heist/templates/new_user.tpl b/project_template/default/snaplets/heist/templates/new_user.tpl
--- a/project_template/default/snaplets/heist/templates/new_user.tpl
+++ b/project_template/default/snaplets/heist/templates/new_user.tpl
@@ -1,9 +1,3 @@
-
- Register a new user
-
- /new_user
- Add User
-
-
+
diff --git a/project_template/default/src/Main.hs b/project_template/default/src/Main.hs
--- a/project_template/default/src/Main.hs
+++ b/project_template/default/src/Main.hs
@@ -79,7 +79,7 @@
-- This action is only run once, regardless of whether development or
-- production mode is in use.
getConf :: IO (Config Snap AppConfig)
-getConf = commandLineConfig defaultConfig
+getConf = commandLineAppConfig defaultConfig
------------------------------------------------------------------------------
diff --git a/snap.cabal b/snap.cabal
--- a/snap.cabal
+++ b/snap.cabal
@@ -1,5 +1,5 @@
name: snap
-version: 0.9.0.1
+version: 0.9.1
synopsis: Snap: A Haskell Web Framework: project starter executable and glue code library
description: Snap Framework project starter executable and glue code library
license: BSD3
@@ -27,7 +27,9 @@
project_template/default/static/screen.css,
project_template/default/snaplets/heist/templates/base.tpl,
project_template/default/snaplets/heist/templates/index.tpl,
+ project_template/default/snaplets/heist/templates/_login.tpl,
project_template/default/snaplets/heist/templates/login.tpl,
+ project_template/default/snaplets/heist/templates/_new_user.tpl,
project_template/default/snaplets/heist/templates/new_user.tpl,
project_template/default/snaplets/heist/templates/userform.tpl,
project_template/default/src/Application.hs,
@@ -136,8 +138,8 @@
mtl > 2.0 && < 2.2,
mwc-random >= 0.8 && < 0.13,
pwstore-fast >= 2.2 && < 2.3,
- snap-core >= 0.9 && < 0.10,
- snap-server >= 0.9 && < 0.10,
+ snap-core >= 0.9.1 && < 0.10,
+ snap-server >= 0.9.1 && < 0.10,
stm >= 2.2 && < 2.4,
syb >= 0.1 && < 0.4,
template-haskell >= 2.2 && < 2.8,
@@ -191,7 +193,7 @@
directory-tree >= 0.10 && < 0.11,
filepath >= 1.1 && < 1.4,
old-time >= 1.0 && < 1.2,
- snap-server >= 0.9 && < 0.10,
+ snap-server >= 0.9.1 && < 0.10,
template-haskell >= 2.2 && < 2.8,
text >= 0.11 && < 0.12
diff --git a/src/Snap/Snaplet.hs b/src/Snap/Snaplet.hs
--- a/src/Snap/Snaplet.hs
+++ b/src/Snap/Snaplet.hs
@@ -96,6 +96,7 @@
-- $routes
, addRoutes
, wrapHandlers
+ , wrapSite
-- * Handlers
, Handler
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
@@ -217,8 +217,8 @@
------------------------------------------------------------------------------
-- | The 'Initializer' for 'Heist'. This function is a convenience wrapper
--- around `heistInit'` that uses the default `mempty` HeistState and sets up
--- routes for all the templates.
+-- around `heistInit'` that uses defaultHeistState and sets up routes for all
+-- the templates.
--
heistInit :: FilePath -- ^ Path to templates
-> SnapletInit b (Heist b)
diff --git a/src/Snap/Snaplet/Internal/Initializer.hs b/src/Snap/Snaplet/Internal/Initializer.hs
--- a/src/Snap/Snaplet/Internal/Initializer.hs
+++ b/src/Snap/Snaplet/Internal/Initializer.hs
@@ -14,6 +14,7 @@
, onUnload
, addRoutes
, wrapHandlers
+ , wrapSite
, runInitializer
, runSnaplet
, combineConfig
@@ -366,16 +367,32 @@
------------------------------------------------------------------------------
--- | Wraps the snaplet's routing. This can be used to provide a snaplet that
--- does per-request setup and cleanup, but then dispatches to the rest of the
--- application.
-wrapHandlers :: (Handler b v () -> Handler b v ()) -> Initializer b v ()
-wrapHandlers f0 = do
+-- | Wraps the snaplet's routing. When all is said and done, a snaplet's
+-- routes end up getting combined into a single 'Handler' action. This
+-- function allows you to modify that Handler before it actually gets served.
+-- This allows you to do things that need to happen for every request handled
+-- by your snaplet. Here are some examples of things you might do:
+--
+-- @wrapSite (\site -> removePathTrailingSlashes >> site)@
+-- @wrapSite (\site -> logHandlerStart >> site >> logHandlerFinished)@
+-- @wrapSite (\site -> ensureAdminUser >> site)@
+wrapSite :: (Handler b v () -> Handler b v ())
+ -- ^ Handler modifier function
+ -> Initializer b v ()
+wrapSite f0 = do
f <- mungeFilter f0
iModify (\v -> modL hFilter (f.) v)
------------------------------------------------------------------------------
+-- | This function has been renamed to 'wrapSite' and is deprecated. It will
+-- be removed in the next major Snap release. Fix your code now!
+wrapHandlers :: (Handler b v () -> Handler b v ()) -> Initializer b v ()
+wrapHandlers = wrapSite
+{-# DEPRECATED wrapHandlers "wrapHandlers was renamed to wrapSite" #-}
+
+
+------------------------------------------------------------------------------
mungeFilter :: (Handler b v () -> Handler b v ())
-> Initializer b v (Handler b b () -> Handler b b ())
mungeFilter f = do
@@ -418,9 +435,11 @@
mkReloader :: FilePath
-> String
-> MVar (Snaplet b)
+ -> IORef (IO ())
-> Initializer b b (Snaplet b)
-> IO (Either Text Text)
-mkReloader cwd env mvar i = do
+mkReloader cwd env mvar cleanupRef i = do
+ join $ readIORef cleanupRef
!res <- runInitializer' mvar env i cwd
either (return . Left) good res
where
@@ -462,11 +481,11 @@
-> FilePath
-> IO (Either Text (Snaplet b, InitializerState b))
runInitializer' mvar env b@(Initializer i) cwd = do
+ cleanupRef <- newIORef (return ())
let builtinHandlers = [("/admin/reload", reloadSite)]
let cfg = SnapletConfig [] cwd Nothing "" empty [] Nothing
- (mkReloader cwd env mvar b)
+ (mkReloader cwd env mvar cleanupRef b)
logRef <- newIORef ""
- cleanupRef <- newIORef (return ())
let body = do
((res, s), (Hook hook)) <- runWriterT $ LT.runLensT i id $
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
@@ -91,7 +91,7 @@
, ("/sessionDemo", sessionDemo)
, ("/sessionTest", sessionTest)
]
- wrapHandlers (<|> heistServe)
+ wrapSite (<|> heistServe)
return $ App hs (modL snapletValue fooMod fs) bs sm ns