snap 0.13.2.9 → 0.13.3
raw patch · 8 files changed
+43/−35 lines, 8 filesdep ~basedep ~heist
Dependency ranges changed: base, heist
Files
- project_template/default/foo.cabal +1/−1
- snap.cabal +2/−2
- src/Snap/Snaplet/Auth/SpliceHelpers.hs +18/−13
- src/Snap/Snaplet/Heist/Internal.hs +4/−3
- src/Snap/Snaplet/HeistNoClass.hs +9/−7
- test/snap-testsuite.cabal +3/−3
- test/suite/Blackbox/App.hs +3/−3
- test/suite/Blackbox/FooSnaplet.hs +3/−3
project_template/default/foo.cabal view
@@ -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,
snap.cabal view
@@ -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,
src/Snap/Snaplet/Auth/SpliceHelpers.hs view
@@ -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 @@ -- > <ifLoggedIn> Show this when there is a logged in user </ifLoggedIn> 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 @@ -- > <ifLoggedOut> Show this when there is a logged in user </ifLoggedOut> 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
src/Snap/Snaplet/Heist/Internal.hs view
@@ -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
src/Snap/Snaplet/HeistNoClass.hs view
@@ -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), ()) -----------------------
test/snap-testsuite.cabal view
@@ -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,
test/suite/Blackbox/App.hs view
@@ -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)
test/suite/Blackbox/FooSnaplet.hs view
@@ -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)