refactor alert button creation code

This commit is contained in:
Joey Hess 2013-04-04 01:48:26 -04:00
parent 628637c633
commit 8b329c0317
16 changed files with 267 additions and 235 deletions

View file

@ -11,7 +11,7 @@ import Assistant.Common
import Assistant.Pairing
import Assistant.Pairing.Network
import Assistant.Pairing.MakeRemote
import Assistant.WebApp (UrlRenderer, renderUrl)
import Assistant.WebApp (UrlRenderer)
import Assistant.WebApp.Types
import Assistant.Alert
import Assistant.DaemonStatus
@ -101,14 +101,8 @@ pairListenerThread urlrenderer = namedThread "PairListener" $ do
pairReqReceived :: Bool -> UrlRenderer -> PairMsg -> Assistant ()
pairReqReceived True _ _ = noop -- ignore our own PairReq
pairReqReceived False urlrenderer msg = do
url <- liftIO $ renderUrl urlrenderer (FinishLocalPairR msg) []
closealert <- asIO1 removeAlert
void $ addAlert $ pairRequestReceivedAlert repo
AlertButton
{ buttonUrl = url
, buttonLabel = T.pack "Respond"
, buttonAction = Just closealert
}
button <- mkAlertButton (T.pack "Respond") urlrenderer (FinishLocalPairR msg)
void $ addAlert $ pairRequestReceivedAlert repo button
where
repo = pairRepo msg

View file

@ -12,6 +12,7 @@ import Assistant.DaemonStatus
import Assistant.TransferQueue
import Assistant.TransferSlots
import Assistant.Alert
import Assistant.Alert.Utility
import Assistant.Commits
import Assistant.Drop
import Assistant.TransferrerPool

View file

@ -18,7 +18,7 @@ import Assistant.Sync
import Assistant.DaemonStatus
import qualified Remote
import Utility.ThreadScheduler
import Assistant.WebApp (UrlRenderer, renderUrl)
import Assistant.WebApp (UrlRenderer)
import Assistant.WebApp.Types hiding (liftAssistant)
import Assistant.WebApp.Configurators.XMPP (checkCloudRepos)
import Assistant.Alert
@ -281,16 +281,12 @@ pairMsgReceived urlrenderer PairReq theiruuid selfjid theirjid
finishXMPPPairing theirjid theiruuid
-- Show an alert to let the user decide if they want to pair.
showalert = do
let route = ConfirmXMPPPairFriendR $
PairKey theiruuid $ formatJID theirjid
url <- liftIO $ renderUrl urlrenderer route []
close <- asIO1 removeAlert
void $ addAlert $ pairRequestReceivedAlert (T.unpack $ buddyName theirjid)
AlertButton
{ buttonUrl = url
, buttonLabel = T.pack "Respond"
, buttonAction = Just close
}
button <- mkAlertButton (T.pack "Respond") urlrenderer $
ConfirmXMPPPairFriendR $
PairKey theiruuid $ formatJID theirjid
void $ addAlert $ pairRequestReceivedAlert
(T.unpack $ buddyName theirjid)
button
pairMsgReceived _ PairAck theiruuid _selfjid theirjid =
{- PairAck must come from one of the buddies we are pairing with;