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.

Annex.hs

@@ -64,14 +64,16 @@ import Utility.Quvi (QuviVersion)
 import Utility.InodeCache
 
 import "mtl" Control.Monad.Reader
-import Control.Monad.Catch
 import Control.Concurrent
 import qualified Data.Map as M
 import qualified Data.Set as S
 
 {- git-annex's monad is a ReaderT around an AnnexState stored in a MVar.
- - This allows modifying the state in an exception-safe fashion.
  - The MVar is not exposed outside this module.
+ -
+ - Note that when an Annex action fails and the exception is caught,
+ - ny changes the action has made to the AnnexState are retained,
+ - due to the use of the MVar to store the state.
  -}
 newtype Annex a = Annex { runAnnex :: ReaderT (MVar AnnexState) IO a }
 	deriving (

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

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

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
 

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

Annex/Exception.hs

@@ -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)

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} }

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

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

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

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

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

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

Assistant/Pairing/Network.hs

@@ -20,7 +20,6 @@ import Utility.Verifiable
 import Network.Multicast
 import Network.Info
 import Network.Socket
-import Control.Exception (bracket)
 import qualified Data.Map as M
 import Control.Concurrent
 

Assistant/Threads/Committer.hs

@@ -27,7 +27,6 @@ import qualified Utility.Lsof as Lsof
 import qualified Utility.DirWatcher as DirWatcher
 import Types.KeySource
 import Config
-import Annex.Exception
 import Annex.Content
 import Annex.Link
 import Annex.CatFile
@@ -217,7 +216,7 @@ commitStaged :: Annex Bool
 commitStaged = do
 	{- This could fail if there's another commit being made by
 	 - something else. -}
-	v <- tryAnnex Annex.Queue.flush
+	v <- tryNonAsync Annex.Queue.flush
 	case v of
 		Left _ -> return False
 		Right _ -> do

Assistant/Threads/Cronner.hs

@@ -191,10 +191,10 @@ runActivity' urlrenderer (ScheduledSelfFsck _ d) = do
 	mapM_ reget =<< liftAnnex (dirKeys gitAnnexBadDir)
   where
 	reget k = queueTransfers "fsck found bad file; redownloading" Next k Nothing Download
-runActivity' urlrenderer (ScheduledRemoteFsck u s d) = handle =<< liftAnnex (remoteFromUUID u)
+runActivity' urlrenderer (ScheduledRemoteFsck u s d) = dispatch =<< liftAnnex (remoteFromUUID u)
   where
-	handle Nothing = debug ["skipping remote fsck of uuid without a configured remote", fromUUID u, fromSchedule s]
+	dispatch Nothing = debug ["skipping remote fsck of uuid without a configured remote", fromUUID u, fromSchedule s]
-	handle (Just rmt) = void $ case Remote.remoteFsck rmt of
+	dispatch (Just rmt) = void $ case Remote.remoteFsck rmt of
 		Nothing -> go rmt $ do
 			program <- readProgramFile
 			void $ batchCommand program $ 

Assistant/Threads/SanityChecker.hs

@@ -40,7 +40,6 @@ import Logs.Transfer
 import Config.Files
 import Utility.DiskFree
 import qualified Annex
-import Annex.Exception
 #ifdef WITH_WEBAPP
 import Assistant.WebApp.Types
 #endif
@@ -85,7 +84,7 @@ sanityCheckerStartupThread startupdelay = namedThreadUnchecked "SanityCheckerSta
 	liftIO $ fixUpSshRemotes
 
 	{- Clean up old temp files. -}
-	void $ liftAnnex $ tryAnnex $ do
+	void $ liftAnnex $ tryNonAsync $ do
 		cleanOldTmpMisc
 		cleanReallyOldTmp
 

Assistant/Threads/Watcher.hs

@@ -104,13 +104,13 @@ runWatcher = do
 		, errHook = errhook
 		}
 	scanevents <- liftAnnex $ annexStartupScan <$> Annex.getGitConfig
