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.

12 files changed, 13 insertions, 86 deletions

diff --git a/Annex/Content.hs b/Annex/Content.hs
index eb84f2fe9..b51e15827 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -56,7 +56,6 @@ import Annex.Perms
 import Annex.Link
 import Annex.Content.Direct
 import Annex.ReplaceFile
-import Annex.Exception
 
 #ifdef mingw32_HOST_OS
 import Utility.WinLock
@@ -167,7 +166,7 @@ lockContent key a = do
 	contentfile <- calcRepo $ gitAnnexLocation key
 	lockfile <- contentLockFile key
 	maybe noop setuplockfile lockfile
-	bracketAnnex (liftIO $ lock contentfile lockfile) (unlock lockfile) (const a)
+	bracket (liftIO $ lock contentfile lockfile) (unlock lockfile) (const a)
   where
 	alreadylocked = error "content is locked"
 	setuplockfile lockfile = modifyContent lockfile $
@@ -420,7 +419,7 @@ withObjectLoc key indirect direct = ifM isDirect
 cleanObjectLoc :: Key -> Annex () -> Annex ()
 cleanObjectLoc key cleaner = do
 	file <- calcRepo $ gitAnnexLocation key
-	void $ tryAnnexIO $ thawContentDir file
+	void $ tryIO $ thawContentDir file
 	cleaner
 	liftIO $ removeparents file (3 :: Int)
   where
diff --git a/Annex/Direct.hs b/Annex/Direct.hs
index e6b941e0f..374599369 100644
--- a/Annex/Direct.hs
+++ b/Annex/Direct.hs
@@ -32,7 +32,6 @@ import Utility.InodeCache
 import Utility.CopyFile
 import Annex.Perms
 import Annex.ReplaceFile
-import Annex.Exception
 import Annex.VariantFile
 import Git.Index
 import Annex.Index
@@ -252,7 +251,7 @@ mergeDirectCleanup d oldref = do
 	go makeabs getsha getmode a araw (f, item)
 		| getsha item == nullSha = noop
 		| otherwise = void $
-			tryAnnex . maybe (araw item makeabs f) (\k -> void $ a item makeabs k f)
+			tryNonAsync . maybe (araw item makeabs f) (\k -> void $ a item makeabs k f)
 				=<< catKey (getsha item) (getmode item)
 
 	moveout _ _ = removeDirect
diff --git a/Annex/Drop.hs b/Annex/Drop.hs
index 71263dc61..c5a3fbe5f 100644
--- a/Annex/Drop.hs
+++ b/Annex/Drop.hs
@@ -16,7 +16,6 @@ import qualified Remote
 import qualified Command.Drop
 import Command
 import Annex.Wanted
-import Annex.Exception
 import Config
 import Annex.Content.Direct
 
@@ -120,5 +119,5 @@ handleDropsFrom locs rs reason fromhere key afile knownpresentremote runner = do
 
 	slocs = S.fromList locs
 	
-	safely a = either (const False) id <$> tryAnnex a
+	safely a = either (const False) id <$> tryNonAsync a
 
diff --git a/Annex/Environment.hs b/Annex/Environment.hs
index 4b8d38464..bc97c17b7 100644
--- a/Annex/Environment.hs
+++ b/Annex/Environment.hs
@@ -13,7 +13,6 @@ import Common.Annex
 import Utility.UserInfo
 import qualified Git.Config
 import Config
-import Annex.Exception
 
 #ifndef mingw32_HOST_OS
 import Utility.Env
@@ -58,7 +57,7 @@ checkEnvironmentIO =
 {- Runs an action that commits to the repository, and if it fails, 
  - sets user.email and user.name to a dummy value and tries the action again. -}
 ensureCommit :: Annex a -> Annex a
-ensureCommit a = either retry return =<< tryAnnex a 
+ensureCommit a = either retry return =<< tryNonAsync a 
   where
   	retry _ = do
 		name <- liftIO myUserName
