summaryrefslogtreecommitdiff
path: root/Remote/Git.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2016-11-15 21:29:54 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2016-11-15 21:29:54 -0400
commit381766efcdddb4c8706408a90c515470a6aa43a7 (patch)
treedda693b36724839ff2daff0e0766b7bdd883ea2c /Remote/Git.hs
parent27fafd61c39f8436e19e8fd449b5851ead10bbd1 (diff)
Avoid backtraces on expected failures when built with ghc 8; only use backtraces for unexpected errors.
ghc 8 added backtraces on uncaught errors. This is great, but git-annex was using error in many places for a error message targeted at the user, in some known problem case. A backtrace only confuses such a message, so omit it. Notably, commands like git annex drop that failed due to eg, numcopies, used to use error, so had a backtrace. This commit was sponsored by Ethan Aubin.
Diffstat (limited to 'Remote/Git.hs')
-rw-r--r--Remote/Git.hs22
1 files changed, 11 insertions, 11 deletions
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 34bdd83a1..3304e2069 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -95,20 +95,20 @@ list autoinit = do
-}
gitSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
gitSetup Nothing _ c _ = do
- let location = fromMaybe (error "Specify location=url") $
+ let location = fromMaybe (giveup "Specify location=url") $
Url.parseURIRelaxed =<< M.lookup "location" c
g <- Annex.gitRepo
u <- case filter (\r -> Git.location r == Git.Url location) (Git.remotes g) of
[r] -> getRepoUUID r
- [] -> error "could not find existing git remote with specified location"
- _ -> error "found multiple git remotes with specified location"
+ [] -> giveup "could not find existing git remote with specified location"
+ _ -> giveup "found multiple git remotes with specified location"
return (c, u)
gitSetup (Just u) _ c _ = do
inRepo $ Git.Command.run
[ Param "remote"
, Param "add"
- , Param $ fromMaybe (error "no name") (M.lookup "name" c)
- , Param $ fromMaybe (error "no location") (M.lookup "location" c)
+ , Param $ fromMaybe (giveup "no name") (M.lookup "name" c)
+ , Param $ fromMaybe (giveup "no location") (M.lookup "location" c)
]
return (c, u)
@@ -202,7 +202,7 @@ tryGitConfigRead :: Bool -> Git.Repo -> Annex Git.Repo
tryGitConfigRead autoinit r
| haveconfig r = return r -- already read
| Git.repoIsSsh r = store $ do
- v <- Ssh.onRemote r (pipedconfig, return (Left $ error "configlist failed")) "configlist" [] configlistfields
+ v <- Ssh.onRemote r (pipedconfig, return (Left $ giveup "configlist failed")) "configlist" [] configlistfields
case v of
Right r'
| haveconfig r' -> return r'
@@ -321,7 +321,7 @@ inAnnex rmt key
showChecking r
ifM (Url.withUrlOptions $ \uo -> anyM (\u -> Url.checkBoth u (keySize key) uo) (keyUrls rmt key))
( return True
- , error "not found"
+ , giveup "not found"
)
checkremote = Ssh.inAnnex r key
checklocal = guardUsable r (cantCheck r) $
@@ -357,7 +357,7 @@ dropKey r key
logStatus key InfoMissing
Annex.Content.saveState True
return True
- | Git.repoIsHttp (repo r) = error "dropping from http remote not supported"
+ | Git.repoIsHttp (repo r) = giveup "dropping from http remote not supported"
| otherwise = commitOnCleanup r $ Ssh.dropKey (repo r) key
lockKey :: Remote -> Key -> (VerifiedCopy -> Annex r) -> Annex r
@@ -414,7 +414,7 @@ lockKey r key callback
failedlock
| otherwise = failedlock
where
- failedlock = error "can't lock content"
+ failedlock = giveup "can't lock content"
{- Tries to copy a key's content from a remote's annex to a file. -}
copyFromRemote :: Remote -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex (Bool, Verification)
@@ -444,7 +444,7 @@ copyFromRemote' r key file dest meterupdate
| Git.repoIsSsh (repo r) = unVerified $ feedprogressback $ \p -> do
Ssh.rsyncHelper (Just (combineMeterUpdate meterupdate p))
=<< Ssh.rsyncParamsRemote False r Download key dest file
- | otherwise = error "copying from non-ssh, non-http remote not supported"
+ | otherwise = giveup "copying from non-ssh, non-http remote not supported"
where
{- Feed local rsync's progress info back to the remote,
- by forking a feeder thread that runs
@@ -547,7 +547,7 @@ copyToRemote' r key file meterupdate
unlocked <- isDirect <||> versionSupportsUnlockedPointers
Ssh.rsyncHelper (Just meterupdate)
=<< Ssh.rsyncParamsRemote unlocked r Upload key object file
- | otherwise = error "copying to non-ssh repo not supported"
+ | otherwise = giveup "copying to non-ssh repo not supported"
where
copylocal Nothing = return False
copylocal (Just (object, checksuccess)) = do