-	handle <- liftIO $ watchDir "." ignored scanevents hooks startup
+	h <- liftIO $ watchDir "." ignored scanevents hooks startup
 	debug [ "watching", "."]
 	
 	{- Let the DirWatcher thread run until signalled to pause it,
 	 - then wait for a resume signal, and restart. -}
 	waitFor PauseWatcher $ do
-		liftIO $ stopWatchDir handle
+		liftIO $ stopWatchDir h
 		waitFor ResumeWatcher runWatcher
   where
 	hook a = Just <$> asIO2 (runHandler a)

Assistant/Threads/XMPPClient.hs

@@ -117,7 +117,7 @@ xmppClient urlrenderer d creds xmppuuid =
 		void $ liftIO $ atomically . swapTMVar lasttraffic =<< getCurrentTime
 		inAssistant $ debug
 			["received:", show $ map logXMPPEvent l]
-		mapM_ (handle selfjid) l
+		mapM_ (handlemsg selfjid) l
 	sendpings selfjid lasttraffic = forever $ do
 		putStanza pingstanza
 
@@ -133,21 +133,21 @@ xmppClient urlrenderer d creds xmppuuid =
 		 - cause traffic, so good enough. -}
 	  	pingstanza = xmppPing selfjid
 
-	handle selfjid (PresenceMessage p) = do
+	handlemsg selfjid (PresenceMessage p) = do
 		void $ inAssistant $ 
 			updateBuddyList (updateBuddies p) <<~ buddyList
 		resendImportantMessages selfjid p
-	handle _ (GotNetMessage QueryPresence) = putStanza gitAnnexSignature
+	handlemsg _ (GotNetMessage QueryPresence) = putStanza gitAnnexSignature
-	handle _ (GotNetMessage (NotifyPush us)) = void $ inAssistant $ pull us
+	handlemsg _ (GotNetMessage (NotifyPush us)) = void $ inAssistant $ pull us
-	handle selfjid (GotNetMessage (PairingNotification stage c u)) =
+	handlemsg selfjid (GotNetMessage (PairingNotification stage c u)) =
 		maybe noop (inAssistant . pairMsgReceived urlrenderer stage u selfjid) (parseJID c)
-	handle _ (GotNetMessage m@(Pushing _ pushstage))
+	handlemsg _ (GotNetMessage m@(Pushing _ pushstage))
 		| isPushNotice pushstage = inAssistant $ handlePushNotice m
 		| isPushInitiation pushstage = inAssistant $ queuePushInitiation m
 		| otherwise = inAssistant $ storeInbox m
-	handle _ (Ignorable _) = noop
+	handlemsg _ (Ignorable _) = noop
-	handle _ (Unknown _) = noop
+	handlemsg _ (Unknown _) = noop
-	handle _ (ProtocolError _) = noop
+	handlemsg _ (ProtocolError _) = noop
 
 	resendImportantMessages selfjid (Presence { presenceFrom = Just jid }) = do
 		let c = formatJID jid

Assistant/XMPP/Client.hs

@@ -15,7 +15,6 @@ import Network.Protocol.XMPP
 import Network
 import Control.Concurrent
 import qualified Data.Text as T
-import Control.Exception (SomeException)
 
 {- Everything we need to know to connect to an XMPP server. -}
 data XMPPCreds = XMPPCreds
@@ -34,18 +33,18 @@ connectXMPP c a = case parseJID (xmppJID c) of
 
 {- Do a SRV lookup, but if it fails, fall back to the cached xmppHostname. -}
 connectXMPP' :: JID -> XMPPCreds -> (JID -> XMPP a) -> IO [(HostPort, Either SomeException ())]
-connectXMPP' jid c a = reverse <$> (handle =<< lookupSRV srvrecord)
+connectXMPP' jid c a = reverse <$> (handlesrv =<< lookupSRV srvrecord)
   where
 	srvrecord = mkSRVTcp "xmpp-client" $
 		T.unpack $ strDomain $ jidDomain jid
 	serverjid = JID Nothing (jidDomain jid) Nothing
 
-	handle [] = do
+	handlesrv [] = do
 		let h = xmppHostname c
 		let p = PortNumber $ fromIntegral $ xmppPort c
 		r <- run h p $ a jid
 		return [r]
