diff --git a/snap.cabal b/snap.cabal --- a/snap.cabal +++ b/snap.cabal @@ -1,5 +1,5 @@ name: snap -version: 0.10.0.1 +version: 0.11.0 synopsis: Top-level package for the Snap Web Framework description: This is the top-level package for the official Snap Framework libraries. @@ -106,6 +106,8 @@ Snap.Snaplet Snap.Snaplet.Heist Snap.Snaplet.HeistNoClass + Snap.Snaplet.Heist.Compiled + Snap.Snaplet.Heist.Interpreted Snap.Snaplet.Auth Snap.Snaplet.Auth.Backends.JsonFile Snap.Snaplet.Config @@ -148,11 +150,12 @@ directory >= 1.0 && < 1.3, directory-tree >= 0.10 && < 0.12, dlist >= 0.5 && < 0.6, + either >= 3.1 && < 3.2, errors >= 1.3 && < 1.4, filepath >= 1.1 && < 1.4, - hashable >= 1.1 && < 1.2, - heist >= 0.10 && < 0.11, - lens >= 3.7.0.1 && < 3.8, + hashable >= 1.1 && < 1.3, + heist >= 0.11 && < 0.12, + lens >= 3.7.0.1 && < 3.9, logict >= 0.4.2 && < 0.6, mtl > 2.0 && < 2.2, mwc-random >= 0.8 && < 0.13, diff --git a/src/Control/Access/RoleBased/Internal/Role.hs b/src/Control/Access/RoleBased/Internal/Role.hs --- a/src/Control/Access/RoleBased/Internal/Role.hs +++ b/src/Control/Access/RoleBased/Internal/Role.hs @@ -26,11 +26,11 @@ ------------------------------------------------------------------------------ instance Hashable RoleValue where - hashWithSalt salt (RoleBool e) = hashWithSalt salt e `combine` 7 - hashWithSalt salt (RoleText t) = hashWithSalt salt t `combine` 196613 - hashWithSalt salt (RoleInt i) = hashWithSalt salt i `combine` 12582917 + hashWithSalt salt (RoleBool e) = hashWithSalt salt e `hashWithSalt` (7 :: Int) + hashWithSalt salt (RoleText t) = hashWithSalt salt t `hashWithSalt` (196613 :: Int) + hashWithSalt salt (RoleInt i) = hashWithSalt salt i `hashWithSalt` (12582917 :: Int) hashWithSalt salt (RoleDouble d) = - hashWithSalt salt d `combine` 1610612741 + hashWithSalt salt d `hashWithSalt` (1610612741 :: Int) ------------------------------------------------------------------------------ diff --git a/src/Snap/Snaplet/Auth.hs b/src/Snap/Snaplet/Auth.hs --- a/src/Snap/Snaplet/Auth.hs +++ b/src/Snap/Snaplet/Auth.hs @@ -66,6 +66,7 @@ -- * Splice helpers , addAuthSplices , compiledAuthSplices + , userCSplices , ifLoggedIn , ifLoggedOut , loggedInUser 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 @@ -14,6 +14,7 @@ ( addAuthSplices , compiledAuthSplices + , userCSplices , ifLoggedIn , ifLoggedOut , loggedInUser @@ -23,12 +24,16 @@ ) where 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 import Heist import qualified Heist.Interpreted as I import qualified Heist.Compiled as C +import Heist.Splices import Snap.Snaplet import Snap.Snaplet.Auth.AuthManager @@ -62,6 +67,24 @@ [ ("ifLoggedIn", cIfLoggedIn auth) , ("ifLoggedOut", cIfLoggedOut auth) , ("loggedInUser", cLoggedInUser auth) + ] + + +userCSplices :: Monad m => [(Text, C.Promise AuthUser -> C.Splice m)] +userCSplices = (C.pureSplices $ C.textSplices + [ ("login", userLogin) + , ("email", maybe "-" id . userEmail) + , ("active", T.pack . show . isNothing . userSuspendedAt) + , ("loginCount", T.pack . show . userLoginCount) + , ("failedCount", T.pack . show . userFailedLoginCount) + , ("loginAt", maybe "-" (T.pack . show) . userCurrentLoginAt) + , ("lastLoginAt", maybe "-" (T.pack . show) . userLastLoginAt) + , ("suspendedAt", maybe "-" (T.pack . show) . userSuspendedAt) + , ("loginIP", maybe "-" decodeUtf8 . userCurrentLoginIp) + , ("lastLoginIP", maybe "-" decodeUtf8 . userLastLoginIp) + ]) ++ + [ ("ifActive", ifCSplice (isNothing . userSuspendedAt)) + , ("ifSuspended", ifCSplice (isJust . userSuspendedAt)) ] diff --git a/src/Snap/Snaplet/Heist.hs b/src/Snap/Snaplet/Heist.hs --- a/src/Snap/Snaplet/Heist.hs +++ b/src/Snap/Snaplet/Heist.hs @@ -66,7 +66,7 @@ -- how the heist snaplet might be declared: -- -- > data App = App { _heist :: Snaplet (Heist App) } --- > mkLabels [''App] +-- > makeLenses ''App -- > -- > instance HasHeist App where heistLens = subSnaplet heist -- > diff --git a/src/Snap/Snaplet/Heist/Compiled.hs b/src/Snap/Snaplet/Heist/Compiled.hs new file mode 100644 --- /dev/null +++ b/src/Snap/Snaplet/Heist/Compiled.hs @@ -0,0 +1,80 @@ +{- | A module exporting only functions for using compiled templates. If you + - import the main Snap.Snaplet.Heist module, it's easy to accidentally use + - the interpreted render function even when you're using compiled Heist. + - Importing only this module will make it harder to make mistakes like that. + -} +module Snap.Snaplet.Heist.Compiled + ( H.Heist + , H.HasHeist(..) + , H.SnapletHeist + , H.SnapletCSplice + + -- * Initializer Functions + -- $initializerSection + , H.heistInit + , H.heistInit' + , H.addTemplates + , H.addTemplatesAt + , H.addConfig + , H.modifyHeistState + , H.withHeistState + + -- * Handler Functions + -- $handlerSection + , render + , renderAs + , heistServe + , heistServeSingle + + , H.clearHeistCache + ) where + +import Data.ByteString (ByteString) +import Snap.Snaplet +import qualified Snap.Snaplet.Heist as H + + +------------------------------------------------------------------------------ +-- | Renders a compiled template as text\/html. If the given template is not +-- found, this returns 'empty'. +render :: H.HasHeist b + => ByteString + -- ^ Template name + -> Handler b v () +render = H.cRender + + +------------------------------------------------------------------------------ +-- | Renders a compiled template as the given content type. If the given +-- template is not found, this returns 'empty'. +renderAs :: H.HasHeist b + => ByteString + -- ^ Content type to render with + -> ByteString + -- ^ Template name + -> Handler b v () +renderAs = H.cRenderAs + + +------------------------------------------------------------------------------ +-- | A handler that serves all the templates (similar to 'serveDirectory'). +-- If the template specified in the request path is not found, it returns +-- 'empty'. Also, this function does not serve any templates beginning with +-- an underscore. This gives you a way to prevent some templates from being +-- served. For example, you might have a template that contains only the +-- navbar of your pages, and you probably wouldn't want that template to be +-- visible to the user as a standalone template. So if you put it in a file +-- called \"_nav.tpl\", this function won't serve it. +heistServe :: H.HasHeist b => Handler b v () +heistServe = H.cHeistServe + + +------------------------------------------------------------------------------ +-- | Handler for serving a single template (similar to 'fileServeSingle'). If +-- the given template is not found, this throws an error. +heistServeSingle :: H.HasHeist b + => ByteString + -- ^ Template name + -> Handler b v () +heistServeSingle = H.cHeistServeSingle + diff --git a/src/Snap/Snaplet/Heist/Interpreted.hs b/src/Snap/Snaplet/Heist/Interpreted.hs new file mode 100644 --- /dev/null +++ b/src/Snap/Snaplet/Heist/Interpreted.hs @@ -0,0 +1,37 @@ +{- | A module exporting only functions for using interpreted templates. If + - you import the main Snap.Snaplet.Heist module, it's easy to accidentally + - use the compiled render function even when you're using interpreted Heist. + - Importing only this module will make it harder to make mistakes like that. + -} +module Snap.Snaplet.Heist.Interpreted + ( Heist + , HasHeist(..) + , SnapletHeist + , SnapletISplice + + -- * Initializer Functions + -- $initializerSection + , heistInit + , heistInit' + , addTemplates + , addTemplatesAt + , addConfig + , modifyHeistState + , withHeistState + , addSplices + + -- * Handler Functions + -- $handlerSection + , render + , renderAs + , heistServe + , heistServeSingle + , heistLocal + , withSplices + , renderWithSplices + + , clearHeistCache + ) where + +import Snap.Snaplet.Heist + 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 @@ -192,7 +192,7 @@ (hs,cts) <- toTextErrors $ initHeistWithCacheTag hc return $ Running hs cts where - toTextErrors = mapEitherT (T.pack . intercalate "\n") id + toTextErrors = bimapEitherT (T.pack . intercalate "\n") id finalLoadHook (Running _ _) = left "finalLoadHook called while running" @@ -325,8 +325,8 @@ ------------------------------------------------------------------------------ -- | Internal helper function for rendering. cRenderHelper :: Maybe MIMEType - -> ByteString - -> Handler b (Heist b) () + -> ByteString + -> Handler b (Heist b) () cRenderHelper c t = do (Running hs _) <- get withTop' id $ maybe pass serve $ C.renderTemplate hs t @@ -355,16 +355,16 @@ ------------------------------------------------------------------------------ cRender :: ByteString -- ^ Name of the template - -> Handler b (Heist b) () + -> Handler b (Heist b) () cRender t = cRenderHelper Nothing t ------------------------------------------------------------------------------ cRenderAs :: ByteString -- ^ Content type - -> ByteString + -> ByteString -- ^ Name of the template - -> Handler b (Heist b) () + -> Handler b (Heist b) () cRenderAs ct t = cRenderHelper (Just ct) t diff --git a/test/snap-testsuite.cabal b/test/snap-testsuite.cabal --- a/test/snap-testsuite.cabal +++ b/test/snap-testsuite.cabal @@ -35,7 +35,7 @@ errors >= 1.3 && < 1.4, filepath >= 1.1 && < 1.4, hashable >= 1.1 && < 1.2, - heist >= 0.10 && < 0.11, + heist >= 0.10 && < 0.12, lens >= 3.7.0.1 && < 3.8, logict >= 0.4.2 && < 0.6, mtl > 2.0 && < 2.2, @@ -98,7 +98,7 @@ errors >= 1.3 && < 1.4, filepath >= 1.1 && < 1.4, hashable >= 1.1 && < 1.2, - heist >= 0.10 && < 0.11, + heist >= 0.10 && < 0.12, lens >= 3.7.0.1 && < 3.8, logict >= 0.4.2 && < 0.6, mtl > 2.0 && < 2.2, @@ -171,7 +171,7 @@ errors >= 1.3 && < 1.4, filepath >= 1.1 && < 1.4, hashable >= 1.1 && < 1.2, - heist >= 0.10 && < 0.11, + heist >= 0.10 && < 0.12, lens >= 3.7.0.1 && < 3.8, logict >= 0.4.2 && < 0.6, mtl > 2.0 && < 2.2,