IO exception rework

ghc 7.4 comaplains about use of System.IO.Error to catch exceptions.
Ok, use Control.Exception, with variants specialized to only catch IO
exceptions.

14 files changed, 56 insertions, 44 deletions

diff --git a/Annex/Content.hs b/Annex/Content.hs
index dcfd43866..d10370bc9 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -25,7 +25,6 @@ module Annex.Content (
 	preseedTmp,
 ) where
 
-import System.IO.Error (try)
 import Control.Exception (bracket_)
 import System.Posix.Types
 
@@ -79,7 +78,7 @@ lockContent key a = do
 	where
 		lock Nothing = return Nothing
 		lock (Just l) = do
-			v <- try $ setLock l (WriteLock, AbsoluteSeek, 0, 0)
+			v <- tryIO $ setLock l (WriteLock, AbsoluteSeek, 0, 0)
 			case v of
 				Left _ -> error "content is locked"
 				Right _ -> return $ Just l
diff --git a/Annex/Journal.hs b/Annex/Journal.hs
index 9c5be89b1..34c4d98c8 100644
--- a/Annex/Journal.hs
+++ b/Annex/Journal.hs
@@ -91,4 +91,4 @@ lockJournal a = do
 {- Runs an action, catching failure and running something to fix it up, and
  - retrying if necessary. -}
 doRedo :: IO a -> IO b -> IO a
-doRedo a b = catch a $ const $ b >> a
+doRedo a b = catchIO a $ const $ b >> a
diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs
index 14ea74e53..d6f36e868 100644
--- a/Annex/Ssh.hs
+++ b/Annex/Ssh.hs
@@ -11,7 +11,6 @@ module Annex.Ssh (
 ) where
 
 import qualified Data.Map as M
-import System.IO.Error (try)
 
 import Common.Annex
 import Annex.LockPool
@@ -72,7 +71,8 @@ sshCleanup = do
 			let lockfile = socket2lock socketfile
 			unlockFile lockfile
 			fd <- liftIO $ openFd lockfile ReadWrite (Just stdFileMode) defaultFileFlags
-			v <- liftIO $ try $ setLock fd (WriteLock, AbsoluteSeek, 0, 0)
+			v <- liftIO $ tryIO $
+				setLock fd (WriteLock, AbsoluteSeek, 0, 0)
 			case v of
 				Left _ -> return ()
 				Right _ -> stopssh socketfile
diff --git a/Backend.hs b/Backend.hs
index 003d62bfc..e351bb3b2 100644
--- a/Backend.hs
+++ b/Backend.hs
@@ -16,7 +16,6 @@ module Backend (
 	maybeLookupBackendName
 ) where
 
-import System.IO.Error (try)
 import System.Posix.Files
 
 import Common.Annex
@@ -77,7 +76,7 @@ genKey' (b:bs) file = do
  - by examining what the file symlinks to. -}
 lookupFile :: FilePath -> Annex (Maybe (Key, Backend))
 lookupFile file = do
-	tl <- liftIO $ try getsymlink
+	tl <- liftIO $ tryIO getsymlink
 	case tl of
 		Left _ -> return Nothing
 		Right l -> makekey l
diff --git a/CmdLine.hs b/CmdLine.hs
index 61e6c26bb..18bb5fe51 100644
--- a/CmdLine.hs
+++ b/CmdLine.hs
@@ -11,7 +11,6 @@ module CmdLine (
 	shutdown
 ) where
 
-import qualified System.IO.Error as IO
 import qualified Control.Exception as E
 import Control.Exception (throw)
 import System.Console.GetOpt
@@ -74,7 +73,7 @@ tryRun' errnum _ cmd []
 	| otherwise = return ()
 tryRun' errnum state cmd (a:as) = run >>= handle
 	where
-		run = IO.try $ Annex.run state $ do
+		run = tryIO $ Annex.run state $ do
 			Annex.Queue.flushWhenFull
 			a
 		handle (Left err) = showerr err >> cont False state
diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index 59af29edb..469fad749 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -81,7 +81,7 @@ performRemote key file backend numcopies remote = do
 			t <- fromRepo gitAnnexTmpDir
 			let tmp = t </> "fsck" ++ show pid ++ "." ++ keyFile key
 			liftIO $ createDirectoryIfMissing True t
-			let cleanup = liftIO $ catch (removeFile tmp) (const $ return ())
+			let cleanup = liftIO $ catchIO (removeFile tmp) (const $ return ())
 			cleanup
 			cleanup `after` a tmp
 		getfile tmp = do
diff --git a/Common.hs b/Common.hs
index fb998214b..cc6cf9252 100644
--- a/Common.hs
+++ b/Common.hs
@@ -21,6 +21,7 @@ import System.Posix.Process as X hiding (executeFile)
 import System.Exit as X
 
 import Utility.Misc as X
+import Utility.Exception as X
 import Utility.SafeCommand as X
 import Utility.Path as X
 import Utility.Directory as X
diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index 9b54d8c85..50c3b10b3 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -8,7 +8,6 @@
 module Remote.Bup (remote) where
 
 import qualified Data.ByteString.Lazy.Char8 as L
-import System.IO.Error
 import qualified Data.Map as M
 import System.Process
 
@@ -200,7 +199,7 @@ getBupUUID :: Git.Repo -> UUID -> Annex (UUID, Git.Repo)
 getBupUUID r u
 	| Git.repoIsUrl r = return (u, r)
 	| otherwise = liftIO $ do
-		ret <- try $ Git.Config.read r
+		ret <- tryIO $ Git.Config.read r
 		case ret of
 			Right r' -> return (toUUID $ Git.Config.get "annex.uuid" "" r', r')
 			Left _ -> return (NoUUID, r)
diff --git a/Upgrade/V0.hs b/Upgrade/V0.hs
index c5310c641..c439c7caa 100644
--- a/Upgrade/V0.hs
+++ b/Upgrade/V0.hs
@@ -7,8 +7,6 @@
 
 module Upgrade.V0 where
 
-import System.IO.Error (try)
-
 import Common.Annex
 import Annex.Content
 import qualified Upgrade.V1
@@ -47,7 +45,7 @@ getKeysPresent0 dir = do
 			return $ map fileKey0 files
 	where
 		present d = do
-			result <- try $
+			result <- tryIO $
 				getFileStatus $ dir ++ "/" ++ takeFileName d
 			case result of
 				Right s -> return $ isRegularFile s
diff --git a/Upgrade/V1.hs b/Upgrade/V1.hs
index add50fcf3..ca2bff661 100644
--- a/Upgrade/V1.hs
+++ b/Upgrade/V1.hs
@@ -7,7 +7,6 @@
 
 module Upgrade.V1 where
 
-import System.IO.Error (try)
 import System.Posix.Types
 import Data.Char
 
@@ -183,7 +182,7 @@ readLog1 file = catchDefaultIO (parseLog <$> readFileStrict file) []
 
 lookupFile1 :: FilePath -> Annex (Maybe (Key, Backend))
 lookupFile1 file = do
-	tl <- liftIO $ try getsymlink
+	tl <- liftIO $ tryIO getsymlink
 	case tl of
 		Left _ -> return Nothing
 		Right l -> makekey l
@@ -216,7 +215,7 @@ getKeyFilesPresent1' dir = do
 			liftIO $ filterM present files
 	where
 		present f = do
-			result <- try $ getFileStatus f
+			result <- tryIO $ getFileStatus f
 			case result of
 				Right s -> return $ isRegularFile s
 				Left _ -> return False
diff --git a/Utility/Directory.hs b/Utility/Directory.hs
index b5fedb9c7..e7b7c442b 100644
--- a/Utility/Directory.hs
+++ b/Utility/Directory.hs
@@ -16,11 +16,12 @@ import Control.Monad.IfElse
 
 import Utility.SafeCommand
 import Utility.TempFile
+import Utility.Exception
 
 {- Moves one filename to another.
  - First tries a rename, but falls back to moving across devices if needed. -}
 moveFile :: FilePath -> FilePath -> IO ()