-	handle srvs = go [] srvs
+	handlesrv srvs = go [] srvs
 
 	go l [] = return l
 	go l ((h,p):rest) = do

Assistant/XMPP/Git.hs

@@ -150,16 +150,16 @@ xmppPush cid gitpush = do
 					SendPackOutput seqnum' b
 				toxmpp seqnum' inh
 	
-	fromxmpp outh controlh = withPushMessagesInSequence cid SendPack handle
+	fromxmpp outh controlh = withPushMessagesInSequence cid SendPack handlemsg
 	  where
-	  	handle (Just (Pushing _ (ReceivePackOutput _ b))) = 
+	  	handlemsg (Just (Pushing _ (ReceivePackOutput _ b))) = 
 			liftIO $ writeChunk outh b
-		handle (Just (Pushing _ (ReceivePackDone exitcode))) =
+		handlemsg (Just (Pushing _ (ReceivePackDone exitcode))) =
 			liftIO $ do
 				hPrint controlh exitcode
 				hFlush controlh
-		handle (Just _) = noop
+		handlemsg (Just _) = noop
-		handle Nothing = do
+		handlemsg Nothing = do
 			debug ["timeout waiting for git receive-pack output via XMPP"]
 			-- Send a synthetic exit code to git-annex
 			-- xmppgit, which will exit and cause git push
@@ -264,12 +264,12 @@ xmppReceivePack cid = do
 			let seqnum' = succ seqnum
 			sendNetMessage $ Pushing cid $ ReceivePackOutput seqnum' b
 			relaytoxmpp seqnum' outh
-	relayfromxmpp inh = withPushMessagesInSequence cid ReceivePack handle
+	relayfromxmpp inh = withPushMessagesInSequence cid ReceivePack handlemsg
 	  where
-	  	handle (Just (Pushing _ (SendPackOutput _ b))) =
+	  	handlemsg (Just (Pushing _ (SendPackOutput _ b))) =
 			liftIO $ writeChunk inh b
-		handle (Just _) = noop
+		handlemsg (Just _) = noop
-		handle Nothing = do
+		handlemsg Nothing = do
 			debug ["timeout waiting for git send-pack output via XMPP"]
 			-- closing the handle will make git receive-pack exit
 			liftIO $ do

CmdLine/Action.hs

@@ -13,7 +13,6 @@ import Common.Annex
 import qualified Annex
 import Types.Command
 import qualified Annex.Queue
-import Annex.Exception
 
 type CommandActionRunner = CommandStart -> CommandCleanup
 
@@ -37,14 +36,14 @@ performCommandAction Command { cmdseek = seek, cmdcheck = c, cmdname = name } pa
  - 
  - This should only be run in the seek stage. -}
 commandAction :: CommandActionRunner
-commandAction a = handle =<< tryAnnexIO go
+commandAction a = account =<< tryIO go
   where
 	go = do
 		Annex.Queue.flushWhenFull
 		callCommandAction a
-	handle (Right True) = return True
+	account (Right True) = return True
-	handle (Right False) = incerr
+	account (Right False) = incerr
-	handle (Left err) = do
+	account (Left err) = do
 		showErr err
 		showEndFail
 		incerr

Command/Add.hs

@@ -10,7 +10,6 @@
 module Command.Add where
 
 import Common.Annex
-import Annex.Exception
 import Command
 import Types.KeySource
 import Backend
@@ -33,6 +32,8 @@ import Annex.FileMatcher
 import Annex.ReplaceFile
 import Utility.Tmp
 
