Permalink
Browse files

Port to the new Heist API

  • Loading branch information...
1 parent 7da5a64 commit bde4a8a622fe78c3045eca280ad5a4b4b5a2d934 @mightybyte mightybyte committed Jun 10, 2013
View
4 snap.cabal
@@ -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 @@ Library
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,
View
100 src/Snap/Snaplet/Auth/SpliceHelpers.hs
@@ -1,6 +1,6 @@
-{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
@@ -27,7 +27,6 @@ module Snap.Snaplet.Auth.SpliceHelpers
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 @@ addAuthSplices
-- ^ 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 @@ addAuthSplices h auth = addConfig h $ mempty
-- | 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 = unionWith const fields 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 auth = do
-- > <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 auth = do
-- > <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
-------------------------------------------------------------------------------
View
5 src/Snap/Snaplet/Heist.hs
@@ -56,7 +56,6 @@ module Snap.Snaplet.Heist
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 @@ heistServeSingle t = withTop' heistLens (Unclassed.heistServeSingle t)
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 @@ renderWithSplices = Unclassed.renderWithSplices' heistLens
-- | 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
View
1 src/Snap/Snaplet/Heist/Internal.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE TemplateHaskell #-}
module Snap.Snaplet.Heist.Internal where
import Prelude hiding ((.), id)
View
8 src/Snap/Snaplet/HeistNoClass.hs
@@ -503,7 +503,7 @@ heistLocal heist f m = heistLocal' (subSnaplet heist) f m
------------------------------------------------------------------------------
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 +512,7 @@ withSplices' heist splices m = do
------------------------------------------------------------------------------
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 +521,7 @@ withSplices heist splices m = withSplices' (subSnaplet heist) splices m
------------------------------------------------------------------------------
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 +530,7 @@ renderWithSplices' heist t splices =
------------------------------------------------------------------------------
renderWithSplices :: SnapletLens b (Heist b)
-> ByteString
- -> [(Text, SnapletISplice b)]
+ -> Splices (SnapletISplice b)
-> Handler b v ()
renderWithSplices heist t splices =
renderWithSplices' (subSnaplet heist) t splices

0 comments on commit bde4a8a

Please sign in to comment.