git.gnu.io has moved to IP address 209.51.188.249 -- please double check where you are logging in.

Commit 1f176419 authored by Bryan Richter's avatar Bryan Richter

Put alerts into a module

parent 190da03d
......@@ -42,6 +42,7 @@ library
-- exposed-modules {{{2
exposed-modules:
Alerts
Application
Avatar
Css
......
module Alerts
( alertDanger
, alertInfo
, alertSuccess
, alertWarning
, getAlert
) where
import Prelude
import Control.Monad (liftM)
import Yesod
import Data.Text (Text)
import Text.Blaze.Html.Renderer.Text (renderHtml)
import qualified Data.Text.Lazy as TL
alertKey :: Text
alertKey = "_MSG_ALERT"
addAlert :: MonadHandler m => Text -> Text -> m ()
addAlert level msg = do
render <- getUrlRenderParams
prev <- lookupSession alertKey
setSession alertKey $ maybe id mappend prev $ TL.toStrict $ renderHtml $
[hamlet|
<div .alert .alert-#{level}>
#{msg}
|] render
alertDanger, alertInfo, alertSuccess, alertWarning :: MonadHandler m => Text -> m ()
alertDanger = addAlert "danger"
alertInfo = addAlert "info"
alertSuccess = addAlert "success"
alertWarning = addAlert "warning"
getAlert :: MonadHandler m => m (Maybe Html)
getAlert = do
mmsg <- liftM (fmap preEscapedToMarkup) $ lookupSession alertKey
deleteSession alertKey
return mmsg
......@@ -4,13 +4,11 @@ import Import.NoFoundation
import Blaze.ByteString.Builder.Char.Utf8 (fromText)
import Control.Exception.Lifted (throwIO, handle)
import Control.Monad.Logger
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Data.Char (isSpace)
import Data.Text as T
import Network.HTTP.Conduit (Manager)
import Text.Blaze.Html.Renderer.Text (renderHtml)
import Text.Hamlet (hamletFile)
import Text.Jasmine (minifym)
import Web.Authenticate.BrowserId (browserIdJs)
......@@ -24,7 +22,6 @@ import Yesod.Default.Util (addStaticContentExternal)
import Yesod.Form.Jquery
import Yesod.Static
import qualified Data.ByteString.Lazy.Char8 as LB
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as E
import qualified Database.Persist
import qualified Settings
......@@ -294,7 +291,7 @@ createUser ident passph name newEmail avatar nick = do
return $ Just user_id
Nothing -> do
lift $ addAlert "danger" "Handle already in use."
lift $ alertDanger "Handle already in use."
throwIO DBException
where
newUser langs now account_id =
......@@ -329,49 +326,6 @@ instance RenderMessage App FormMessage where
getExtra :: Handler Extra
getExtra = fmap (appExtra . appSettings) getYesod
-- expanded session messages
-- need to use a seperate key to maintain compatability with Yesod.Auth
alertKey :: Text
alertKey = "_MSG_ALERT"
addAlertEm :: Text -> Text -> Text -> Handler ()
addAlertEm level msg em = do
render <- getUrlRenderParams
prev <- lookupSession alertKey
setSession alertKey $ maybe id mappend prev $ TL.toStrict $ renderHtml $
[hamlet|
<div .alert .alert-#{level}>
<em>#{em}
#{msg}
|] render
-- TODO: don't export this
addAlert :: Text -> Text -> Handler ()
addAlert level msg = do
render <- getUrlRenderParams
prev <- lookupSession alertKey
setSession alertKey $ maybe id mappend prev $ TL.toStrict $ renderHtml $
[hamlet|
<div .alert .alert-#{level}>
#{msg}
|] render
alertDanger, alertInfo, alertSuccess, alertWarning :: Text -> Handler ()
alertDanger = addAlert "danger"
alertInfo = addAlert "info"
alertSuccess = addAlert "success"
alertWarning = addAlert "warning"
getAlert :: Handler (Maybe Html)
getAlert = do
mmsg <- liftM (fmap preEscapedToMarkup) $ lookupSession alertKey
deleteSession alertKey
return mmsg
--------------------------------------------------------------------------------
-- There are FOUR different kinds of database actions, each with a different run function.
......
......@@ -40,6 +40,7 @@ import Yesod.Auth as Import
import Yesod.Form.Bootstrap3 as Import
import Yesod.Markdown as Import (Markdown (..))
import Alerts as Import
import Css as Import
import Local.Esqueleto as Import
import Local.Github as Import
......
......@@ -62,7 +62,7 @@ getGithubIssues :: Project -> Handler [GH.Issue]
getGithubIssues project =
getGithubIssues'
>>= liftIO . wait
>>= either (\_ -> addAlert "danger" eMsg >> return [])
>>= either (\_ -> alertDanger eMsg >> return [])
return
where
eMsg = "failed to fetch GitHub tickets\n"
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment