reconnect XMPP when NetWatcher notices a change

2 files changed, 20 insertions, 6 deletions

diff --git a/Utility/DBus.hs b/Utility/DBus.hs
index a1a4c4804..d31c20d54 100644
--- a/Utility/DBus.hs
+++ b/Utility/DBus.hs
@@ -9,6 +9,8 @@
 
 module Utility.DBus where
 
+import Utility.Exception
+
 import DBus.Client
 import DBus
 import Data.Maybe
@@ -70,10 +72,7 @@ persistentClient :: IO (Maybe Address) -> v -> (SomeException -> v -> IO v) -> (
 persistentClient getaddr v onretry clientaction =
 	{- runClient can fail with not just ClientError, but also other
 	 - things, if dbus is not running. Let async exceptions through. -}
-	runClient getaddr clientaction `E.catches`
-		[ Handler (\ (e :: AsyncException) -> E.throw e)
-		, Handler (\ (e :: SomeException) -> retry e)
-		]
+	runClient getaddr clientaction `catchNonAsync` retry
 	where
 		retry e = do
 			v' <- onretry e v
@@ -81,5 +80,5 @@ persistentClient getaddr v onretry clientaction =
 
 {- Catches only ClientError -}
 catchClientError :: IO () -> (ClientError -> IO ()) -> IO ()
-catchClientError io handler = do
+catchClientError io handler =
 	either handler return =<< (E.try io :: IO (Either ClientError ()))
diff --git a/Utility/Exception.hs b/Utility/Exception.hs
index 8b6077743..45f2aecec 100644
--- a/Utility/Exception.hs
+++ b/Utility/Exception.hs
@@ -1,10 +1,12 @@
-{- Simple IO exception handling
+{- Simple IO exception handling (and some more)
  -
  - Copyright 2011-2012 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE ScopedTypeVariables #-}
+
 module Utility.Exception where
 
 import Prelude hiding (catch)
@@ -34,3 +36,16 @@ catchIO = catch
 {- try specialized for IO errors only -}
 tryIO :: IO a -> IO (Either IOException a)
 tryIO = try
+
+{- Catches all exceptions except for async exceptions.
+ - This is often better to use than catching them all, so that
+ - ThreadKilled and UserInterrupt get through.
+ -}
+catchNonAsync :: IO a -> (SomeException -> IO a) -> IO a
+catchNonAsync a onerr = a `catches`
+	[ Handler (\ (e :: AsyncException) -> throw e)
+	, Handler (\ (e :: SomeException) -> onerr e)
+	]
+
+tryNonAsync :: IO a -> IO (Either SomeException a)
+tryNonAsync a = (Right <$> a) `catchNonAsync` (return . Left)