unify exception handling into Utility.Exception

Removed old extensible-exceptions, only needed for very old ghc.

Made webdav use Utility.Exception, to work after some changes in DAV's
exception handling.

Removed Annex.Exception. Mostly this was trivial, but note that
tryAnnex is replaced with tryNonAsync and catchAnnex replaced with
catchNonAsync. In theory that could be a behavior change, since the former
caught all exceptions, and the latter don't catch async exceptions.

However, in practice, nothing in the Annex monad uses async exceptions.
Grepping for throwTo and killThread only find stuff in the assistant,
which does not seem related.

Command.Add.undo is changed to accept a SomeException, and things
that use it for rollback now catch non-async exceptions, rather than
only IOExceptions.

Utility/Directory.hs

@@ -11,7 +11,6 @@ module Utility.Directory where
 
 import System.IO.Error
 import System.Directory
-import Control.Exception (throw, bracket)
 import Control.Monad
 import Control.Monad.IfElse
 import System.FilePath
@@ -114,7 +113,7 @@ moveFile src dest = tryIO (rename src dest) >>= onrename
 			whenM (isdir dest) rethrow
 			viaTmp mv dest undefined
 	  where
-		rethrow = throw e
+		rethrow = throwM e
 		mv tmp _ = do
 			ok <- boolSystem "mv" [Param "-f", Param src, Param tmp]
 			unless ok $ do

Utility/Exception.hs

@@ -7,11 +7,25 @@
 
 {-# LANGUAGE ScopedTypeVariables #-}
 
-module Utility.Exception where
+module Utility.Exception (
+	module X,
+	catchBoolIO,
+	catchMaybeIO,
+	catchDefaultIO,
+	catchMsgIO,
+	catchIO,
+	tryIO,
+	bracketIO,
+	catchNonAsync,
+	tryNonAsync,
+	tryWhenExists,
+) where
 
+import Control.Monad.Catch as X hiding (Handler)
+import qualified Control.Monad.Catch as M
 import Control.Exception (IOException, AsyncException)
-import Control.Monad.Catch
 import Control.Monad
+import Control.Monad.IO.Class (liftIO, MonadIO)
 import System.IO.Error (isDoesNotExistError)
 import Utility.Data
 
@@ -44,14 +58,20 @@ catchIO = catch
 tryIO :: MonadCatch m => m a -> m (Either IOException a)
 tryIO = try
 
+{- bracket with setup and cleanup actions lifted to IO.
+ -
+ - Note that unlike catchIO and tryIO, this catches all exceptions. -}
+bracketIO :: (MonadMask m, MonadIO m) => IO v -> (v -> IO b) -> (v -> m a) -> m a
+bracketIO setup cleanup = bracket (liftIO setup) (liftIO . cleanup)
+
 {- 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 :: MonadCatch m => m a -> (SomeException -> m a) -> m a
 catchNonAsync a onerr = a `catches`
-	[ Handler (\ (e :: AsyncException) -> throwM e)
-	, Handler (\ (e :: SomeException) -> onerr e)
+	[ M.Handler (\ (e :: AsyncException) -> throwM e)
+	, M.Handler (\ (e :: SomeException) -> onerr e)
 	]
 
 tryNonAsync :: MonadCatch m => m a -> m (Either SomeException a)

Utility/FileMode.hs

@@ -11,7 +11,6 @@ module Utility.FileMode where
 
 import System.IO
 import Control.Monad
-import Control.Exception (bracket)
 import System.PosixCompat.Types
 import Utility.PosixFiles
 #ifndef mingw32_HOST_OS

Utility/Gpg.hs

@@ -13,7 +13,6 @@ import Control.Applicative
 import Control.Concurrent
 import Control.Monad.IO.Class
 import qualified Data.Map as M
-import Control.Monad.Catch (bracket, MonadMask)
 
 import Common
 import qualified Build.SysConfig as SysConfig

Utility/Matcher.hs

@@ -102,13 +102,13 @@ findClose l =
 	in (Group (reverse g), rest)
   where
   	go c [] = (c, []) -- not picky about extra Close
-	go c (t:ts) = handle t
+	go c (t:ts) = dispatch t
 	  where
-		handle Close = (c, ts)
-		handle Open = 
+		dispatch Close = (c, ts)
+		dispatch Open = 
 			let (c', ts') = go [] ts
 			in go (Group (reverse c') : c) ts'
-		handle _ = go (One t:c) ts
+		dispatch _ = go (One t:c) ts
 
 {- Checks if a Matcher matches, using a supplied function to check
  - the value of Operations. -}

Utility/Parallel.hs

@@ -10,7 +10,6 @@ module Utility.Parallel where
 import Common
 
 import Control.Concurrent
-import Control.Exception
 
 {- Runs an action in parallel with a set of values, in a set of threads.
  - In order for the actions to truely run in parallel, requires GHC's

Utility/Tmp.hs

@@ -14,7 +14,6 @@ import System.Directory
 import Control.Monad.IfElse
 import System.FilePath
 import Control.Monad.IO.Class
-import Control.Monad.Catch (bracket, MonadMask)
 
 import Utility.Exception
 import Utility.FileSystemEncoding
@@ -33,11 +32,11 @@ viaTmp a file content = bracket setup cleanup use
 	setup = do
 		createDirectoryIfMissing True dir
 		openTempFile dir template
-	cleanup (tmpfile, handle) = do
-		_ <- tryIO $ hClose handle
+	cleanup (tmpfile, h) = do
+		_ <- tryIO $ hClose h
 		tryIO $ removeFile tmpfile
-	use (tmpfile, handle) = do
-		hClose handle
+	use (tmpfile, h) = do
+		hClose h
 		a tmpfile content
 		rename tmpfile file
 
@@ -54,10 +53,10 @@ withTmpFileIn :: (MonadIO m, MonadMask m) => FilePath -> Template -> (FilePath -
 withTmpFileIn tmpdir template a = bracket create remove use
   where
 	create = liftIO $ openTempFile tmpdir template
-	remove (name, handle) = liftIO $ do
-		hClose handle
+	remove (name, h) = liftIO $ do
+		hClose h
 		catchBoolIO (removeFile name >> return True)
-	use (name, handle) = a name handle
+	use (name, h) = a name h
 
 {- Runs an action with a tmp directory located within the system's tmp
  - directory (or within "." if there is none), then removes the tmp

Utility/Url.hs

@@ -51,11 +51,11 @@ checkBoth url expected_size uo = do
 	v <- check url expected_size uo
 	return (fst v && snd v)
 check :: URLString -> Maybe Integer -> UrlOptions -> IO (Bool, Bool)
-check url expected_size = handle <$$> exists url
+check url expected_size = go <$$> exists url
   where
-	handle (False, _) = (False, False)
-	handle (True, Nothing) = (True, True)
-	handle (True, s) = case expected_size of
+	go (False, _) = (False, False)
+	go (True, Nothing) = (True, True)
+	go (True, s) = case expected_size of
 		Just _ -> (True, expected_size == s)
 		Nothing -> (True, True)
 

Utility/WebApp.hs

@@ -38,10 +38,6 @@ import Data.Byteable
 #ifdef __ANDROID__
 import Data.Endian
 #endif
-#if defined(__ANDROID__) || defined (mingw32_HOST_OS)
-#else
-import Control.Exception (bracketOnError)
-#endif
 
 localhost :: HostName
 localhost = "localhost"