factored out some useful error catching methods

Remote/Bup.hs

@@ -110,21 +110,21 @@ storeEncrypted :: Git.Repo -> BupRepo -> (Cipher, Key) -> Key -> Annex Bool
 storeEncrypted r buprepo (cipher, enck) k = do
 	src <- fromRepo $ gitAnnexLocation k
 	params <- bupSplitParams r buprepo enck (Param "-")
-	liftIO $ catchBool $
+	liftIO $ catchBoolIO $
 		withEncryptedHandle cipher (L.readFile src) $ \h ->
 			pipeBup params (Just h) Nothing
 
 retrieve :: BupRepo -> Key -> FilePath -> Annex Bool
 retrieve buprepo k f = do
 	let params = bupParams "join" buprepo [Param $ show k]
-	liftIO $ catchBool $ do
+	liftIO $ catchBoolIO $ do
 		tofile <- openFile f WriteMode
 		pipeBup params Nothing (Just tofile)
 
 retrieveEncrypted :: BupRepo -> (Cipher, Key) -> FilePath -> Annex Bool
 retrieveEncrypted buprepo (cipher, enck) f = do
 	let params = bupParams "join" buprepo [Param $ show enck]
-	liftIO $ catchBool $ do
+	liftIO $ catchBoolIO $ do
 		(pid, h) <- hPipeFrom "bup" $ toCommand params
 		withDecryptedContent cipher (L.hGetContents h) $ L.writeFile f
 		forceSuccess pid
@@ -145,15 +145,12 @@ checkPresent r bupr k
 		showAction $ "checking " ++ Git.repoDescribe r
 		ok <- onBupRemote bupr boolSystem "git" params
 		return $ Right ok
-	| otherwise = dispatch <$> localcheck
+	| otherwise = liftIO $ catchMsgIO $
+		boolSystem "git" $ Git.gitCommandLine params bupr
 	where
 		params = 
 			[ Params "show-ref --quiet --verify"
 			, Param $ "refs/heads/" ++ show k]
-		localcheck = liftIO $ try $
-			boolSystem "git" $ Git.gitCommandLine params bupr
-		dispatch (Left e) = Left $ show e
-		dispatch (Right v) = Right v
 
 {- Store UUID in the annex.uuid setting of the bup repository. -}
 storeBupUUID :: UUID -> BupRepo -> Annex ()

Remote/Directory.hs

@@ -8,7 +8,6 @@
 module Remote.Directory (remote) where
 
 import qualified Data.ByteString.Lazy.Char8 as L
-import System.IO.Error
 import qualified Data.Map as M
 
 import Common.Annex
@@ -72,13 +71,13 @@ store :: FilePath -> Key -> Annex Bool
 store d k = do
 	src <- fromRepo $ gitAnnexLocation k
 	let dest = dirKey d k
-	liftIO $ catchBool $ storeHelper dest $ copyFileExternal src dest
+	liftIO $ catchBoolIO $ storeHelper dest $ copyFileExternal src dest
 
 storeEncrypted :: FilePath -> (Cipher, Key) -> Key -> Annex Bool
 storeEncrypted d (cipher, enck) k = do
 	src <- fromRepo $ gitAnnexLocation k
 	let dest = dirKey d enck
-	liftIO $ catchBool $ storeHelper dest $ encrypt src dest
+	liftIO $ catchBoolIO $ storeHelper dest $ encrypt src dest
 	where
 		encrypt src dest = do
 			withEncryptedContent cipher (L.readFile src) $ L.writeFile dest
@@ -100,12 +99,12 @@ retrieve d k f = liftIO $ copyFileExternal (dirKey d k) f
 
 retrieveEncrypted :: FilePath -> (Cipher, Key) -> FilePath -> Annex Bool
 retrieveEncrypted d (cipher, enck) f =
-	liftIO $ catchBool $ do
+	liftIO $ catchBoolIO $ do
 		withDecryptedContent cipher (L.readFile (dirKey d enck)) $ L.writeFile f
 		return True
 
 remove :: FilePath -> Key -> Annex Bool
-remove d k = liftIO $ catchBool $ do
+remove d k = liftIO $ catchBoolIO $ do
 	allowWrite dir
 	removeFile file
 	removeDirectory dir
@@ -115,8 +114,4 @@ remove d k = liftIO $ catchBool $ do
 		dir = parentDir file
 
 checkPresent :: FilePath -> Key -> Annex (Either String Bool)
