From ff21fd4a652cc6516d0e06ab885adf1c93eddced Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 4 Oct 2011 00:34:04 -0400
Subject: factor out Annex exception handling module

---
 Annex/Exception.hs | 27 +++++++++++++++++++++++++++
 Branch.hs          | 15 +++++----------
 Command/Add.hs     |  6 ++----
 3 files changed, 34 insertions(+), 14 deletions(-)
 create mode 100644 Annex/Exception.hs

diff --git a/Annex/Exception.hs b/Annex/Exception.hs
new file mode 100644
index 000000000..549ef4fd5
--- /dev/null
+++ b/Annex/Exception.hs
@@ -0,0 +1,27 @@
+{- exception handling in the git-annex monad
+ -
+ - Copyright 2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Annex.Exception (
+	bracketIO,
+	handle,
+	throw,
+) where
+
+import Control.Exception.Control (handle)
+import Control.Monad.IO.Control (liftIOOp)
+import Control.Exception hiding (handle, throw)
+
+import AnnexCommon
+
+{- Runs an Annex action, with setup and cleanup both in the IO monad. -}
+bracketIO :: IO c -> (c -> IO b) -> Annex a -> Annex a
+bracketIO setup cleanup go =
+	liftIOOp (Control.Exception.bracket setup cleanup) (const go)
+
+{- Throws an exception in the Annex monad. -}
+throw :: Control.Exception.Exception e => e -> Annex a
+throw = liftIO . throwIO
diff --git a/Branch.hs b/Branch.hs
index 554f16848..a2ddc70ac 100644
--- a/Branch.hs
+++ b/Branch.hs
@@ -21,10 +21,9 @@ module Branch (
 import System.IO.Binary
 import System.Exit
 import qualified Data.ByteString.Lazy.Char8 as L
-import Control.Monad.IO.Control (liftIOOp)
-import qualified Control.Exception
 
 import AnnexCommon
+import Annex.Exception
 import Types.BranchState
 import qualified Git
 import qualified Git.UnionMerge
@@ -66,7 +65,7 @@ withIndex' bootstrapping a = do
 	g <- gitRepo
 	let f = index g
 
-	bracket (Git.useIndex f) id $ do
+	bracketIO (Git.useIndex f) id $ do
 		unlessM (liftIO $ doesFileExist f) $ do
 			unless bootstrapping create
 			liftIO $ createDirectoryIfMissing True $ takeDirectory f
@@ -93,9 +92,9 @@ invalidateCache = do
 	setState state { cachedFile = Nothing, cachedContent = "" }
 
 getCache :: FilePath -> Annex (Maybe String)
-getCache file = getState >>= handle
+getCache file = getState >>= go
 	where
-		handle state
+		go state
 			| cachedFile state == Just file =
 				return $ Just $ cachedContent state
 			| otherwise = return Nothing
@@ -328,14 +327,10 @@ lockJournal :: Annex a -> Annex a
 lockJournal a = do
 	g <- gitRepo
 	let file = gitAnnexJournalLock g
-	bracket (lock file) unlock a
+	bracketIO (lock file) unlock a
 	where
 		lock file = do
 			l <- createFile file stdFileMode
 			waitToSetLock l (WriteLock, AbsoluteSeek, 0, 0)
 			return l
 		unlock = closeFd
-
-bracket :: IO c -> (c -> IO b) -> Annex a -> Annex a
-bracket start cleanup go =
-	liftIOOp (Control.Exception.bracket start cleanup) (const go)
diff --git a/Command/Add.hs b/Command/Add.hs
index c66c38131..299b5f36e 100644
--- a/Command/Add.hs
+++ b/Command/Add.hs
@@ -7,10 +7,8 @@
 
 module Command.Add where
 
-import Control.Exception.Control (handle)
-import Control.Exception.Base (throwIO)
-
 import AnnexCommon
+import Annex.Exception
 import Command
 import qualified Annex
 import qualified AnnexQueue
@@ -58,7 +56,7 @@ undo file key e = do
 	logStatus key InfoMissing
 	rethrow
 	where
-		rethrow = liftIO $ throwIO e
+		rethrow = throw e
 
 		-- fromAnnex could fail if the file ownership is weird
 		tryharder :: IOException -> Annex ()
-- 
cgit v1.2.3