fix build with xmpp and w/o webapp

diff --git a/Assistant/Threads/XMPPClient.hs b/Assistant/Threads/XMPPClient.hs
index 1242c1d7409543e764953c9df65fcf789fe471d2..8ccb241bb0e4f2d739465714cdad57fe75a9e58c 100644 (file)
--- 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 62b21f3bdf86a0d31ffa271de09d5ced2a53494e..e1bce6b581bed6e4166aa1eeee493ad2b7db8adb 100644 (file)
--- 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 135c68fbcfbe83882eaf956d0fdda2aa17338780..f90af408057e44bb5b33c8cad16b7d762ec9b718 100644 (file)
--- 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