-checkPresent d k = dispatch <$> check
-	where
-		check = liftIO $ try $ doesFileExist (dirKey d k)
-		dispatch (Left e) = Left $ show e
-		dispatch (Right v) = Right v
+checkPresent d k = liftIO $ catchMsgIO $ doesFileExist (dirKey d k)

Remote/Git.hs

@@ -134,11 +134,7 @@ inAnnex r key
 	| Git.repoIsUrl r = checkremote
 	| otherwise = checklocal
 	where
-		checkhttp = dispatch <$> check
-			where
-				check = safely $ Url.exists $ keyUrl r key
-				dispatch (Left e) = Left $ show e
-				dispatch (Right v) = Right v
+		checkhttp = liftIO $ catchMsgIO $ Url.exists $ keyUrl r key
 		checkremote = do
 			showAction $ "checking " ++ Git.repoDescribe r
 			onRemote r (check, unknown) "inannex" [Param (show key)]
@@ -149,13 +145,11 @@ inAnnex r key
 				dispatch _ = unknown
 		checklocal = dispatch <$> check
 			where
-				check = safely $ onLocal r $
+				check = liftIO $ catchMsgIO $ onLocal r $
 					Annex.Content.inAnnexSafe key
-				dispatch (Left e) = Left $ show e
+				dispatch (Left e) = Left e
 				dispatch (Right (Just b)) = Right b
 				dispatch (Right Nothing) = unknown
-		safely :: IO a -> Annex (Either IOException a)
-		safely a = liftIO $ try a
 		unknown = Left $ "unable to check " ++ Git.repoDescribe r
 
 {- Runs an action on a local repository inexpensively, by making an annex

Remote/Hook.hs

@@ -9,7 +9,6 @@ module Remote.Hook (remote) where
 
 import qualified Data.ByteString.Lazy.Char8 as L
 import qualified Data.Map as M
-import System.IO.Error (try)
 import System.Exit
 
 import Common.Annex
@@ -112,7 +111,7 @@ retrieve h k f = runHook h "retrieve" k (Just f) $ return True
 
 retrieveEncrypted :: String -> (Cipher, Key) -> FilePath -> Annex Bool
 retrieveEncrypted h (cipher, enck) f = withTmp enck $ \tmp ->
-	runHook h "retrieve" enck (Just tmp) $ liftIO $ catchBool $ do
+	runHook h "retrieve" enck (Just tmp) $ liftIO $ catchBoolIO $ do
 		withDecryptedContent cipher (L.readFile tmp) $ L.writeFile f
 		return True
 
@@ -123,12 +122,10 @@ checkPresent :: Git.Repo -> String -> Key -> Annex (Either String Bool)
 checkPresent r h k = do
 	showAction $ "checking " ++ Git.repoDescribe r
 	v <- lookupHook h "checkpresent"
-	dispatch <$> liftIO (try (check v) ::IO (Either IOException Bool))
+	liftIO $ catchMsgIO $ check v
 	where
 		findkey s = show k `elem` lines s
 		env = hookEnv k Nothing
-		dispatch (Left e) = Left $ show e
-		dispatch (Right v) = Right v
 		check Nothing = error "checkpresent hook misconfigured"
 		check (Just hook) = do
 			(frompipe, topipe) <- createPipe

Remote/Rsync.hs

@@ -110,7 +110,7 @@ retrieveEncrypted :: RsyncOpts -> (Cipher, Key) -> FilePath -> Annex Bool
 retrieveEncrypted o (cipher, enck) f = withTmp enck $ \tmp -> do
 	res <- retrieve o enck tmp
 	if res
-		then liftIO $ catchBool $ do
+		then liftIO $ catchBoolIO $ do
 			withDecryptedContent cipher (L.readFile tmp) $ L.writeFile f
 			return True
 		else return res

Remote/S3real.hs

@@ -286,7 +286,7 @@ s3GetCreds c = do
 				_ -> return Nothing
 		else return $ Just (ak, sk)
 	where
-		getEnvKey s = liftIO $ catch (getEnv s) (const $ return "")
+		getEnvKey s = liftIO $ catchDefaultIO (getEnv s) ""
 
 {- Stores S3 creds encrypted in the remote's config if possible. -}
 s3SetCreds :: RemoteConfig -> Annex RemoteConfig