From 3ef6b6a200d2f71a3ac96bffb5f90e49e61aa314 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 24 Mar 2013 18:55:19 -0400 Subject: [PATCH] fix build with xmpp and w/o webapp --- Assistant/Threads/XMPPClient.hs | 6 ++++-- Assistant/WebApp/Configurators/XMPP.hs | 28 +++++++++++++----------- Assistant/XMPP/Git.hs | 30 +++++++------------------- 3 files changed, 27 insertions(+), 37 deletions(-) diff --git a/Assistant/Threads/XMPPClient.hs b/Assistant/Threads/XMPPClient.hs index 1242c1d740..8ccb241bb0 100644 --- a/Assistant/Threads/XMPPClient.hs +++ b/Assistant/Threads/XMPPClient.hs @@ -20,6 +20,7 @@ import qualified Remote import Utility.ThreadScheduler import Assistant.WebApp (UrlRenderer, renderUrl) import Assistant.WebApp.Types hiding (liftAssistant) +import Assistant.WebApp.Configurators.XMPP (checkCloudRepos) import Assistant.Alert import Assistant.Pairing import Assistant.XMPP.Git @@ -106,8 +107,9 @@ xmppClient urlrenderer d creds = maybe noop (inAssistant . pairMsgReceived urlrenderer stage u selfjid) (parseJID c) handle _ (GotNetMessage m@(Pushing _ pushstage)) | isPushInitiation pushstage = inAssistant $ - unlessM (queueNetPushMessage m) $ - void $ forkIO <~> handlePushInitiation urlrenderer m + unlessM (queueNetPushMessage m) $ do + let checker = checkCloudRepos urlrenderer + void $ forkIO <~> handlePushInitiation checker m | otherwise = void $ inAssistant $ queueNetPushMessage m handle _ (Ignorable _) = noop handle _ (Unknown _) = noop diff --git a/Assistant/WebApp/Configurators/XMPP.hs b/Assistant/WebApp/Configurators/XMPP.hs index 62b21f3bdf..e1bce6b581 100644 --- a/Assistant/WebApp/Configurators/XMPP.hs +++ b/Assistant/WebApp/Configurators/XMPP.hs @@ -50,21 +50,23 @@ xmppNeeded = whenM (isNothing <$> liftAnnex getXMPPCreds) $ do xmppNeeded = return () #endif -{- Displays an alert suggesting to configure a cloud repo +{- When appropriate, displays an alert suggesting to configure a cloud repo - to suppliment an XMPP remote. -} -cloudRepoNeeded :: UrlRenderer -> UUID -> Assistant () +checkCloudRepos :: UrlRenderer -> Remote -> Assistant () #ifdef WITH_XMPP -cloudRepoNeeded urlrenderer for = do - buddyname <- getBuddyName for - url <- liftIO $ renderUrl urlrenderer (NeedCloudRepoR for) [] - close <- asIO1 removeAlert - void $ addAlert $ cloudRepoNeededAlert buddyname $ AlertButton - { buttonLabel = "Add a cloud repository" - , buttonUrl = url - , buttonAction = Just close - } +checkCloudRepos urlrenderer r = + unlessM (syncingToCloudRemote <$> getDaemonStatus) $ do + buddyname <- getBuddyName $ Remote.uuid r + url <- liftIO $ + renderUrl urlrenderer (NeedCloudRepoR $ Remote.uuid r) [] + close <- asIO1 removeAlert + void $ addAlert $ cloudRepoNeededAlert buddyname $ AlertButton + { buttonLabel = "Add a cloud repository" + , buttonUrl = url + , buttonAction = Just close + } #else -cloudRepoNeeded = return () +checkCloudRepos _ _ = noop #endif {- Returns the name of the friend corresponding to a @@ -88,7 +90,7 @@ getNeedCloudRepoR for = page "Cloud repository needed" (Just Configuration) $ do buddyname <- liftAssistant $ getBuddyName for $(widgetFile "configurators/xmpp/needcloudrepo") #else -needCloudRepoR = xmppPage $ +getNeedCloudRepoR = xmppPage $ $(widgetFile "configurators/xmpp/disabled") #endif diff --git a/Assistant/XMPP/Git.hs b/Assistant/XMPP/Git.hs index 135c68fbcf..f90af40805 100644 --- a/Assistant/XMPP/Git.hs +++ b/Assistant/XMPP/Git.hs @@ -31,10 +31,6 @@ import qualified Remote as Remote import Remote.List import Utility.FileMode import Utility.Shell -#ifdef WITH_WEBAPP -import Assistant.WebApp (UrlRenderer) -import Assistant.WebApp.Configurators.XMPP -#endif import Network.Protocol.XMPP import qualified Data.Text as T @@ -256,11 +252,11 @@ xmppRemotes cid = case baseJID <$> parseJID cid of where matching loc r = repoIsUrl r && repoLocation r == loc -handlePushInitiation :: UrlRenderer -> NetMessage -> Assistant () +handlePushInitiation :: (Remote -> Assistant ()) -> NetMessage -> Assistant () handlePushInitiation _ (Pushing cid CanPush) = unlessM (null <$> xmppRemotes cid) $ sendNetMessage $ Pushing cid PushRequest -handlePushInitiation urlrenderer (Pushing cid PushRequest) = +handlePushInitiation checkcloudrepos (Pushing cid PushRequest) = go =<< liftAnnex (inRepo Git.Branch.current) where go Nothing = noop @@ -276,29 +272,19 @@ handlePushInitiation urlrenderer (Pushing cid PushRequest) = void $ alertWhile (syncAlert [r]) $ xmppPush cid (taggedPush u selfjid branch r) - (handleDeferred urlrenderer) - checkCloudRepos urlrenderer r -handlePushInitiation urlrenderer (Pushing cid StartingPush) = do + (handleDeferred checkcloudrepos) + checkcloudrepos r +handlePushInitiation checkcloudrepos (Pushing cid StartingPush) = do rs <- xmppRemotes cid unless (null rs) $ do void $ alertWhile (syncAlert rs) $ - xmppReceivePack cid (handleDeferred urlrenderer) - mapM_ (checkCloudRepos urlrenderer) rs + xmppReceivePack cid (handleDeferred checkcloudrepos) + mapM_ checkcloudrepos rs handlePushInitiation _ _ = noop -handleDeferred :: UrlRenderer -> NetMessage -> Assistant () +handleDeferred :: (Remote -> Assistant ()) -> NetMessage -> Assistant () handleDeferred = handlePushInitiation -checkCloudRepos :: UrlRenderer -> Remote -> Assistant () --- TODO only display if needed -checkCloudRepos urlrenderer r = -#ifdef WITH_WEBAPP - unlessM (syncingToCloudRemote <$> getDaemonStatus) $ - cloudRepoNeeded urlrenderer (Remote.uuid r) -#else - noop -#endif - writeChunk :: Handle -> B.ByteString -> IO () writeChunk h b = do B.hPut h b