+import Control.Exception (IOException)
+
 def :: [Command]
 def = [notBareRepo $ withOptions [includeDotFilesOption] $
 	command "add" paramPaths seek SectionCommon
@@ -103,7 +104,7 @@ lockDown = either (\e -> showErr e >> return Nothing) (return . Just) <=< lockDo
 lockDown' :: FilePath -> Annex (Either IOException KeySource)
 lockDown' file = ifM crippledFileSystem
 	( withTSDelta $ liftIO . tryIO . nohardlink
-	, tryAnnexIO $ do
+	, tryIO $ do
 		tmp <- fromRepo gitAnnexTmpMiscDir
 		createAnnexDirectory tmp
 		go tmp
@@ -167,7 +168,7 @@ ingest (Just source) = withTSDelta $ \delta -> do
 		)
 
 	goindirect (Just (key, _)) mcache ms = do
-		catchAnnex (moveAnnex key $ contentLocation source)
+		catchNonAsync (moveAnnex key $ contentLocation source)
 			(undo (keyFilename source) key)
 		maybe noop (genMetaData key (keyFilename source)) ms
 		liftIO $ nukeFile $ keyFilename source
@@ -206,23 +207,23 @@ perform file = lockDown file >>= ingest >>= go
 
 {- On error, put the file back so it doesn't seem to have vanished.
  - This can be called before or after the symlink is in place. -}
-undo :: FilePath -> Key -> IOException -> Annex a
+undo :: FilePath -> Key -> SomeException -> Annex a
 undo file key e = do
 	whenM (inAnnex key) $ do
 		liftIO $ nukeFile file
-		catchAnnex (fromAnnex key file) tryharder
+		catchNonAsync (fromAnnex key file) tryharder
 		logStatus key InfoMissing
-	throwAnnex e
+	throwM e
   where
 	-- fromAnnex could fail if the file ownership is weird
-	tryharder :: IOException -> Annex ()
+	tryharder :: SomeException -> Annex ()
 	tryharder _ = do
 		src <- calcRepo $ gitAnnexLocation key
 		liftIO $ moveFile src file
 
 {- Creates the symlink to the annexed content, returns the link target. -}
 link :: FilePath -> Key -> Maybe InodeCache -> Annex String
-link file key mcache = flip catchAnnex (undo file key) $ do
+link file key mcache = flip catchNonAsync (undo file key) $ do
 	l <- inRepo $ gitAnnexLink file key
 	replaceFile file $ makeAnnexLink l
 

Command/Direct.hs

@@ -7,8 +7,6 @@
 
 module Command.Direct where
 
-import Control.Exception.Extensible
-
 import Common.Annex
 import Command
 import qualified Git
@@ -16,7 +14,6 @@ import qualified Git.LsFiles
 import qualified Git.Branch
 import Config
 import Annex.Direct
-import Annex.Exception
 
 def :: [Command]
 def = [notBareRepo $ noDaemonRunning $
@@ -52,7 +49,7 @@ perform = do
 			Nothing -> noop
 			Just a -> do
 				showStart "direct" f
-				r' <- tryAnnex a
+				r' <- tryNonAsync a
 				case r' of
 					Left e -> warnlocked e
 					Right _ -> showEndOk

Command/FuzzTest.hs

@@ -13,7 +13,6 @@ import Command
 import qualified Git.Config
 import Config
 import Utility.ThreadScheduler
-import Annex.Exception
 import Utility.DiskFree
 
 import Data.Time.Clock
@@ -56,7 +55,7 @@ fuzz :: Handle -> Annex ()
 fuzz logh = do
 	action <- genFuzzAction
 	record logh $ flip Started action
-	result <- tryAnnex $ runFuzzAction action
+	result <- tryNonAsync $ runFuzzAction action
 	record logh $ flip Finished $
 		either (const False) (const True) result
 

Command/Indirect.hs

@@ -7,8 +7,6 @@
 
 module Command.Indirect where
 
-import Control.Exception.Extensible
-
 import Common.Annex
 import Command
 import qualified Git
@@ -21,7 +19,6 @@ import Annex.Direct
 import Annex.Content
 import Annex.Content.Direct
 import Annex.CatFile
-import Annex.Exception
 import Annex.Init
 import qualified Command.Add
 
@@ -88,12 +85,12 @@ perform = do
 		removeInodeCache k
 		removeAssociatedFiles k
 		whenM (liftIO $ not . isSymbolicLink <$> getSymbolicLinkStatus f) $ do
-			v <-tryAnnexIO (moveAnnex k f)
+			v <- tryNonAsync (moveAnnex k f)
 			case v of
 				Right _ -> do 
 					l <- inRepo $ gitAnnexLink f k
 					liftIO $ createSymbolicLink l f
-				Left e -> catchAnnex (Command.Add.undo f k e)
+				Left e -> catchNonAsync (Command.Add.undo f k e)
 					warnlocked
 		showEndOk
 

Command/Map.hs

@@ -7,7 +7,6 @@
 
 module Command.Map where
 
-import Control.Exception.Extensible
 import qualified Data.Map as M
 
 import Common.Annex
@@ -247,7 +246,7 @@ combineSame = map snd . nubBy sameuuid . map pair
 
 safely :: IO Git.Repo -> IO (Maybe Git.Repo)
 safely a = do
-	result <- try a :: IO (Either SomeException Git.Repo)
+	result <- tryNonAsync a
 	case result of
 		Left _ -> return Nothing
 		Right r' -> return $ Just r'

Command/Move.hs

@@ -152,17 +152,17 @@ fromOk src key = go =<< Annex.getState Annex.force
 fromPerform :: Remote -> Bool -> Key -> AssociatedFile -> CommandPerform
 fromPerform src move key afile = moveLock move key $
 	ifM (inAnnex key)
-		( handle move True
+		( dispatch move True
-		, handle move =<< go
+		, dispatch move =<< go
 		)
   where
 	go = notifyTransfer Download afile $ 
 		download (Remote.uuid src) key afile noRetry $ \p -> do
 			showAction $ "from " ++ Remote.name src
 			getViaTmp key $ \t -> Remote.retrieveKeyFile src key afile t p
-	handle _ False = stop -- failed
+	dispatch _ False = stop -- failed
-	handle False True = next $ return True -- copy complete
+	dispatch False True = next $ return True -- copy complete
-	handle True True = do -- finish moving
+	dispatch True True = do -- finish moving
 		ok <- Remote.removeKey src key
 		next $ Command.Drop.cleanupRemote key src ok
 

Command/PreCommit.hs

@@ -19,7 +19,6 @@ import Annex.Hook
 import Annex.View
 import Annex.View.ViewedFile
 import Annex.Perms
-import Annex.Exception
 import Logs.View
 import Logs.MetaData
 import Types.View

Command/TestRemote.hs

@@ -31,7 +31,6 @@ import Locations
 import Test.Tasty
 import Test.Tasty.Runners
 import Test.Tasty.HUnit
-import Control.Exception
 import "crypto-api" Crypto.Random
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as L

Command/Vicfg.hs

@@ -217,7 +217,7 @@ parseCfg curcfg = go [] curcfg . lines
 		| null l = Right cfg
 		| "#" `isPrefixOf` l = Right cfg
 		| null setting || null f = Left "missing field"
-		| otherwise = handle cfg f setting value'
+		| otherwise = parsed cfg f setting value'
 	  where
 		(setting, rest) = separate isSpace l
 		(r, value) = separate (== '=') rest
@@ -225,7 +225,7 @@ parseCfg curcfg = go [] curcfg . lines
 		f = reverse $ trimspace $ reverse $ trimspace r
 		trimspace = dropWhile isSpace
 
-	handle cfg f setting value
+	parsed cfg f setting value
 		| setting == "trust" = case readTrustLevel value of
 			Nothing -> badval "trust value" value
 			Just t ->

Common.hs

@@ -6,7 +6,6 @@ import Control.Monad as X
 import Control.Monad.IfElse as X
 import Control.Applicative as X
 import "mtl" Control.Monad.State.Strict as X (liftIO)
-import Control.Exception.Extensible as X (IOException)
 
 import Data.Maybe as X
 import Data.List as X hiding (head, tail, init, last)

Crypto.hs

@@ -38,7 +38,6 @@ import Data.ByteString.Lazy.UTF8 (fromString)
 import Control.Applicative
 import qualified Data.Map as M
 import Control.Monad.IO.Class
-import Control.Monad.Catch (MonadMask)
 
 import Common.Annex
 import qualified Utility.Gpg as Gpg

Git/Config.hs

@@ -9,7 +9,6 @@ module Git.Config where
 
 import qualified Data.Map as M
 import Data.Char
-import Control.Exception.Extensible
 
 import Common
 import Git

Git/UpdateIndex.hs

@@ -29,8 +29,6 @@ import Git.Command
 import Git.FilePath
 import Git.Sha
 
-import Control.Exception (bracket)
-
 {- Streamers are passed a callback and should feed it lines in the form
  - read by update-index, and generated by ls-tree. -}
 type Streamer = (String -> IO ()) -> IO ()

Limit.hs

@@ -152,8 +152,8 @@ limitCopies want = case split ":" want of
 	go num good = case readish num of
 		Nothing -> Left "bad number for copies"
 		Just n -> Right $ \notpresent -> checkKey $
-			handle n good notpresent
+			go' n good notpresent
-	handle n good notpresent key = do
+	go' n good notpresent key = do
 		us <- filter (`S.notMember` notpresent)
 			<$> (filterM good =<< Remote.keyLocations key)
 		return $ length us >= n
@@ -170,10 +170,10 @@ addLackingCopies approx = addLimit . limitLackingCopies approx
 limitLackingCopies :: Bool -> MkLimit Annex
 limitLackingCopies approx want = case readish want of
 	Just needed -> Right $ \notpresent mi -> flip checkKey mi $
-		handle mi needed notpresent
+		go mi needed notpresent
 	Nothing -> Left "bad value for number of lacking copies"
   where
-	handle mi needed notpresent key = do
+	go mi needed notpresent key = do
 		NumCopies numcopies <- if approx
 			then approxNumCopies
 			else case mi of

Logs/Transfer.hs

@@ -11,7 +11,6 @@ module Logs.Transfer where
 
 import Common.Annex
 import Annex.Perms
-import Annex.Exception
 import qualified Git
 import Types.Key
 import Utility.Metered
@@ -94,7 +93,7 @@ percentComplete (Transfer { transferKey = key }) info =
 mkProgressUpdater :: Transfer -> TransferInfo -> Annex (MeterUpdate, FilePath, MVar Integer)
 mkProgressUpdater t info = do
 	tfile <- fromRepo $ transferFile t
-	_ <- tryAnnex $ createAnnexDirectory $ takeDirectory tfile
+	_ <- tryNonAsync $ createAnnexDirectory $ takeDirectory tfile
 	mvar <- liftIO $ newMVar 0
 	return (liftIO . updater tfile mvar, tfile, mvar)
   where

Messages.hs

@@ -47,7 +47,7 @@ import System.Log.Handler (setFormatter, LogHandler)
 import System.Log.Handler.Simple
 import qualified Data.Set as S
 
-import Common
+import Common hiding (handle)
 import Types
 import Types.Messages
 import qualified Messages.JSON as JSON

Remote.hs

@@ -56,7 +56,6 @@ import Data.Ord
 import Common.Annex
 import Types.Remote
 import qualified Annex
-import Annex.Exception
 import Annex.UUID
 import Logs.UUID
 import Logs.Trust
@@ -114,10 +113,10 @@ byNameWithUUID = checkuuid <=< byName
 
 byName' :: RemoteName -> Annex (Either String Remote)
 byName' "" = return $ Left "no remote specified"
-byName' n = handle . filter matching <$> remoteList
+byName' n = go . filter matching <$> remoteList
   where
-	handle [] = Left $ "there is no available git remote named \"" ++ n ++ "\""
+	go [] = Left $ "there is no available git remote named \"" ++ n ++ "\""
-	handle (match:_) = Right match
+	go (match:_) = Right match
 	matching r = n == name r || toUUID n == uuid r
 
 {- Only matches remote name, not UUID -}
@@ -315,8 +314,7 @@ isXMPPRemote remote = Git.repoIsUrl r && "xmpp::" `isPrefixOf` Git.repoLocation
 	r = repo remote
 
 hasKey :: Remote -> Key -> Annex (Either String Bool)
-hasKey r k = either (Left  . show) Right
+hasKey r k = either (Left  . show) Right <$> tryNonAsync (checkPresent r k)
-	<$> tryNonAsyncAnnex (checkPresent r k)
 
 hasKeyCheap :: Remote -> Bool
 hasKeyCheap = checkPresentCheap

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

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

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(..))

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

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. -}

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

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

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)
+safely = eitherToMaybe <$$> tryNonAsync
-	`EL.catch` (\(_ :: EL.SomeException) -> return Nothing)
 
 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
 

