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.

8 files changed, 16 insertions, 26 deletions

diff --git a/Remote/Ddar.hs b/Remote/Ddar.hs
index fba05312b..beeb4d7cc 100644
--- a/Remote/Ddar.hs
+++ b/Remote/Ddar.hs
@@ -8,7 +8,6 @@
 
 module Remote.Ddar (remote) where
 
-import Control.Exception
 import qualified Data.Map as M
 import qualified Data.ByteString.Lazy as L
 import System.IO.Error
diff --git a/Remote/External.hs b/Remote/External.hs
index f326f26ba..4fb760afd 100644
--- a/Remote/External.hs
+++ b/Remote/External.hs
@@ -21,7 +21,6 @@ import Logs.PreferredContent.Raw
 import Logs.RemoteState
 import Config.Cost
 import Annex.UUID
-import Annex.Exception
 import Creds
 
 import Control.Concurrent.STM
@@ -137,7 +136,7 @@ checkKey external k = either error id <$> go
 			_ -> Nothing
 
 safely :: Annex Bool -> Annex Bool
-safely a = go =<< tryAnnex a
+safely a = go =<< tryNonAsync a
   where
 	go (Right r) = return r
 	go (Left e) = do
diff --git a/Remote/External/Types.hs b/Remote/External/Types.hs
index 983764f70..3a69ae9ea 100644
--- a/Remote/External/Types.hs
+++ b/Remote/External/Types.hs
@@ -32,7 +32,6 @@ module Remote.External.Types (
 ) where
 
 import Common.Annex
-import Annex.Exception
 import Types.Key (file2key, key2file)
 import Types.StandardGroups (PreferredContentExpression)
 import Utility.Metered (BytesProcessed(..))
diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index 55a775811..8891977f7 100644
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -15,7 +15,7 @@ module Remote.GCrypt (
 
 import qualified Data.Map as M
 import qualified Data.ByteString.Lazy as L
-import Control.Exception.Extensible
+import Control.Exception
 
 import Common.Annex
 import Types.Remote
diff --git a/Remote/Git.hs b/Remote/Git.hs
index da5ca4c4a..34c60d98f 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -27,7 +27,6 @@ import qualified Annex
 import Logs.Presence
 import Annex.Transfer
 import Annex.UUID
-import Annex.Exception
 import qualified Annex.Content
 import qualified Annex.BranchState
 import qualified Annex.Branch
@@ -56,7 +55,6 @@ import Creds
 import Control.Concurrent
 import Control.Concurrent.MSampleVar
 import qualified Data.Map as M
-import Control.Exception.Extensible
 
 remote :: RemoteType
 remote = RemoteType {
@@ -281,7 +279,7 @@ tryGitConfigRead r
 		s <- Annex.new r
 		Annex.eval s $ do
 			Annex.BranchState.disableUpdate
-			void $ tryAnnex $ ensureInitialized
+			void $ tryNonAsync $ ensureInitialized
 			Annex.getState Annex.repo
 
 {- Checks if a given remote has the content for a key in its annex. -}
diff --git a/Remote/Helper/Chunked.hs b/Remote/Helper/Chunked.hs
index 953c533b6..5e4ea111f 100644
--- a/Remote/Helper/Chunked.hs
+++ b/Remote/Helper/Chunked.hs
@@ -24,7 +24,6 @@ import Logs.Chunk
 import Utility.Metered
 import Crypto (EncKey)
 import Backend (isStableKey)
-import Annex.Exception
 
 import qualified Data.ByteString.Lazy as L
 import qualified Data.Map as M
@@ -172,7 +171,7 @@ seekResume h chunkkeys checker = do
 			liftIO $ hSeek h AbsoluteSeek sz
 			return (cks, toBytesProcessed sz)
 		| otherwise = do
-			v <- tryNonAsyncAnnex (checker k)
+			v <- tryNonAsync (checker k)
 			case v of
 				Right True ->
 					check pos' cks' sz
@@ -231,7 +230,7 @@ retrieveChunks retriever u chunkconfig encryptor basek dest basep sink
 		-- Optimisation: Try the unchunked key first, to avoid
 		-- looking in the git-annex branch for chunk counts
 		-- that are likely not there.
-		getunchunked `catchNonAsyncAnnex`
+		getunchunked `catchNonAsync`
 			const (go =<< chunkKeysOnly u basek)
 	| otherwise = go =<< chunkKeys u chunkconfig basek
   where
@@ -241,7 +240,7 @@ retrieveChunks retriever u chunkconfig encryptor basek dest basep sink
 		let ls' = maybe ls (setupResume ls) currsize
 		if any null ls'
 			then return True -- dest is already complete
-			else firstavail currsize ls' `catchNonAsyncAnnex` giveup
+			else firstavail currsize ls' `catchNonAsync` giveup
 
 	giveup e = do
 		warning (show e)
@@ -251,20 +250,20 @@ retrieveChunks retriever u chunkconfig encryptor basek dest basep sink
 	firstavail currsize ([]:ls) = firstavail currsize ls
 	firstavail currsize ((k:ks):ls)
 		| k == basek = getunchunked
-			`catchNonAsyncAnnex` (const $ firstavail currsize ls)
+			`catchNonAsync` (const $ firstavail currsize ls)
 		| otherwise = do
 			let offset = resumeOffset currsize k
 			let p = maybe basep
 				(offsetMeterUpdate basep . toBytesProcessed)
 				offset
-			v <- tryNonAsyncAnnex $
+			v <- tryNonAsync $
 				retriever (encryptor k) p $ \content ->
 					bracketIO (maybe opennew openresume offset) hClose $ \h -> do
 						void $ tosink (Just h) p content
 						let sz = toBytesProcessed $
 							fromMaybe 0 $ keyChunkSize k
 						getrest p h sz sz ks
-							`catchNonAsyncAnnex` giveup
+							`catchNonAsync` giveup
 			case v of
 				Left e
 					| null ls -> giveup e
@@ -372,7 +371,7 @@ checkPresentChunks checker u chunkconfig encryptor basek
 			Right False -> return $ Right False
 			Left e -> return $ Left $ show e
 
-	check = tryNonAsyncAnnex . checker . encryptor
+	check = tryNonAsync . checker . encryptor
 
 {- A key can be stored in a remote unchunked, or as a list of chunked keys.
  - This can be the case whether or not the remote is currently configured
diff --git a/Remote/Helper/Special.hs b/Remote/Helper/Special.hs
index fc0e11d2f..ba9ff4fb4 100644
--- a/Remote/Helper/Special.hs
+++ b/Remote/Helper/Special.hs
@@ -42,13 +42,11 @@ import Remote.Helper.Chunked as X
 import Remote.Helper.Encryptable as X
 import Remote.Helper.Messages
 import Annex.Content
-import Annex.Exception
 import qualified Git
 import qualified Git.Command
 import qualified Git.Construct
 
 import qualified Data.ByteString.Lazy as L
-import Control.Exception (bracket)
 import qualified Data.Map as M
 
 {- Special remotes don't have a configured url, so Git.Repo does not
@@ -174,7 +172,7 @@ specialRemote' cfg c preparestorer prepareretriever prepareremover preparecheckp
 	cip = cipherKey c
 	gpgopts = getGpgEncParams encr
 
-	safely a = catchNonAsyncAnnex a (\e -> warning (show e) >> return False)
+	safely a = catchNonAsync a (\e -> warning (show e) >> return False)
 
 	-- chunk, then encrypt, then feed to the storer
 	storeKeyGen k p enc = safely $ preparestorer k $ safely . go
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index b70001ddb..4caebaf21 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -14,10 +14,10 @@ import qualified Data.Map as M
 import qualified Data.ByteString.Lazy as L
 import qualified Data.ByteString.UTF8 as B8
 import qualified Data.ByteString.Lazy.UTF8 as L8
-import qualified Control.Exception.Lifted as EL
 import Network.HTTP.Client (HttpException(..))
 import Network.HTTP.Types
 import System.IO.Error
+import Control.Monad.Catch
 
 import Common.Annex
 import Types.Remote
@@ -31,7 +31,6 @@ import Creds
 import Utility.Metered
 import Utility.Url (URLString)
 import Annex.UUID
-import Annex.Exception
 import Remote.WebDAV.DavLocation
 
 remote :: RemoteType
@@ -301,11 +300,11 @@ moveDAV baseurl src dest = inLocation src $ moveContentM newurl
 	newurl = B8.fromString (locationUrl baseurl dest)
 
 existsDAV :: DavLocation -> DAVT IO (Either String Bool)
-existsDAV l = inLocation l check `EL.catch` (\(e :: EL.SomeException) -> return (Left $ show e))
+existsDAV l = inLocation l check `catchNonAsync` (\e -> return (Left $ show e))
   where
 	check = do
 		setDepth Nothing
-		EL.catchJust
+		catchJust
 			(matchStatusCodeException notFound404)
 			(getPropsM >> ispresent True)
 			(const $ ispresent False)
@@ -319,8 +318,7 @@ matchStatusCodeException _ _ = Nothing
 
 -- Ignores any exceptions when performing a DAV action.
 safely :: DAVT IO a -> DAVT IO (Maybe a)
-safely a = (Just <$> a)
-	`EL.catch` (\(_ :: EL.SomeException) -> return Nothing)
+safely = eitherToMaybe <$$> tryNonAsync
 
 choke :: IO (Either String a) -> IO a
 choke f = do
@@ -336,7 +334,7 @@ withDAVHandle r a = do
 	mcreds <- getCreds (config r) (uuid r)
 	case (mcreds, configUrl r) of
 		(Just (user, pass), Just baseurl) ->
-			bracketIO (mkDAVContext baseurl) closeDAVContext $ \ctx ->
+			withDAVContext baseurl $ \ctx ->
 				a (Just (DavHandle ctx (toDavUser user) (toDavPass pass) baseurl))
 		_ -> a Nothing