factor out Annex exception handling module

This commit is contained in:
Joey Hess 2011-10-04 00:34:04 -04:00
parent 1a96d4ab35
commit ff21fd4a65
3 changed files with 34 additions and 14 deletions

27
Annex/Exception.hs Normal file
View file

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

View file

@ -21,10 +21,9 @@ module Branch (
import System.IO.Binary import System.IO.Binary
import System.Exit import System.Exit
import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.ByteString.Lazy.Char8 as L
import Control.Monad.IO.Control (liftIOOp)
import qualified Control.Exception
import AnnexCommon import AnnexCommon
import Annex.Exception
import Types.BranchState import Types.BranchState
import qualified Git import qualified Git
import qualified Git.UnionMerge import qualified Git.UnionMerge
@ -66,7 +65,7 @@ withIndex' bootstrapping a = do
g <- gitRepo g <- gitRepo
let f = index g let f = index g
bracket (Git.useIndex f) id $ do bracketIO (Git.useIndex f) id $ do
unlessM (liftIO $ doesFileExist f) $ do unlessM (liftIO $ doesFileExist f) $ do
unless bootstrapping create unless bootstrapping create
liftIO $ createDirectoryIfMissing True $ takeDirectory f liftIO $ createDirectoryIfMissing True $ takeDirectory f
@ -93,9 +92,9 @@ invalidateCache = do
setState state { cachedFile = Nothing, cachedContent = "" } setState state { cachedFile = Nothing, cachedContent = "" }
getCache :: FilePath -> Annex (Maybe String) getCache :: FilePath -> Annex (Maybe String)
getCache file = getState >>= handle getCache file = getState >>= go
where where
handle state go state
| cachedFile state == Just file = | cachedFile state == Just file =
return $ Just $ cachedContent state return $ Just $ cachedContent state
| otherwise = return Nothing | otherwise = return Nothing
@ -328,14 +327,10 @@ lockJournal :: Annex a -> Annex a
lockJournal a = do lockJournal a = do
g <- gitRepo g <- gitRepo
let file = gitAnnexJournalLock g let file = gitAnnexJournalLock g
bracket (lock file) unlock a bracketIO (lock file) unlock a
where where
lock file = do lock file = do
l <- createFile file stdFileMode l <- createFile file stdFileMode
waitToSetLock l (WriteLock, AbsoluteSeek, 0, 0) waitToSetLock l (WriteLock, AbsoluteSeek, 0, 0)
return l return l
unlock = closeFd unlock = closeFd
bracket :: IO c -> (c -> IO b) -> Annex a -> Annex a
bracket start cleanup go =
liftIOOp (Control.Exception.bracket start cleanup) (const go)

View file

@ -7,10 +7,8 @@
module Command.Add where module Command.Add where
import Control.Exception.Control (handle)
import Control.Exception.Base (throwIO)
import AnnexCommon import AnnexCommon
import Annex.Exception
import Command import Command
import qualified Annex import qualified Annex
import qualified AnnexQueue import qualified AnnexQueue
@ -58,7 +56,7 @@ undo file key e = do
logStatus key InfoMissing logStatus key InfoMissing
rethrow rethrow
where where
rethrow = liftIO $ throwIO e rethrow = throw e
-- fromAnnex could fail if the file ownership is weird -- fromAnnex could fail if the file ownership is weird
tryharder :: IOException -> Annex () tryharder :: IOException -> Annex ()