module Snap.Snaplet.Auth.SpliceHelpers
(
addAuthSplices
, compiledAuthSplices
, ifLoggedIn
, ifLoggedOut
, loggedInUser
, cIfLoggedIn
, cIfLoggedOut
, cLoggedInUser
) where
import Control.Monad.Trans
import Data.Monoid
import Data.Text (Text)
import qualified Text.XmlHtml as X
import Heist
import qualified Heist.Interpreted as I
import qualified Heist.Compiled as C
import Snap.Snaplet
import Snap.Snaplet.Auth.AuthManager
import Snap.Snaplet.Auth.Handlers
import Snap.Snaplet.Auth.Types
import Snap.Snaplet.Heist
addAuthSplices
:: HasHeist b
=> SnapletLens b (AuthManager b)
-> Initializer b v ()
addAuthSplices auth = addSplices
[ ("ifLoggedIn", ifLoggedIn auth)
, ("ifLoggedOut", ifLoggedOut auth)
, ("loggedInUser", loggedInUser auth)
]
compiledAuthSplices :: SnapletLens b (AuthManager b)
-> [(Text, SnapletCSplice b)]
compiledAuthSplices auth =
[ ("ifLoggedIn", cIfLoggedIn auth)
, ("ifLoggedOut", cIfLoggedOut auth)
, ("loggedInUser", cLoggedInUser auth)
]
ifLoggedIn :: SnapletLens b (AuthManager b) -> SnapletISplice b
ifLoggedIn auth = do
chk <- lift $ withTop auth isLoggedIn
case chk of
True -> getParamNode >>= return . X.childNodes
False -> return []
cIfLoggedIn :: SnapletLens b (AuthManager b) -> SnapletCSplice b
cIfLoggedIn auth = do
children <- C.promiseChildren
return $ C.yieldRuntime $ do
chk <- lift $ withTop auth isLoggedIn
case chk of
True -> children
False -> return mempty
ifLoggedOut :: SnapletLens b (AuthManager b) -> SnapletISplice b
ifLoggedOut auth = do
chk <- lift $ withTop auth isLoggedIn
case chk of
False -> getParamNode >>= return . X.childNodes
True -> return []
cIfLoggedOut :: SnapletLens b (AuthManager b) -> SnapletCSplice b
cIfLoggedOut auth = do
children <- C.promiseChildren
return $ C.yieldRuntime $ do
chk <- lift $ withTop auth isLoggedIn
case chk of
False -> children
True -> return mempty
loggedInUser :: SnapletLens b (AuthManager b) -> SnapletISplice b
loggedInUser auth = do
u <- lift $ withTop auth currentUser
maybe (return []) (I.textSplice . userLogin) u
cLoggedInUser :: SnapletLens b (AuthManager b) -> SnapletCSplice b
cLoggedInUser auth =
return $ C.yieldRuntimeText $ do
u <- lift $ withTop auth currentUser
return $ maybe "" userLogin u