Merge branch 'master' into tor
This commit is contained in:
commit
95916b2ecf
149 changed files with 925 additions and 305 deletions
|
@ -38,7 +38,7 @@ performCommandAction Command { cmdcheck = c, cmdname = name } seek cont = do
|
|||
showerrcount =<< Annex.getState Annex.errcounter
|
||||
where
|
||||
showerrcount 0 = noop
|
||||
showerrcount cnt = error $ name ++ ": " ++ show cnt ++ " failed"
|
||||
showerrcount cnt = giveup $ name ++ ": " ++ show cnt ++ " failed"
|
||||
|
||||
{- Runs one of the actions needed to perform a command.
|
||||
- Individual actions can fail without stopping the whole command,
|
||||
|
|
|
@ -56,7 +56,7 @@ batchInput parser a = do
|
|||
either parseerr a (parser v)
|
||||
batchInput parser a
|
||||
where
|
||||
parseerr s = error $ "Batch input parse failure: " ++ s
|
||||
parseerr s = giveup $ "Batch input parse failure: " ++ s
|
||||
|
||||
-- Runs a CommandStart in batch mode.
|
||||
--
|
||||
|
|
|
@ -71,7 +71,7 @@ globalOptions =
|
|||
check Nothing = unexpected expected "uninitialized repository"
|
||||
check (Just u) = unexpectedUUID expected u
|
||||
unexpectedUUID expected u = unexpected expected $ "UUID " ++ fromUUID u
|
||||
unexpected expected s = error $
|
||||
unexpected expected s = giveup $
|
||||
"expected repository UUID " ++ expected ++ " but found " ++ s
|
||||
|
||||
run :: [String] -> IO ()
|
||||
|
@ -109,7 +109,7 @@ builtin cmd dir params = do
|
|||
Git.Config.read r
|
||||
`catchIO` \_ -> do
|
||||
hn <- fromMaybe "unknown" <$> getHostname
|
||||
error $ "failed to read git config of git repository in " ++ hn ++ " on " ++ dir ++ "; perhaps this repository is not set up correctly or has moved"
|
||||
giveup $ "failed to read git config of git repository in " ++ hn ++ " on " ++ dir ++ "; perhaps this repository is not set up correctly or has moved"
|
||||
|
||||
external :: [String] -> IO ()
|
||||
external params = do
|
||||
|
@ -120,7 +120,7 @@ external params = do
|
|||
checkDirectory lastparam
|
||||
checkNotLimited
|
||||
unlessM (boolSystem "git-shell" $ map Param $ "-c":params') $
|
||||
error "git-shell failed"
|
||||
giveup "git-shell failed"
|
||||
|
||||
{- Split the input list into 3 groups separated with a double dash --.
|
||||
- Parameters between two -- markers are field settings, in the form:
|
||||
|
@ -150,6 +150,6 @@ checkField (field, val)
|
|||
| otherwise = False
|
||||
|
||||
failure :: IO ()
|
||||
failure = error $ "bad parameters\n\n" ++ usage h cmds
|
||||
failure = giveup $ "bad parameters\n\n" ++ usage h cmds
|
||||
where
|
||||
h = "git-annex-shell [-c] command [parameters ...] [option ...]"
|
||||
|
|
|
@ -26,7 +26,7 @@ checkEnv var = do
|
|||
case v of
|
||||
Nothing -> noop
|
||||
Just "" -> noop
|
||||
Just _ -> error $ "Action blocked by " ++ var
|
||||
Just _ -> giveup $ "Action blocked by " ++ var
|
||||
|
||||
checkDirectory :: Maybe FilePath -> IO ()
|
||||
checkDirectory mdir = do
|
||||
|
@ -44,7 +44,7 @@ checkDirectory mdir = do
|
|||
then noop
|
||||
else req d' (Just dir')
|
||||
where
|
||||
req d mdir' = error $ unwords
|
||||
req d mdir' = giveup $ unwords
|
||||
[ "Only allowed to access"
|
||||
, d
|
||||
, maybe "and could not determine directory from command line" ("not " ++) mdir'
|
||||
|
@ -64,4 +64,4 @@ gitAnnexShellCheck :: Command -> Command
|
|||
gitAnnexShellCheck = addCheck okforshell . dontCheck repoExists
|
||||
where
|
||||
okforshell = unlessM (isInitialized <||> isJust . gcryptId <$> Annex.getGitConfig) $
|
||||
error "Not a git-annex or gcrypt repository."
|
||||
giveup "Not a git-annex or gcrypt repository."
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue