diff options
author | Joey Hess <joey@kitenet.net> | 2012-10-26 19:42:24 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-10-26 19:42:24 -0400 |
commit | 117df9c3714f2366d4f10d63fce41a608d96308e (patch) | |
tree | 47155e8948b3137cf2ee527afe2984899a3685eb /Utility | |
parent | d2b9c300b12a025de66f39efafd7962dc591a330 (diff) | |
parent | 26fb68355b4ad95f99b2d14110e683109d0bab3d (diff) |
Merge branch 'master' into xmpp
Conflicts:
Assistant/Threads/NetWatcher.hs
Diffstat (limited to 'Utility')
-rw-r--r-- | Utility/DBus.hs | 16 |
1 files changed, 8 insertions, 8 deletions
diff --git a/Utility/DBus.hs b/Utility/DBus.hs index 3b34e00ac..a1a4c4804 100644 --- a/Utility/DBus.hs +++ b/Utility/DBus.hs @@ -5,7 +5,7 @@ - Licensed under the GNU GPL version 3 or higher. -} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-} module Utility.DBus where @@ -65,15 +65,15 @@ runClient getaddr clientaction = do - If the connection is lost, runs onretry, which can do something like - a delay, or printing a warning, and has a state value (useful for - exponential backoff). Once onretry returns, the connection is retried. - - - - Warning: Currently connectWith can throw a SocketError and leave behind - - an open FD. So each retry leaks one FD. -} + -} persistentClient :: IO (Maybe Address) -> v -> (SomeException -> v -> IO v) -> (Client -> IO ()) -> IO () -persistentClient getaddr v onretry clientaction = do +persistentClient getaddr v onretry clientaction = {- runClient can fail with not just ClientError, but also other - - things, if dbus is not running. -} - r <- E.try (runClient getaddr clientaction) :: IO (Either SomeException ()) - either retry return r + - 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) + ] where retry e = do v' <- onretry e v |