diff options
| author |  Joey Hess <joey@kitenet.net> | 2012-10-27 00:42:14 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2012-10-27 00:42:14 -0400 |
| commit | ce5b38aa1dbd1e320c5247d95344e373bf03e7cf (patch) | |
| tree | 99e55c492457520f016188e00ba553c23f8bc187 /Utility/DBus.hs | |
| parent | 5b7d00b6e9f79f4e0a2093feea58ad164a766ab2 (diff) | |
reconnect XMPP when NetWatcher notices a change
Diffstat (limited to 'Utility/DBus.hs')
| -rw-r--r-- | Utility/DBus.hs | 9 |
1 files changed, 4 insertions, 5 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 ())) |