RemoteDaemon/Transport/Ssh.hs

@@ -108,10 +108,10 @@ data Status = Stopping | ConnectionClosed
 
 {- Make connection robustly, with exponentioal backoff on failure. -}
 robustly :: Int -> IO Status -> IO ()
-robustly backoff a = handle =<< catchDefaultIO ConnectionClosed a
+robustly backoff a = caught =<< catchDefaultIO ConnectionClosed a
   where
-	handle Stopping = return ()
+	caught Stopping = return ()
-	handle ConnectionClosed = do
+	caught ConnectionClosed = do
 		threadDelaySeconds (Seconds backoff)
 		robustly increasedbackoff a
 

Test.hs

@@ -20,7 +20,6 @@ import Options.Applicative hiding (command)
 #if MIN_VERSION_optparse_applicative(0,8,0)
 import qualified Options.Applicative.Types as Opt
 #endif
-import Control.Exception.Extensible
 import qualified Data.Map as M
 import qualified Text.JSON
 
@@ -1444,7 +1443,7 @@ indir testenv dir a = do
 		(try a::IO (Either SomeException ()))
 	case r of
 		Right () -> return ()
-		Left e -> throw e
+		Left e -> throwM e
 
 setuprepo :: TestEnv -> FilePath -> IO FilePath
 setuprepo testenv dir = do

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)
+	[ M.Handler (\ (e :: AsyncException) -> throwM e)
-	, Handler (\ (e :: SomeException) -> onerr 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)
+		dispatch Close = (c, ts)
-		handle Open = 
+		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
+	cleanup (tmpfile, h) = do
-		_ <- tryIO $ hClose handle
+		_ <- tryIO $ hClose h
 		tryIO $ removeFile tmpfile
-	use (tmpfile, handle) = do
+	use (tmpfile, h) = do
-		hClose handle
+		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
+	remove (name, h) = liftIO $ do
-		hClose handle
+		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)
+	go (False, _) = (False, False)
-	handle (True, Nothing) = (True, True)
+	go (True, Nothing) = (True, True)
-	handle (True, s) = case expected_size of
+	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"

