reconnect XMPP when NetWatcher notices a change

This commit is contained in:
Joey Hess 2012-10-27 00:42:14 -04:00
parent 9fc8257392
commit 2dc40ecbd1
6 changed files with 58 additions and 19 deletions

View file

@ -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 ()))

View file

@ -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)