mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

Avoid backtraces on expected failures when built with ghc 8; only use backtraces for unexpected errors.

Browse source 
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.
This commit is contained in:
Joey Hess 2016-11-15 21:29:54 -04:00
parent 69915c6c9b
commit 0a4479b8ec
No known key found for this signature in database
GPG key ID: C910D9222512E3C7
116 changed files with 287 additions and 270 deletions
Download patch file Download diff file Expand all files Collapse all files

16
CmdLine/Seek.hs
View file

@ -40,7 +40,7 @@ withFilesInGitNonRecursive :: String -> (FilePath -> CommandStart) -> CmdParams
withFilesInGitNonRecursive needforce a params = ifM (Annex.getState Annex.force)
( withFilesInGit a params
, if null params
then error needforce
then giveup needforce
else seekActions $ prepFiltered a (getfiles [] params)
)
where
@ -54,7 +54,7 @@ withFilesInGitNonRecursive needforce a params = ifM (Annex.getState Annex.force)
[] -> do
void $ liftIO $ cleanup
getfiles c ps
_ -> error needforce
_ -> giveup needforce
withFilesNotInGit :: Bool -> (FilePath -> CommandStart) -> CmdParams -> CommandSeek
withFilesNotInGit skipdotfiles a params
@ -117,7 +117,7 @@ withPairs a params = seekActions $ return $ map a $ pairs [] params
where
pairs c [] = reverse c
pairs c (x:y:xs) = pairs ((x,y):c) xs
pairs _ _ = error "expected pairs"
pairs _ _ = giveup "expected pairs"
withFilesToBeCommitted :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek
withFilesToBeCommitted a params = seekActions $ prepFiltered a $
@ -152,11 +152,11 @@ withFilesMaybeModified a params = seekActions $
withKeys :: (Key -> CommandStart) -> CmdParams -> CommandSeek
withKeys a params = seekActions $ return $ map (a . parse) params
where
parse p = fromMaybe (error "bad key") $ file2key p
parse p = fromMaybe (giveup "bad key") $ file2key p
withNothing :: CommandStart -> CmdParams -> CommandSeek
withNothing a [] = seekActions $ return [a]
withNothing _ _ = error "This command takes no parameters."
withNothing _ _ = giveup "This command takes no parameters."
{- Handles the --all, --branch, --unused, --failed, --key, and
- --incomplete options, which specify particular keys to run an
@ -191,7 +191,7 @@ withKeyOptions'
withKeyOptions' ko auto mkkeyaction fallbackaction params = do
bare <- fromRepo Git.repoIsLocalBare
when (auto && bare) $
error "Cannot use --auto in a bare repository"
giveup "Cannot use --auto in a bare repository"
case (null params, ko) of
(True, Nothing)
| bare -> noauto $ runkeyaction loggedKeys
@ -203,10 +203,10 @@ withKeyOptions' ko auto mkkeyaction fallbackaction params = do
(True, Just (WantSpecificKey k)) -> noauto $ runkeyaction (return [k])
(True, Just WantIncompleteKeys) -> noauto $ runkeyaction incompletekeys
(True, Just (WantBranchKeys bs)) -> noauto $ runbranchkeys bs
(False, Just _) -> error "Can only specify one of file names, --all, --branch, --unused, --failed, --key, or --incomplete"
(False, Just _) -> giveup "Can only specify one of file names, --all, --branch, --unused, --failed, --key, or --incomplete"
where
noauto a
| auto = error "Cannot use --auto with --all or --branch or --unused or --key or --incomplete"
| auto = giveup "Cannot use --auto with --all or --branch or --unused or --key or --incomplete"
| otherwise = a
incompletekeys = staleKeysPrune gitAnnexTmpObjectDir True
runkeyaction getks = do