diff --git a/snap-utils.cabal b/snap-utils.cabal --- a/snap-utils.cabal +++ b/snap-utils.cabal @@ -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 diff --git a/src/Snap/Utils.hs b/src/Snap/Utils.hs --- a/src/Snap/Utils.hs +++ b/src/Snap/Utils.hs @@ -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. diff --git a/src/Snap/Utils/Alert.hs b/src/Snap/Utils/Alert.hs --- a/src/Snap/Utils/Alert.hs +++ b/src/Snap/Utils/Alert.hs @@ -1,7 +1,54 @@ {-# LANGUAGE OverloadedStrings #-} +{-| + +There are two components to the @Alerts@ module. + + 1. 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. + +> +>
+>
+> +> +>
+>
+> + +@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. , +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 +-- @\@ tag with nested tags of @\@ and +-- @\@ 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] diff --git a/src/Snap/Utils/Environment.hs b/src/Snap/Utils/Environment.hs --- a/src/Snap/Utils/Environment.hs +++ b/src/Snap/Utils/Environment.hs @@ -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: + +> +> +> +> +> +> +> +> + +The @\@ 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 @\@ splices to Heist state. addEnvironmentSplices :: HasHeist b => Snaplet (Heist b) -> Initializer b v () addEnvironmentSplices h = do env <- T.pack <$> getEnvironment