diff options
Diffstat (limited to 'Annex')
| -rw-r--r-- | Annex/Content.hs | 5 | ||||
| -rw-r--r-- | Annex/Direct.hs | 3 | ||||
| -rw-r--r-- | Annex/Drop.hs | 3 | ||||
| -rw-r--r-- | Annex/Environment.hs | 3 | ||||
| -rw-r--r-- | Annex/Exception.hs | 63 | ||||
| -rw-r--r-- | Annex/Index.hs | 3 | ||||
| -rw-r--r-- | Annex/Journal.hs | 1 | ||||
| -rw-r--r-- | Annex/LockFile.hs | 1 | ||||
| -rw-r--r-- | Annex/Perms.hs | 5 | ||||
| -rw-r--r-- | Annex/ReplaceFile.hs | 3 | ||||
| -rw-r--r-- | Annex/Transfer.hs | 3 | ||||
| -rw-r--r-- | Annex/View.hs | 6 |
12 files changed, 13 insertions, 86 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs index eb84f2fe9..b51e15827 100644 --- a/Annex/Content.hs +++ b/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 diff --git a/Annex/Direct.hs b/Annex/Direct.hs index e6b941e0f..374599369 100644 --- a/Annex/Direct.hs +++ b/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 diff --git a/Annex/Drop.hs b/Annex/Drop.hs index 71263dc61..c5a3fbe5f 100644 --- a/Annex/Drop.hs +++ b/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 diff --git a/Annex/Environment.hs b/Annex/Environment.hs index 4b8d38464..bc97c17b7 100644 --- a/Annex/Environment.hs +++ b/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 diff --git a/Annex/Exception.hs b/Annex/Exception.hs deleted file mode 100644 index 5ecbd28a0..000000000 --- a/Annex/Exception.hs +++ /dev/null @@ -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) diff --git a/Annex/Index.hs b/Annex/Index.hs index af0cab45e..7757a412b 100644 --- a/Annex/Index.hs +++ b/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} } diff --git a/Annex/Journal.hs b/Annex/Journal.hs index f34a7be1b..798bcba29 100644 --- a/Annex/Journal.hs +++ b/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 diff --git a/Annex/LockFile.hs b/Annex/LockFile.hs index 8114e94f2..dc4f82f98 100644 --- a/Annex/LockFile.hs +++ b/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 diff --git a/Annex/Perms.hs b/Annex/Perms.hs index e3a2fa65a..3430554c7 100644 --- a/Annex/Perms.hs +++ b/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 diff --git a/Annex/ReplaceFile.hs b/Annex/ReplaceFile.hs index e734c4d64..8776762e9 100644 --- a/Annex/ReplaceFile.hs +++ b/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 diff --git a/Annex/Transfer.hs b/Annex/Transfer.hs index 001539adc..ebc8e8b89 100644 --- a/Annex/Transfer.hs +++ b/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 diff --git a/Annex/View.hs b/Annex/View.hs index b96981612..a1d873f50 100644 --- a/Annex/View.hs +++ b/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 |