-moveFile src dest = try (rename src dest) >>= onrename
+moveFile src dest = tryIO (rename src dest) >>= onrename
 	where
 		onrename (Right _) = return ()
 		onrename (Left e)
@@ -40,11 +41,10 @@ moveFile src dest = try (rename src dest) >>= onrename
 						Param src, Param tmp]
 					unless ok $ do
 						-- delete any partial
-						_ <- try $
-							removeFile tmp
+						_ <- tryIO $ removeFile tmp
 						rethrow
 		isdir f = do
-			r <- try (getFileStatus f)
+			r <- tryIO $ getFileStatus f
 			case r of
 				(Left _) -> return False
 				(Right s) -> return $ isDirectory s
diff --git a/Utility/Exception.hs b/Utility/Exception.hs
new file mode 100644
index 000000000..7b6c9c999
--- /dev/null
+++ b/Utility/Exception.hs
@@ -0,0 +1,39 @@
+{- Simple IO exception handling
+ -
+ - Copyright 2011-2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Utility.Exception where
+
+import Prelude hiding (catch)
+import Control.Exception
+import Control.Applicative
+
+{- Catches IO errors and returns a Bool -}
+catchBoolIO :: IO Bool -> IO Bool
+catchBoolIO a = catchDefaultIO a False
+
+{- Catches IO errors and returns a Maybe -}
+catchMaybeIO :: IO a -> IO (Maybe a)
+catchMaybeIO a = catchDefaultIO (Just <$> a) Nothing
+
+{- Catches IO errors and returns a default value. -}
+catchDefaultIO :: IO a -> a -> IO a
+catchDefaultIO a def = catchIO a (const $ return def)
+
+{- Catches IO errors and returns the error message. -}
+catchMsgIO :: IO a -> IO (Either String a)
+catchMsgIO a = dispatch <$> tryIO a
+	where
+		dispatch (Left e) = Left $ show e
+		dispatch (Right v) = Right v
+
+{- catch specialized for IO errors only -}
+catchIO :: IO a -> (IOException -> IO a) -> IO a
+catchIO = catch
+
+{- try specialized for IO errors only -}
+tryIO :: IO a -> IO (Either IOException a)
+tryIO = try
diff --git a/Utility/Misc.hs b/Utility/Misc.hs
index c9bfcb953..3ac5ca5c0 100644
--- a/Utility/Misc.hs
+++ b/Utility/Misc.hs
@@ -8,9 +8,7 @@
 module Utility.Misc where
 
 import System.IO
-import System.IO.Error (try)
 import Control.Monad
-import Control.Applicative
 
 {- A version of hgetContents that is not lazy. Ensures file is 
  - all read before it gets closed. -}
@@ -37,22 +35,3 @@ separate c l = unbreak $ break c l
 {- Breaks out the first line. -}
 firstLine :: String-> String
 firstLine = takeWhile (/= '\n')
-
-{- Catches IO errors and returns a Bool -}
-catchBoolIO :: IO Bool -> IO Bool
-catchBoolIO a = catchDefaultIO a False
-
-{- Catches IO errors and returns a Maybe -}
-catchMaybeIO :: IO a -> IO (Maybe a)
-catchMaybeIO a = catchDefaultIO (Just <$> a) Nothing
-
-{- Catches IO errors and returns a default value. -}
-catchDefaultIO :: IO a -> a -> IO a
-catchDefaultIO a def = catch a (const $ return def)
-
-{- Catches IO errors and returns the error message. -}
-catchMsgIO :: IO a -> IO (Either String a)
-catchMsgIO a = dispatch <$> try a
-	where
-		dispatch (Left e) = Left $ show e
-		dispatch (Right v) = Right v
diff --git a/Utility/TempFile.hs b/Utility/TempFile.hs
index 469d52e8c..4dcbf1cca 100644
--- a/Utility/TempFile.hs
+++ b/Utility/TempFile.hs
@@ -12,7 +12,7 @@ import System.IO
 import System.Posix.Process hiding (executeFile)
 import System.Directory
 
-import Utility.Misc
+import Utility.Exception
 import Utility.Path
 
 {- Runs an action like writeFile, writing to a temp file first and