c784ef4586
Removed old extensible-exceptions, only needed for very old ghc. Made webdav use Utility.Exception, to work after some changes in DAV's exception handling. Removed Annex.Exception. Mostly this was trivial, but note that tryAnnex is replaced with tryNonAsync and catchAnnex replaced with catchNonAsync. In theory that could be a behavior change, since the former caught all exceptions, and the latter don't catch async exceptions. However, in practice, nothing in the Annex monad uses async exceptions. Grepping for throwTo and killThread only find stuff in the assistant, which does not seem related. Command.Add.undo is changed to accept a SomeException, and things that use it for rollback now catch non-async exceptions, rather than only IOExceptions.
52 lines
1.4 KiB
Haskell
52 lines
1.4 KiB
Haskell
{- Using other git index files
|
|
-
|
|
- Copyright 2014 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE CPP #-}
|
|
|
|
module Annex.Index (
|
|
withIndexFile,
|
|
addGitEnv,
|
|
) where
|
|
|
|
import qualified Control.Exception as E
|
|
|
|
import Common.Annex
|
|
import Git.Types
|
|
import qualified Annex
|
|
import Utility.Env
|
|
|
|
{- Runs an action using a different git index file. -}
|
|
withIndexFile :: FilePath -> Annex a -> Annex a
|
|
withIndexFile f a = do
|
|
g <- gitRepo
|
|
g' <- liftIO $ addGitEnv g "GIT_INDEX_FILE" f
|
|
|
|
r <- tryNonAsync $ do
|
|
Annex.changeState $ \s -> s { Annex.repo = g' }
|
|
a
|
|
Annex.changeState $ \s -> s { Annex.repo = (Annex.repo s) { gitEnv = gitEnv g} }
|
|
either E.throw return r
|
|
|
|
addGitEnv :: Repo -> String -> String -> IO Repo
|
|
addGitEnv g var val = do
|
|
e <- maybe copyenv return (gitEnv g)
|
|
let e' = addEntry var val e
|
|
return $ g { gitEnv = Just e' }
|
|
where
|
|
copyenv = do
|
|
#ifdef __ANDROID__
|
|
{- This should not be necessary on Android, but there is some
|
|
- weird getEnvironment breakage. See
|
|
- https://github.com/neurocyte/ghc-android/issues/7
|
|
- Use getEnv to get some key environment variables that
|
|
- git expects to have. -}
|
|
let keyenv = words "USER PATH GIT_EXEC_PATH HOSTNAME HOME"
|
|
let getEnvPair k = maybe Nothing (\v -> Just (k, v)) <$> getEnv k
|
|
liftIO $ catMaybes <$> forM keyenv getEnvPair
|
|
#else
|
|
liftIO getEnvironment
|
|
#endif
|