debian/control

@@ -26,7 +26,6 @@ Build-Depends:
 	libghc-ifelse-dev,
 	libghc-bloomfilter-dev,
 	libghc-edit-distance-dev,
-	libghc-extensible-exceptions-dev,
 	libghc-hinotify-dev [linux-any],
 	libghc-stm-dev (>= 2.3),
 	libghc-dbus-dev (>= 0.10.3) [linux-any],

git-annex.cabal

@@ -96,8 +96,7 @@ Executable git-annex
   Main-Is: git-annex.hs
   Build-Depends: MissingH, hslogger, directory, filepath,
    containers, utf8-string, network (>= 2.0), mtl (>= 2),
-   bytestring, old-locale, time, HTTP,
+   bytestring, old-locale, time, HTTP, dataenc, SHA, process, json,
-   extensible-exceptions, dataenc, SHA, process, json,
    base (>= 4.5 && < 4.9), monad-control, exceptions (>= 0.5),
    IfElse, text, QuickCheck >= 2.1, bloomfilter, edit-distance, process,
    SafeSemaphore, uuid, random, dlist, unix-compat, async, stm (>= 2.3),
@@ -143,7 +142,7 @@ Executable git-annex
 
   if flag(WebDAV)
     Build-Depends: DAV (>= 0.8),
-     http-client, http-conduit, http-types, lifted-base, transformers
+     http-client, http-conduit, http-types
     CPP-Options: -DWITH_WEBDAV
 
   if flag(Assistant) && ! os(solaris)