reconnect XMPP when NetWatcher notices a change
This commit is contained in:
parent
9fc8257392
commit
2dc40ecbd1
6 changed files with 58 additions and 19 deletions
|
@ -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 ()))
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue