snap-utils 0.1.0 → 0.1.1
raw patch · 4 files changed
+168/−41 lines, 4 files
Files
- snap-utils.cabal +6/−3
- src/Snap/Utils.hs +41/−5
- src/Snap/Utils/Alert.hs +85/−32
- src/Snap/Utils/Environment.hs +36/−1
snap-utils.cabal view
@@ -1,7 +1,10 @@ name: snap-utils-version: 0.1.0-synopsis: Snap Framework utility funtions.-description: Utilities for Snap Framework apps.+version: 0.1.1+synopsis: Snap Framework utilities.+description: Snap.Utils provides helper modules for making web apps+ with Snap Framework. The underlying design goal is to rely on more+ traditional HTTP-based methods of stateless control flow instead of+ relying on cookies and server state continuations. license: BSD3 author: Luke Hoersten maintainer: Luke Hoersten <luke@hoersten.org>
src/Snap/Utils.hs view
@@ -1,11 +1,47 @@+{-|++@Snap.Utils@ provides helper modules for making web apps with Snap+Framework. The underlying design goal is to rely on more traditional+HTTP-based methods of stateless control flow instead of relying on+cookies and server state continuations.++-}+ module Snap.Utils- ( module Snap.Utils.Alert- , module Snap.Utils.Environment- , module Snap.Utils.ErrorLogger- , module Snap.Utils.TargetPage- ) where+ ( module Snap.Utils.Alert+ -- $alerts+ , module Snap.Utils.Environment+ -- $environment+ , module Snap.Utils.ErrorLogger+ -- $errorlogger+ , module Snap.Utils.TargetPage+ -- $targetpage+ ) where import Snap.Utils.Alert import Snap.Utils.Environment import Snap.Utils.ErrorLogger import Snap.Utils.TargetPage++-- $alerts+--+-- 'Alerts' uses GET request URI query parameters to display an alert on the+-- next response page.++-- $environment+--+-- 'Environment' splices the @-e@ runtime environment (ex: devel,+-- prod, etc.) name into a template tag. This allows for splicing+-- certain content only when in a specific runtime environment.++-- $errorlogger+--+-- 'ErrorLogger' catches exceptions that are thrown all the way to the+-- top of the site and handles them cleanly without crashing the+-- application server.++-- $targetpage+--+-- 'TargetPage' captures the desired target page when interim pages+-- need to be visited first before continuing onto the target page+-- afterwards.
src/Snap/Utils/Alert.hs view
@@ -1,7 +1,54 @@ {-# LANGUAGE OverloadedStrings #-} +{-|++There are two components to the @Alerts@ module.++ 1. <http://hackage.haskell.org/package/heist Heist> splices for rendering the alerts++ 2. Alert redirection helpers which pass the alert type and message+ via the HTTP GET query string.++First the Heist splices can be added with the 'addAlertSplices'+function which takes the Heist Snaplet as an argument.++> initApp :: SnapletInit App App+> initApp = makeSnaplet "app" "An snaplet example application." Nothing $ do+> h <- nestSnaplet "heist" heist $ heistInit "templates"+> addAlertSplices h+> return $ App h++Second, generate an alert in a handler.++> import Snap.Utils.Alert (alertSuccess)+>+> actionSuccess :: Handler App App ()+> actionSuccess reg = alertSuccess msg url+> where msg = "Successfully completed an action!"+> url = "/"++Third, ensure the Heist template has a place to bind alerts.++> <alerts>+> <div class="alerts">+> <div class="fade in alert alert-${alert-type} alert-dismissable">+> <button type="button" class="close" data-dismiss="alert">×</button>+> <strong><alert-text/></strong>+> </div>+> </div>+> </alerts>++@Snap.Utils.Alert@ is different from similar modules because it relies+on more traditional HTTP-based methods of stateless control flow like+GET queries instead of relying on cookies and server state+continuations. <http://hackage.haskell.org/package/snap-extras/docs/Snap-Extras-FlashNotice.html Snap.Extras.FlashNotice>,+for example, uses cookies to store alert state.++-}+ module Snap.Utils.Alert- ( addAlertSplices+ ( AlertType(..)+ , addAlertSplices , alertRedirect , alertRedirect' , alertSuccess@@ -9,36 +56,38 @@ , alertWarning , alertDanger , alertUrl- , AlertType(..) ) where --import Control.Applicative ((<$>), (<*>))-import Control.Arrow ((***))-import Control.Monad (liftM2)-import Control.Monad.Trans (lift)-import Data.ByteString (ByteString)-import qualified Data.ByteString.Char8 as B-import Data.Monoid (mempty)-import Data.Text (Text)-import qualified Data.Text.Encoding as T-import Heist (HeistConfig (..), RuntimeSplice,- Splices, mapS, noSplices)-import Heist.Compiled (Splice, callTemplate, codeGen,- pureSplice, textSplice,- withLocalSplices, yieldRuntime)-import Heist.Interpreted (callTemplateWithText)-import Heist.SpliceAPI (( #! ), ($$))-import Snap.Core (MonadSnap, getParam, redirect)-import Snap.Snaplet (Initializer, Snaplet)-import Snap.Snaplet.Heist (HasHeist, Heist, SnapletCSplice,- SnapletISplice, addConfig)-import Snap.Utils.Types (URL)+import Control.Applicative ((<$>), (<*>))+import Control.Arrow ((***))+import Control.Monad (liftM2)+import Control.Monad.Trans (lift)+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as B+import Data.Monoid (mempty)+import Data.Text (Text)+import qualified Data.Text.Encoding as T+import Heist (HeistConfig (..), RuntimeSplice,+ Splices, mapS, noSplices)+import Heist.Compiled (Splice, callTemplate, codeGen,+ pureSplice, textSplice,+ withLocalSplices, yieldRuntime)+import Heist.Interpreted (callTemplateWithText)+import Heist.SpliceAPI (( #! ), ($$))+import Network.HTTP.Types.URI (SimpleQuery, renderSimpleQuery)+import Snap.Core (MonadSnap, getParam, redirect)+import Snap.Snaplet (Initializer, Snaplet)+import Snap.Snaplet.Heist (HasHeist, Heist, SnapletCSplice,+ SnapletISplice, addConfig)+import Snap.Utils.Types (URL) data AlertType = Success | Info | Warning | Danger deriving Show +-- | Add the compiled and interpreted alert splices to the+-- @\<alerts\>@ tag with nested tags of @\<alert-text\>@ and+-- @\<alert-type\>@ which will be bound to an 'AlertType'. addAlertSplices :: HasHeist b => Snaplet (Heist b) -> Initializer b v () addAlertSplices h = addConfig h $ mempty { hcCompiledSplices = ("alerts" #! alertCSplice)@@ -46,26 +95,33 @@ } +-- | 302 redirect to the target page URL with the specified+-- 'AlertType' and message. alertRedirect :: MonadSnap m => AlertType -> Text -> URL -> m a alertRedirect typ msg url = alertRedirect' typ msg url [] -alertRedirect' :: MonadSnap m => AlertType -> Text -> URL -> [(ByteString, ByteString)] -> m a+-- | Same as 'alertRedirect' but accepts additional query parameters.+alertRedirect' :: MonadSnap m => AlertType -> Text -> URL -> SimpleQuery -> m a alertRedirect' typ msg url params = redirect $ alertUrl typ msg url params +-- | 'alertRedirect' with 'Success' alertSuccess :: MonadSnap m => Text -> URL -> m a alertSuccess = alertRedirect Success +-- | 'alertRedirect' with 'Info' alertInfo :: MonadSnap m => Text -> URL -> m a alertInfo = alertRedirect Info +-- | 'alertRedirect' with 'Warning' alertWarning :: MonadSnap m => Text -> URL -> m a alertWarning = alertRedirect Warning +-- | 'alertRedirect' with 'Danger' alertDanger :: MonadSnap m => Text -> URL -> m a alertDanger = alertRedirect Danger @@ -98,8 +154,10 @@ "alert-text" #! snd -alertUrl :: AlertType -> Text -> URL -> [(ByteString, ByteString)] -> URL-alertUrl typ msg url params = B.append url . uriQueryString $+-- | Generate a URL with an alert query string without redirecting to+-- the URL.+alertUrl :: AlertType -> Text -> URL -> SimpleQuery -> URL+alertUrl typ msg url params = B.append url . renderSimpleQuery True $ [("alert-text", T.encodeUtf8 msg), ("alert-type", cssType typ)] ++ params @@ -108,8 +166,3 @@ cssType Info = "info" cssType Warning = "warning" cssType Danger = "danger"---uriQueryString :: [(ByteString, ByteString)] -> URL-uriQueryString = B.append "?" . B.intercalate "&" . map (showPairWith "=")- where showPairWith sep (k, v) = B.concat [k, sep, v]
src/Snap/Utils/Environment.hs view
@@ -1,7 +1,41 @@ {-# LANGUAGE OverloadedStrings #-} -module Snap.Utils.Environment where+{-| +When starting a Snap app, the @-e@ command line flag indicates what+runtime environment to run in. The default is @devel@ which will load+all the @devel.cfg@ Snaplet config files. The 'Environment' module+adds a splice to conditionally render a node list depending on the+string passed to @-e@ on the command line.++Here's an example:++> initApp :: SnapletInit App App+> initApp = makeSnaplet "app" "An snaplet example application." Nothing $ do+> h <- nestSnaplet "heist" heist $ heistInit "templates"+> addEnvironmentSplices h+> return $ App h++Then, in the Heist templates:++> <ifEnvironment name="devel">+> <link href="static/css/bootstrap.min.css" rel="stylesheet">+> <link href="static/css/font-awesome.min.css" rel="stylesheet">+> </ifEnvironment>+> <ifEnvironment name="prod">+> <link href="http://cdn/css/bootstrap.min.css" rel="stylesheet">+> <link href="http://cdn/css/font-awesome.min.css" rel="stylesheet">+> </ifEnvironment>++The @\<ifEnvironment name=\"prod\"\>@ block will only render if the+command line was passed @-e prod@.++-}++module Snap.Utils.Environment+ ( addEnvironmentSplices+ ) where+ import Control.Applicative ((<$>)) import Data.Maybe (fromMaybe) import Data.Monoid (mempty)@@ -16,6 +50,7 @@ import Text.XmlHtml (Node (..), childNodes) +-- | Add @\<ifEnvironment name=\"env\"\>@ splices to Heist state. addEnvironmentSplices :: HasHeist b => Snaplet (Heist b) -> Initializer b v () addEnvironmentSplices h = do env <- T.pack <$> getEnvironment