diff --git a/Annex/Exception.hs b/Annex/Exception.hs
deleted file mode 100644
index 5ecbd28a0..000000000
--- a/Annex/Exception.hs
+++ /dev/null
@@ -1,63 +0,0 @@
-{- exception handling in the git-annex monad
- -
- - Note that when an Annex action fails and the exception is handled
- - by these functions, any changes the action has made to the
- - AnnexState are retained. This works because the Annex monad
- - internally stores the AnnexState in a MVar.
- -
- - Copyright 2011-2014 Joey Hess <joey@kitenet.net>
- -
- - Licensed under the GNU GPL version 3 or higher.
- -}
-
-{-# LANGUAGE PackageImports #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
-module Annex.Exception (
-	bracketIO,
-	bracketAnnex,
-	tryAnnex,
-	tryAnnexIO,
-	throwAnnex,
-	catchAnnex,
-	catchNonAsyncAnnex,
-	tryNonAsyncAnnex,
-) where
-
-import qualified Control.Monad.Catch as M
-import Control.Exception
-
-import Common.Annex
-
-{- Runs an Annex action, with setup and cleanup both in the IO monad. -}
-bracketIO :: IO v -> (v -> IO b) -> (v -> Annex a) -> Annex a
-bracketIO setup cleanup = M.bracket (liftIO setup) (liftIO . cleanup)
-
-bracketAnnex :: Annex v -> (v -> Annex b) -> (v -> Annex a) -> Annex a
-bracketAnnex = M.bracket
-
-{- try in the Annex monad -}
-tryAnnex :: Annex a -> Annex (Either SomeException a)
-tryAnnex = M.try
-
-{- try in the Annex monad, but only catching IO exceptions -}
-tryAnnexIO :: Annex a -> Annex (Either IOException a)
-tryAnnexIO = M.try
-
-{- throw in the Annex monad -}
-throwAnnex :: Exception e => e -> Annex a
-throwAnnex = M.throwM
-
-{- catch in the Annex monad -}
-catchAnnex :: Exception e => Annex a -> (e -> Annex a) -> Annex a
-catchAnnex = M.catch
-
-{- catchs all exceptions except for async exceptions -}
-catchNonAsyncAnnex :: Annex a -> (SomeException -> Annex a) -> Annex a
-catchNonAsyncAnnex a onerr = a `M.catches`
-	[ M.Handler (\ (e :: AsyncException) -> throwAnnex e)
-	, M.Handler (\ (e :: SomeException) -> onerr e)
-	]
-
-tryNonAsyncAnnex :: Annex a -> Annex (Either SomeException a)
-tryNonAsyncAnnex a = (Right <$> a) `catchNonAsyncAnnex` (return . Left)
diff --git a/Annex/Index.hs b/Annex/Index.hs
index af0cab45e..7757a412b 100644
--- a/Annex/Index.hs
+++ b/Annex/Index.hs
@@ -18,7 +18,6 @@ import Common.Annex
 import Git.Types
 import qualified Annex
 import Utility.Env
-import Annex.Exception
 
 {- Runs an action using a different git index file. -}
 withIndexFile :: FilePath -> Annex a -> Annex a
@@ -26,7 +25,7 @@ withIndexFile f a = do
 	g <- gitRepo
 	g' <- liftIO $ addGitEnv g "GIT_INDEX_FILE" f
 
-	r <- tryAnnex $ do
+	r <- tryNonAsync $ do
 		Annex.changeState $ \s -> s { Annex.repo = g' }
 		a
 	Annex.changeState $ \s -> s { Annex.repo = (Annex.repo s) { gitEnv = gitEnv g} }
diff --git a/Annex/Journal.hs b/Annex/Journal.hs
index f34a7be1b..798bcba29 100644
--- a/Annex/Journal.hs
+++ b/Annex/Journal.hs
@@ -14,7 +14,6 @@
 module Annex.Journal where
 
 import Common.Annex
-import Annex.Exception
 import qualified Git
 import Annex.Perms
 import Annex.LockFile
diff --git a/Annex/LockFile.hs b/Annex/LockFile.hs
index 8114e94f2..dc4f82f98 100644
--- a/Annex/LockFile.hs
+++ b/Annex/LockFile.hs
@@ -18,7 +18,6 @@ import Common.Annex
 import Annex
 import Types.LockPool
 import qualified Git
-import Annex.Exception
 import Annex.Perms
 
 import qualified Data.Map as M
diff --git a/Annex/Perms.hs b/Annex/Perms.hs
index e3a2fa65a..3430554c7 100644
--- a/Annex/Perms.hs
+++ b/Annex/Perms.hs
@@ -21,7 +21,6 @@ import Common.Annex
 import Utility.FileMode
 import Git.SharedRepository
 import qualified Annex
-import Annex.Exception
 import Config
 
 import System.Posix.Types
@@ -120,6 +119,6 @@ createContentDir dest = do
 modifyContent :: FilePath -> Annex a -> Annex a
 modifyContent f a = do
 	createContentDir f -- also thaws it
-	v <- tryAnnex a
+	v <- tryNonAsync a
 	freezeContentDir f
-	either throwAnnex return v
+	either throwM return v
diff --git a/Annex/ReplaceFile.hs b/Annex/ReplaceFile.hs
index e734c4d64..8776762e9 100644
--- a/Annex/ReplaceFile.hs
+++ b/Annex/ReplaceFile.hs
@@ -9,7 +9,6 @@ module Annex.ReplaceFile where
 
 import Common.Annex
 import Annex.Perms
-import Annex.Exception
 
 {- Replaces a possibly already existing file with a new version, 
  - atomically, by running an action.
@@ -31,7 +30,7 @@ replaceFileOr :: FilePath -> (FilePath -> Annex ()) -> (FilePath -> Annex ()) ->
 replaceFileOr file action rollback = do
 	tmpdir <- fromRepo gitAnnexTmpMiscDir
 	void $ createAnnexDirectory tmpdir
-	bracketAnnex (liftIO $ setup tmpdir) rollback $ \tmpfile -> do
+	bracket (liftIO $ setup tmpdir) rollback $ \tmpfile -> do
 		action tmpfile
 		liftIO $ catchIO (rename tmpfile file) (fallback tmpfile)
   where
diff --git a/Annex/Transfer.hs b/Annex/Transfer.hs
index 001539adc..ebc8e8b89 100644
--- a/Annex/Transfer.hs
+++ b/Annex/Transfer.hs
@@ -20,7 +20,6 @@ import Common.Annex
 import Logs.Transfer as X
 import Annex.Notification as X
 import Annex.Perms
-import Annex.Exception
 import Utility.Metered
 #ifdef mingw32_HOST_OS
 import Utility.WinLock
@@ -103,7 +102,7 @@ runTransfer t file shouldretry a = do
 		void $ tryIO $ removeFile $ transferLockFile tfile
 #endif
 	retry oldinfo metervar run = do
-		v <- tryAnnex run
+		v <- tryNonAsync run
 		case v of
 			Right b -> return b
 			Left e -> do
diff --git a/Annex/View.hs b/Annex/View.hs
index b96981612..a1d873f50 100644
--- a/Annex/View.hs
+++ b/Annex/View.hs
@@ -410,19 +410,19 @@ withViewChanges addmeta removemeta = do
   where
 	handleremovals item
 		| DiffTree.srcsha item /= nullSha =
-			handle item removemeta
+			handlechange item removemeta
 				=<< catKey (DiffTree.srcsha item) (DiffTree.srcmode item)
 		| otherwise = noop
 	handleadds makeabs item
 		| DiffTree.dstsha item /= nullSha = 
-			handle item addmeta
+			handlechange item addmeta
 				=<< ifM isDirect
 					( catKey (DiffTree.dstsha item) (DiffTree.dstmode item)
 					-- optimisation
 					, isAnnexLink $ makeabs $ DiffTree.file item
 					)
 		| otherwise = noop
-	handle item a = maybe noop
+	handlechange item a = maybe noop
 		(void . commandAction . a (getTopFilePath $ DiffTree.file item))
 
 {- Generates a branch for a view. This is done using a different index