Merge branch 'master' into tor

This commit is contained in:
Joey Hess 2016-11-17 12:56:27 -04:00
commit 95916b2ecf
No known key found for this signature in database
GPG key ID: C910D9222512E3C7
149 changed files with 925 additions and 305 deletions

View file

@ -38,4 +38,4 @@ perform key = next $ do
- it seems better to error out, rather than moving bad/tmp content into
- the annex. -}
performOther :: String -> Key -> CommandPerform
performOther other _ = error $ "cannot addunused " ++ other ++ "content"
performOther other _ = giveup $ "cannot addunused " ++ other ++ "content"

View file

@ -133,7 +133,7 @@ checkUrl r o u = do
let f' = adjustFile o (deffile </> fromSafeFilePath f)
void $ commandAction $
startRemote r (relaxedOption o) f' u' sz
| otherwise = error $ unwords
| otherwise = giveup $ unwords
[ "That url contains multiple files according to the"
, Remote.name r
, " remote; cannot add it to a single file."
@ -182,7 +182,7 @@ startWeb :: AddUrlOptions -> String -> CommandStart
startWeb o s = go $ fromMaybe bad $ parseURI urlstring
where
(urlstring, downloader) = getDownloader s
bad = fromMaybe (error $ "bad url " ++ urlstring) $
bad = fromMaybe (giveup $ "bad url " ++ urlstring) $
Url.parseURIRelaxed $ urlstring
go url = case downloader of
QuviDownloader -> usequvi
@ -208,7 +208,7 @@ startWeb o s = go $ fromMaybe bad $ parseURI urlstring
)
showStart "addurl" file
next $ performWeb (relaxedOption o) urlstring file urlinfo
badquvi = error $ "quvi does not know how to download url " ++ urlstring
badquvi = giveup $ "quvi does not know how to download url " ++ urlstring
usequvi = do
page <- fromMaybe badquvi
<$> withQuviOptions Quvi.forceQuery [Quvi.quiet, Quvi.httponly] urlstring
@ -372,7 +372,7 @@ url2file url pathdepth pathmax = case pathdepth of
| depth >= length urlbits -> frombits id
| depth > 0 -> frombits $ drop depth
| depth < 0 -> frombits $ reverse . take (negate depth) . reverse
| otherwise -> error "bad --pathdepth"
| otherwise -> giveup "bad --pathdepth"
where
fullurl = concat
[ maybe "" uriRegName (uriAuthority url)
@ -385,7 +385,7 @@ url2file url pathdepth pathmax = case pathdepth of
urlString2file :: URLString -> Maybe Int -> Int -> FilePath
urlString2file s pathdepth pathmax = case Url.parseURIRelaxed s of
Nothing -> error $ "bad uri " ++ s
Nothing -> giveup $ "bad uri " ++ s
Just u -> url2file u pathdepth pathmax
adjustFile :: AddUrlOptions -> FilePath -> FilePath

View file

@ -66,14 +66,14 @@ startNoRepo :: AssistantOptions -> IO ()
startNoRepo o
| autoStartOption o = autoStart o
| autoStopOption o = autoStop
| otherwise = error "Not in a git repository."
| otherwise = giveup "Not in a git repository."
autoStart :: AssistantOptions -> IO ()
autoStart o = do
dirs <- liftIO readAutoStartFile
when (null dirs) $ do
f <- autoStartFile
error $ "Nothing listed in " ++ f
giveup $ "Nothing listed in " ++ f
program <- programPath
haveionice <- pure Build.SysConfig.ionice <&&> inPath "ionice"
forM_ dirs $ \d -> do

View file

@ -40,7 +40,7 @@ seek o = case batchOption o of
_ -> wrongnumparams
batchInput Right $ checker >=> batchResult
where
wrongnumparams = error "Wrong number of parameters"
wrongnumparams = giveup "Wrong number of parameters"
data Result = Present | NotPresent | CheckFailure String
@ -71,8 +71,8 @@ batchResult Present = liftIO $ putStrLn "1"
batchResult _ = liftIO $ putStrLn "0"
toKey :: String -> Key
toKey = fromMaybe (error "Bad key") . file2key
toKey = fromMaybe (giveup "Bad key") . file2key
toRemote :: String -> Annex Remote
toRemote rn = maybe (error "Unknown remote") return
toRemote rn = maybe (giveup "Unknown remote") return
=<< Remote.byNameWithUUID (Just rn)

View file

@ -19,7 +19,7 @@ cmd = noCommit $ noMessages $
run :: () -> String -> Annex Bool
run _ p = do
let k = fromMaybe (error "bad key") $ file2key p
let k = fromMaybe (giveup "bad key") $ file2key p
maybe (return False) (\f -> liftIO (putStrLn f) >> return True)
=<< inAnnex' (pure True) Nothing check k
where

View file

@ -37,7 +37,7 @@ startKey key = do
ls <- keyLocations key
case ls of
[] -> next $ performKey key
_ -> error "This key is still known to be present in some locations; not marking as dead."
_ -> giveup "This key is still known to be present in some locations; not marking as dead."
performKey :: Key -> CommandPerform
performKey key = do

View file

@ -25,7 +25,7 @@ start (name:description) = do
showStart "describe" name
u <- Remote.nameToUUID name
next $ perform u $ unwords description
start _ = error "Specify a repository and a description."
start _ = giveup "Specify a repository and a description."
perform :: UUID -> String -> CommandPerform
perform u description = do

View file

@ -73,7 +73,7 @@ parseReq opts = case separate (== "--") opts of
mk (unmergedpath:[]) = UnmergedReq { rPath = unmergedpath }
mk _ = badopts
badopts = error $ "Unexpected input: " ++ unwords opts
badopts = giveup $ "Unexpected input: " ++ unwords opts
{- Check if either file is a symlink to a git-annex object,
- which git-diff will leave as a normal file containing the link text.

View file

@ -26,7 +26,7 @@ seek = withNothing start
start :: CommandStart
start = ifM versionSupportsDirectMode
( ifM isDirect ( stop , next perform )
, error "Direct mode is not suppported by this repository version. Use git-annex unlock instead."
, giveup "Direct mode is not suppported by this repository version. Use git-annex unlock instead."
)
perform :: CommandPerform

View file

@ -32,7 +32,7 @@ optParser desc = DropKeyOptions
seek :: DropKeyOptions -> CommandSeek
seek o = do
unlessM (Annex.getState Annex.force) $
error "dropkey can cause data loss; use --force if you're sure you want to do this"
giveup "dropkey can cause data loss; use --force if you're sure you want to do this"
withKeys start (toDrop o)
case batchOption o of
Batch -> batchInput parsekey $ batchCommandAction . start

View file

@ -63,7 +63,7 @@ startSpecialRemote name config Nothing = do
_ -> unknownNameError "Unknown remote name."
startSpecialRemote name config (Just (u, c)) = do
let fullconfig = config `M.union` c
t <- either error return (Annex.SpecialRemote.findType fullconfig)
t <- either giveup return (Annex.SpecialRemote.findType fullconfig)
showStart "enableremote" name
gc <- maybe def Remote.gitconfig <$> Remote.byUUID u
next $ performSpecialRemote t u fullconfig gc
@ -94,7 +94,7 @@ unknownNameError prefix = do
disabledremotes <- filterM isdisabled =<< Annex.fromRepo Git.remotes
let remotesmsg = unlines $ map ("\t" ++) $
mapMaybe Git.remoteName disabledremotes
error $ concat $ filter (not . null) [prefix ++ "\n", remotesmsg, specialmsg]
giveup $ concat $ filter (not . null) [prefix ++ "\n", remotesmsg, specialmsg]
where
isdisabled r = anyM id
[ (==) NoUUID <$> getRepoUUID r

View file

@ -21,6 +21,6 @@ cmd = noCommit $ noMessages $ dontCheck repoExists $
run :: Maybe Utility.Format.Format -> String -> Annex Bool
run format p = do
let k = fromMaybe (error "bad key") $ file2key p
let k = fromMaybe (giveup "bad key") $ file2key p
showFormatted format (key2file k) (keyVars k)
return True

View file

@ -92,7 +92,7 @@ start (Expire expire) noact actlog descs u =
data Expire = Expire (M.Map (Maybe UUID) (Maybe POSIXTime))
parseExpire :: [String] -> Annex Expire
parseExpire [] = error "Specify an expire time."
parseExpire [] = giveup "Specify an expire time."
parseExpire ps = do
now <- liftIO getPOSIXTime
Expire . M.fromList <$> mapM (parse now) ps
@ -104,7 +104,7 @@ parseExpire ps = do
return (Just r, parsetime now t)
parsetime _ "never" = Nothing
parsetime now s = case parseDuration s of
Nothing -> error $ "bad expire time: " ++ s
Nothing -> giveup $ "bad expire time: " ++ s
Just d -> Just (now - durationToPOSIXTime d)
parseActivity :: Monad m => String -> m Activity

View file

@ -33,14 +33,14 @@ start force (keyname:file:[]) = do
let key = mkKey keyname
unless force $ do
inbackend <- inAnnex key
unless inbackend $ error $
unless inbackend $ giveup $
"key ("++ keyname ++") is not present in backend (use --force to override this sanity check)"
showStart "fromkey" file
next $ perform key file
start _ [] = do
showStart "fromkey" "stdin"
next massAdd
start _ _ = error "specify a key and a dest file"
start _ _ = giveup "specify a key and a dest file"
massAdd :: CommandPerform
massAdd = go True =<< map (separate (== ' ')) . lines <$> liftIO getContents
@ -51,7 +51,7 @@ massAdd = go True =<< map (separate (== ' ')) . lines <$> liftIO getContents
ok <- perform' key f
let !status' = status && ok
go status' rest
go _ _ = error "Expected pairs of key and file on stdin, but got something else."
go _ _ = giveup "Expected pairs of key and file on stdin, but got something else."
-- From user input to a Key.
-- User can input either a serialized key, or an url.
@ -66,7 +66,7 @@ mkKey s = case parseURI s of
Backend.URL.fromUrl s Nothing
_ -> case file2key s of
Just k -> k
Nothing -> error $ "bad key/url " ++ s
Nothing -> giveup $ "bad key/url " ++ s
perform :: Key -> FilePath -> CommandPerform
perform key file = do

View file

@ -89,7 +89,7 @@ seek o = allowConcurrentOutput $ do
checkDeadRepo u
i <- prepIncremental u (incrementalOpt o)
withKeyOptions (keyOptions o) False
(\k ai -> startKey i k ai =<< getNumCopies)
(\k ai -> startKey from i k ai =<< getNumCopies)
(withFilesInGit $ whenAnnexed $ start from i)
(fsckFiles o)
cleanupIncremental i
@ -109,7 +109,7 @@ start from inc file key = do
numcopies <- getFileNumCopies file
case from of
Nothing -> go $ perform key file backend numcopies
Just r -> go $ performRemote key file backend numcopies r
Just r -> go $ performRemote key (Just file) backend numcopies r
where
go = runFsck inc (mkActionItem (Just file)) key
@ -129,8 +129,8 @@ perform key file backend numcopies = do
{- To fsck a remote, the content is retrieved to a tmp file,
- and checked locally. -}
performRemote :: Key -> FilePath -> Backend -> NumCopies -> Remote -> Annex Bool
performRemote key file backend numcopies remote =
performRemote :: Key -> AssociatedFile -> Backend -> NumCopies -> Remote -> Annex Bool
performRemote key afile backend numcopies remote =
dispatch =<< Remote.hasKey remote key
where
dispatch (Left err) = do
@ -147,10 +147,10 @@ performRemote key file backend numcopies remote =
return False
dispatch (Right False) = go False Nothing
go present localcopy = check
[ verifyLocationLogRemote key file remote present
[ verifyLocationLogRemote key (maybe (key2file key) id afile) remote present
, checkKeySizeRemote key remote localcopy
, checkBackendRemote backend key remote localcopy
, checkKeyNumCopies key (Just file) numcopies
, checkKeyNumCopies key afile numcopies
]
withtmp a = do
pid <- liftIO getPID
@ -161,7 +161,7 @@ performRemote key file backend numcopies remote =
cleanup
cleanup `after` a tmp
getfile tmp = ifM (checkDiskSpace (Just (takeDirectory tmp)) key 0 True)
( ifM (Remote.retrieveKeyFileCheap remote key (Just file) tmp)
( ifM (Remote.retrieveKeyFileCheap remote key afile tmp)
( return (Just True)
, ifM (Annex.getState Annex.fast)
( return Nothing
@ -173,12 +173,14 @@ performRemote key file backend numcopies remote =
)
dummymeter _ = noop
startKey :: Incremental -> Key -> ActionItem -> NumCopies -> CommandStart
startKey inc key ai numcopies =
startKey :: Maybe Remote -> Incremental -> Key -> ActionItem -> NumCopies -> CommandStart
startKey from inc key ai numcopies =
case Backend.maybeLookupBackendName (keyBackendName key) of
Nothing -> stop
Just backend -> runFsck inc ai key $
performKey key backend numcopies
case from of
Nothing -> performKey key backend numcopies
Just r -> performRemote key Nothing backend numcopies r
performKey :: Key -> Backend -> NumCopies -> Annex Bool
performKey key backend numcopies = do
@ -584,7 +586,7 @@ prepIncremental u (Just StartIncrementalO) = do
recordStartTime u
ifM (FsckDb.newPass u)
( StartIncremental <$> openFsckDb u
, error "Cannot start a new --incremental fsck pass; another fsck process is already running."
, giveup "Cannot start a new --incremental fsck pass; another fsck process is already running."
)
prepIncremental u (Just MoreIncrementalO) =
ContIncremental <$> openFsckDb u

View file

@ -39,7 +39,7 @@ start = do
guardTest :: Annex ()
guardTest = unlessM (fromMaybe False . Git.Config.isTrue <$> getConfig key "") $
error $ unlines
giveup $ unlines
[ "Running fuzz tests *writes* to and *deletes* files in"
, "this repository, and pushes those changes to other"
, "repositories! This is a developer tool, not something"

View file

@ -25,7 +25,7 @@ start :: String -> CommandStart
start gcryptid = next $ next $ do
u <- getUUID
when (u /= NoUUID) $
error "gcryptsetup refusing to run; this repository already has a git-annex uuid!"
giveup "gcryptsetup refusing to run; this repository already has a git-annex uuid!"
g <- gitRepo
gu <- Remote.GCrypt.getGCryptUUID True g
@ -35,5 +35,5 @@ start gcryptid = next $ next $ do
then do
void $ Remote.GCrypt.setupRepo gcryptid g
return True
else error "cannot use gcrypt in a non-bare repository"
else error "gcryptsetup uuid mismatch"
else giveup "cannot use gcrypt in a non-bare repository"
else giveup "gcryptsetup uuid mismatch"

View file

@ -30,7 +30,7 @@ start (name:[]) = do
u <- Remote.nameToUUID name
showRaw . unwords . S.toList =<< lookupGroups u
stop
start _ = error "Specify a repository and a group."
start _ = giveup "Specify a repository and a group."
setGroup :: UUID -> Group -> CommandPerform
setGroup uuid g = do

View file

@ -25,4 +25,4 @@ start (g:[]) = next $ performGet groupPreferredContentMapRaw g
start (g:expr:[]) = do
showStart "groupwanted" g
next $ performSet groupPreferredContentSet expr g
start _ = error "Specify a group."
start _ = giveup "Specify a group."

View file

@ -62,7 +62,7 @@ seek o = allowConcurrentOutput $ do
repopath <- liftIO . absPath =<< fromRepo Git.repoPath
inrepops <- liftIO $ filter (dirContains repopath) <$> mapM absPath (importFiles o)
unless (null inrepops) $ do
error $ "cannot import files from inside the working tree (use git annex add instead): " ++ unwords inrepops
giveup $ "cannot import files from inside the working tree (use git annex add instead): " ++ unwords inrepops
largematcher <- largeFilesMatcher
withPathContents (start largematcher (duplicateMode o)) (importFiles o)

View file

@ -147,7 +147,7 @@ findDownloads u = go =<< downloadFeed u
{- Feeds change, so a feed download cannot be resumed. -}
downloadFeed :: URLString -> Annex (Maybe Feed)
downloadFeed url
| Url.parseURIRelaxed url == Nothing = error "invalid feed url"
| Url.parseURIRelaxed url == Nothing = giveup "invalid feed url"
| otherwise = do
showOutput
uo <- Url.getUrlOptions
@ -336,7 +336,7 @@ noneValue = "none"
- Throws an error if the feed is broken, otherwise shows a warning. -}
feedProblem :: URLString -> String -> Annex ()
feedProblem url message = ifM (checkFeedBroken url)
( error $ message ++ " (having repeated problems with feed: " ++ url ++ ")"
( giveup $ message ++ " (having repeated problems with feed: " ++ url ++ ")"
, warning $ "warning: " ++ message
)

View file

@ -33,9 +33,9 @@ start :: CommandStart
start = ifM isDirect
( do
unlessM (coreSymlinks <$> Annex.getGitConfig) $
error "Git is configured to not use symlinks, so you must use direct mode."
giveup "Git is configured to not use symlinks, so you must use direct mode."
whenM probeCrippledFileSystem $
error "This repository seems to be on a crippled filesystem, you must use direct mode."
giveup "This repository seems to be on a crippled filesystem, you must use direct mode."
next perform
, stop
)

View file

@ -26,16 +26,16 @@ seek :: CmdParams -> CommandSeek
seek = withWords start
start :: [String] -> CommandStart
start [] = error "Specify a name for the remote."
start [] = giveup "Specify a name for the remote."
start (name:ws) = ifM (isJust <$> findExisting name)
( error $ "There is already a special remote named \"" ++ name ++
( giveup $ "There is already a special remote named \"" ++ name ++
"\". (Use enableremote to enable an existing special remote.)"
, do
ifM (isJust <$> Remote.byNameOnly name)
( error $ "There is already a remote named \"" ++ name ++ "\""
( giveup $ "There is already a remote named \"" ++ name ++ "\""
, do
let c = newConfig name
t <- either error return (findType config)
t <- either giveup return (findType config)
showStart "initremote" name
next $ perform t name $ M.union config c

View file

@ -79,7 +79,7 @@ performNew file key = do
unlessM (sameInodeCache obj (maybeToList mfc)) $ do
modifyContent obj $ replaceFile obj $ \tmp -> do
unlessM (checkedCopyFile key obj tmp Nothing) $
error "unable to lock file"
giveup "unable to lock file"
Database.Keys.storeInodeCaches key [obj]
-- Try to repopulate obj from an unmodified associated file.
@ -115,4 +115,4 @@ performOld file = do
next $ return True
errorModified :: a
errorModified = error "Locking this file would discard any changes you have made to it. Use 'git annex add' to stage your changes. (Or, use --force to override)"
errorModified = giveup "Locking this file would discard any changes you have made to it. Use 'git annex add' to stage your changes. (Or, use --force to override)"

View file

@ -32,7 +32,7 @@ start [ks] = do
then exitSuccess
else exitFailure
where
k = fromMaybe (error "bad key") (file2key ks)
k = fromMaybe (giveup "bad key") (file2key ks)
locksuccess = ifM (inAnnex k)
( liftIO $ do
putStrLn contentLockedMarker
@ -41,4 +41,4 @@ start [ks] = do
return True
, return False
)
start _ = error "Specify exactly 1 key."
start _ = giveup "Specify exactly 1 key."

View file

@ -93,7 +93,7 @@ seek o = do
case (logFiles o, allOption o) of
(fs, False) -> withFilesInGit (whenAnnexed $ start o outputter) fs
([], True) -> commandAction (startAll o outputter)
(_, True) -> error "Cannot specify both files and --all"
(_, True) -> giveup "Cannot specify both files and --all"
start :: LogOptions -> (FilePath -> Outputter) -> FilePath -> Key -> CommandStart
start o outputter file key = do

View file

@ -81,7 +81,7 @@ seek o = do
Batch -> withMessageState $ \s -> case outputType s of
JSONOutput _ -> batchInput parseJSONInput $
commandAction . startBatch now
_ -> error "--batch is currently only supported in --json mode"
_ -> giveup "--batch is currently only supported in --json mode"
start :: POSIXTime -> MetaDataOptions -> FilePath -> Key -> CommandStart
start now o file k = startKeys now o k (mkActionItem afile)
@ -156,7 +156,7 @@ startBatch now (i, (MetaData m)) = case i of
mk <- lookupFile f
case mk of
Just k -> go k (mkActionItem (Just f))
Nothing -> error $ "not an annexed file: " ++ f
Nothing -> giveup $ "not an annexed file: " ++ f
Right k -> go k (mkActionItem k)
where
go k ai = do

View file

@ -197,4 +197,4 @@ fromPerform src move key afile = ifM (inAnnex key)
]
ok <- Remote.removeKey src key
next $ Command.Drop.cleanupRemote key src ok
faileddropremote = error "Unable to drop from remote."
faileddropremote = giveup "Unable to drop from remote."

View file

@ -23,15 +23,15 @@ seek = withWords start
start :: [String] -> CommandStart
start [] = startGet
start [s] = case readish s of
Nothing -> error $ "Bad number: " ++ s
Nothing -> giveup $ "Bad number: " ++ s
Just n
| n > 0 -> startSet n
| n == 0 -> ifM (Annex.getState Annex.force)
( startSet n
, error "Setting numcopies to 0 is very unsafe. You will lose data! If you really want to do that, specify --force."
, giveup "Setting numcopies to 0 is very unsafe. You will lose data! If you really want to do that, specify --force."
)
| otherwise -> error "Number cannot be negative!"
start _ = error "Specify a single number."
| otherwise -> giveup "Number cannot be negative!"
start _ = giveup "Specify a single number."
startGet :: CommandStart
startGet = next $ next $ do

View file

@ -46,7 +46,7 @@ seek ps = lockPreCommitHook $ ifM isDirect
( do
(fs, cleanup) <- inRepo $ Git.typeChangedStaged ps
whenM (anyM isOldUnlocked fs) $
error "Cannot make a partial commit with unlocked annexed files. You should `git annex add` the files you want to commit, and then run git commit."
giveup "Cannot make a partial commit with unlocked annexed files. You should `git annex add` the files you want to commit, and then run git commit."
void $ liftIO cleanup
, do
-- fix symlinks to files being committed

View file

@ -30,7 +30,7 @@ seek :: CmdParams -> CommandSeek
seek = withWords start
start :: [String] -> CommandStart
start [] = error "Did not specify command to run."
start [] = giveup "Did not specify command to run."
start (c:ps) = liftIO . exitWith =<< ifM isDirect
( do
tmp <- gitAnnexTmpMiscDir <$> gitRepo

View file

@ -33,7 +33,7 @@ seek = withPairs start
start :: (FilePath, String) -> CommandStart
start (file, keyname) = ifAnnexed file go stop
where
newkey = fromMaybe (error "bad key") $ file2key keyname
newkey = fromMaybe (giveup "bad key") $ file2key keyname
go oldkey
| oldkey == newkey = stop
| otherwise = do
@ -46,7 +46,7 @@ perform file oldkey newkey = do
( unlessM (linkKey file oldkey newkey) $
error "failed"
, unlessM (Annex.getState Annex.force) $
error $ file ++ " is not available (use --force to override)"
giveup $ file ++ " is not available (use --force to override)"
)
next $ cleanup file oldkey newkey

View file

@ -27,5 +27,5 @@ start (ks:us:[]) = do
then liftIO exitSuccess
else liftIO exitFailure
where
k = fromMaybe (error "bad key") (file2key ks)
start _ = error "Wrong number of parameters"
k = fromMaybe (giveup "bad key") (file2key ks)
start _ = giveup "Wrong number of parameters"

View file

@ -32,7 +32,7 @@ start (keyname:url:[]) = do
start [] = do
showStart "registerurl" "stdin"
next massAdd
start _ = error "specify a key and an url"
start _ = giveup "specify a key and an url"
massAdd :: CommandPerform
massAdd = go True =<< map (separate (== ' ')) . lines <$> liftIO getContents
@ -43,7 +43,7 @@ massAdd = go True =<< map (separate (== ' ')) . lines <$> liftIO getContents
ok <- perform' key u
let !status' = status && ok
go status' rest
go _ _ = error "Expected pairs of key and url on stdin, but got something else."
go _ _ = giveup "Expected pairs of key and url on stdin, but got something else."
perform :: Key -> URLString -> CommandPerform
perform key url = do

View file

@ -47,7 +47,7 @@ startSrcDest (src:dest:[])
next $ ifAnnexed dest
(\key -> perform src key (verifyKeyContent DefaultVerify UnVerified key src))
stop
startSrcDest _ = error "specify a src file and a dest file"
startSrcDest _ = giveup "specify a src file and a dest file"
startKnown :: FilePath -> CommandStart
startKnown src = notAnnexed src $ do
@ -63,7 +63,8 @@ startKnown src = notAnnexed src $ do
)
notAnnexed :: FilePath -> CommandStart -> CommandStart
notAnnexed src = ifAnnexed src (error $ "cannot used annexed file as src: " ++ src)
notAnnexed src = ifAnnexed src $
giveup $ "cannot used annexed file as src: " ++ src
perform :: FilePath -> Key -> Annex Bool -> CommandPerform
perform src key verify = ifM move

View file

@ -33,8 +33,8 @@ start = do
( do
void $ commitResolvedMerge Git.Branch.ManualCommit
next $ next $ return True
, error "Merge conflict could not be automatically resolved."
, giveup "Merge conflict could not be automatically resolved."
)
where
nobranch = error "No branch is currently checked out."
nomergehead = error "No SHA found in .git/merge_head"
nobranch = giveup "No branch is currently checked out."
nomergehead = giveup "No SHA found in .git/merge_head"

View file

@ -31,7 +31,7 @@ start = parse
parse (name:expr:[]) = go name $ \uuid -> do
showStart "schedile" name
performSet expr uuid
parse _ = error "Specify a repository."
parse _ = giveup "Specify a repository."
go name a = do
u <- Remote.nameToUUID name
@ -47,7 +47,7 @@ performGet uuid = do
performSet :: String -> UUID -> CommandPerform
performSet expr uuid = case parseScheduledActivities expr of
Left e -> error $ "Parse error: " ++ e
Left e -> giveup $ "Parse error: " ++ e
Right l -> do
scheduleSet uuid l
next $ return True

View file

@ -23,10 +23,10 @@ start :: [String] -> CommandStart
start (keyname:file:[]) = do
showStart "setkey" file
next $ perform file (mkKey keyname)
start _ = error "specify a key and a content file"
start _ = giveup "specify a key and a content file"
mkKey :: String -> Key
mkKey = fromMaybe (error "bad key") . file2key
mkKey = fromMaybe (giveup "bad key") . file2key
perform :: FilePath -> Key -> CommandPerform
perform file key = do

View file

@ -26,9 +26,9 @@ start (ks:us:vs:[]) = do
showStart' "setpresentkey" k (mkActionItem k)
next $ perform k (toUUID us) s
where
k = fromMaybe (error "bad key") (file2key ks)
s = fromMaybe (error "bad value") (parseStatus vs)
start _ = error "Wrong number of parameters"
k = fromMaybe (giveup "bad key") (file2key ks)
s = fromMaybe (giveup "bad value") (parseStatus vs)
start _ = giveup "Wrong number of parameters"
perform :: Key -> UUID -> LogStatus -> CommandPerform
perform k u s = next $ do

View file

@ -169,7 +169,15 @@ prepMerge :: Annex ()
prepMerge = Annex.changeDirectory =<< fromRepo Git.repoPath
mergeConfig :: [Git.Merge.MergeConfig]
mergeConfig = [Git.Merge.MergeNonInteractive]
mergeConfig =
[ Git.Merge.MergeNonInteractive
-- In several situations, unrelated histories should be merged
-- together. This includes pairing in the assistant, and merging
-- from a remote into a newly created direct mode repo.
-- (Once direct mode is removed, this could be changed, so only
-- the assistant uses it.)
, Git.Merge.MergeUnrelatedHistories
]
merge :: CurrBranch -> [Git.Merge.MergeConfig] -> Git.Branch.CommitMode -> Git.Branch -> Annex Bool
merge (Just b, Just adj) mergeconfig commitmode tomerge =
@ -287,7 +295,7 @@ updateSyncBranch (Just branch, madj) = do
updateBranch :: Git.Branch -> Git.Branch -> Git.Repo -> IO ()
updateBranch syncbranch updateto g =
unlessM go $ error $ "failed to update " ++ Git.fromRef syncbranch
unlessM go $ giveup $ "failed to update " ++ Git.fromRef syncbranch
where
go = Git.Command.runBool
[ Param "branch"

View file

@ -57,7 +57,7 @@ seek o = commandAction $ start (fromInteger $ sizeOption o) (testRemote o)
start :: Int -> RemoteName -> CommandStart
start basesz name = do
showStart "testremote" name
r <- either error id <$> Remote.byName' name
r <- either giveup id <$> Remote.byName' name
showAction "generating test keys"
fast <- Annex.getState Annex.fast
ks <- mapM randKey (keySizes basesz fast)

View file

@ -59,7 +59,7 @@ start (k:[]) = do
, exitSuccess
]
stop
start _ = error "wrong number of parameters"
start _ = giveup "wrong number of parameters"
readUpdate :: IO (Maybe Integer)
readUpdate = readish <$> getLine

View file

@ -45,7 +45,7 @@ wrapUnannex a = ifM (versionSupportsUnlockedPointers <||> isDirect)
-}
, ifM cleanindex
( lockPreCommitHook $ commit `after` a
, error "Cannot proceed with uncommitted changes staged in the index. Recommend you: git commit"
, giveup "Cannot proceed with uncommitted changes staged in the index. Recommend you: git commit"
)
)
where

View file

@ -32,7 +32,7 @@ seek ps = do
-- in the index.
(fs, cleanup) <- inRepo $ LsFiles.notInRepo False ps
unless (null fs) $
error $ "Cannot undo changes to files that are not checked into git: " ++ unwords fs
giveup $ "Cannot undo changes to files that are not checked into git: " ++ unwords fs
void $ liftIO $ cleanup
-- Committing staged changes before undo allows later

View file

@ -26,7 +26,7 @@ start (name:g:[]) = do
showStart "ungroup" name
u <- Remote.nameToUUID name
next $ perform u g
start _ = error "Specify a repository and a group."
start _ = giveup "Specify a repository and a group."
perform :: UUID -> Group -> CommandPerform
perform uuid g = do

View file

@ -30,12 +30,12 @@ cmd = addCheck check $
check :: Annex ()
check = do
b <- current_branch
when (b == Annex.Branch.name) $ error $
when (b == Annex.Branch.name) $ giveup $
"cannot uninit when the " ++ Git.fromRef b ++ " branch is checked out"
top <- fromRepo Git.repoPath
currdir <- liftIO getCurrentDirectory
whenM ((/=) <$> liftIO (absPath top) <*> liftIO (absPath currdir)) $
error "can only run uninit from the top of the git repository"
giveup "can only run uninit from the top of the git repository"
where
current_branch = Git.Ref . Prelude.head . lines <$> revhead
revhead = inRepo $ Git.Command.pipeReadStrict
@ -51,7 +51,7 @@ seek ps = do
{- git annex symlinks that are not checked into git could be left by an
- interrupted add. -}
startCheckIncomplete :: FilePath -> Key -> CommandStart
startCheckIncomplete file _ = error $ unlines
startCheckIncomplete file _ = giveup $ unlines
[ file ++ " points to annexed content, but is not checked into git."
, "Perhaps this was left behind by an interrupted git annex add?"
, "Not continuing with uninit; either delete or git annex add the file and retry."
@ -65,7 +65,7 @@ finish = do
prepareRemoveAnnexDir annexdir
if null leftovers
then liftIO $ removeDirectoryRecursive annexdir
else error $ unlines
else giveup $ unlines
[ "Not fully uninitialized"
, "Some annexed data is still left in " ++ annexobjectdir
, "This may include deleted files, or old versions of modified files."

View file

@ -320,7 +320,7 @@ unusedSpec m spec
range (a, b) = case (readish a, readish b) of
(Just x, Just y) -> [x..y]
_ -> badspec
badspec = error $ "Expected number or range, not \"" ++ spec ++ "\""
badspec = giveup $ "Expected number or range, not \"" ++ spec ++ "\""
{- Seek action for unused content. Finds the number in the maps, and
- calls one of 3 actions, depending on the type of unused file. -}
@ -335,7 +335,7 @@ startUnused message unused badunused tmpunused maps n = search
, (unusedTmpMap maps, tmpunused)
]
where
search [] = error $ show n ++ " not valid (run git annex unused for list)"
search [] = giveup $ show n ++ " not valid (run git annex unused for list)"
search ((m, a):rest) =
case M.lookup n m of
Nothing -> search rest

View file

@ -33,6 +33,6 @@ start params = do
next $ next $ return True
Narrowing -> next $ next $ do
if visibleViewSize view' == visibleViewSize view
then error "That would not add an additional level of directory structure to the view. To filter the view, use vfilter instead of vadd."
then giveup "That would not add an additional level of directory structure to the view. To filter the view, use vfilter instead of vadd."
else checkoutViewBranch view' narrowView
Widening -> error "Widening view to match more files is not currently supported."
Widening -> giveup "Widening view to match more files is not currently supported."

View file

@ -25,7 +25,7 @@ seek = withNothing start
start ::CommandStart
start = go =<< currentView
where
go Nothing = error "Not in a view."
go Nothing = giveup "Not in a view."
go (Just v) = do
showStart "vcycle" ""
let v' = v { viewComponents = vcycle [] (viewComponents v) }

View file

@ -26,5 +26,5 @@ start params = do
let view' = filterView view $
map parseViewParam $ reverse params
next $ next $ if visibleViewSize view' > visibleViewSize view
then error "That would add an additional level of directory structure to the view, rather than filtering it. If you want to do that, use vadd instead of vfilter."
then giveup "That would add an additional level of directory structure to the view, rather than filtering it. If you want to do that, use vadd instead of vfilter."
else checkoutViewBranch view' narrowView

View file

@ -26,7 +26,7 @@ seek = withWords start
start :: [String] -> CommandStart
start ps = go =<< currentView
where
go Nothing = error "Not in a view."
go Nothing = giveup "Not in a view."
go (Just v) = do
showStart "vpop" (show num)
removeView v

View file

@ -50,7 +50,7 @@ vicfg curcfg f = do
vi <- liftIO $ catchDefaultIO "vi" $ getEnv "EDITOR"
-- Allow EDITOR to be processed by the shell, so it can contain options.
unlessM (liftIO $ boolSystem "sh" [Param "-c", Param $ unwords [vi, shellEscape f]]) $
error $ vi ++ " exited nonzero; aborting"
giveup $ vi ++ " exited nonzero; aborting"
r <- parseCfg (defCfg curcfg) <$> liftIO (readFileStrictAnyEncoding f)
liftIO $ nukeFile f
case r of

View file

@ -25,7 +25,7 @@ seek :: CmdParams -> CommandSeek
seek = withWords start
start :: [String] -> CommandStart
start [] = error "Specify metadata to include in view"
start [] = giveup "Specify metadata to include in view"
start ps = do
showStart "view" ""
view <- mkView ps
@ -34,7 +34,7 @@ start ps = do
go view Nothing = next $ perform view
go view (Just v)
| v == view = stop
| otherwise = error "Already in a view. Use the vfilter and vadd commands to further refine this view."
| otherwise = giveup "Already in a view. Use the vfilter and vadd commands to further refine this view."
perform :: View -> CommandPerform
perform view = do
@ -47,7 +47,7 @@ paramView = paramRepeating "FIELD=VALUE"
mkView :: [String] -> Annex View
mkView ps = go =<< inRepo Git.Branch.current
where
go Nothing = error "not on any branch!"
go Nothing = giveup "not on any branch!"
go (Just b) = return $ fst $ refineView (View b []) $
map parseViewParam $ reverse ps

View file

@ -37,7 +37,7 @@ cmd' name desc getter setter = command name SectionSetup desc pdesc (withParams
start (rname:expr:[]) = go rname $ \uuid -> do
showStart name rname
performSet setter expr uuid
start _ = error "Specify a repository."
start _ = giveup "Specify a repository."
go rname a = do
u <- Remote.nameToUUID rname
@ -52,7 +52,7 @@ performGet getter a = do
performSet :: (a -> PreferredContentExpression -> Annex ()) -> String -> a -> CommandPerform
performSet setter expr a = case checkPreferredContentExpression expr of
Just e -> error $ "Parse error: " ++ e
Just e -> giveup $ "Parse error: " ++ e
Nothing -> do
setter a expr
next $ return True

View file

@ -77,7 +77,7 @@ start' allowauto o = do
else annexListen <$> Annex.getGitConfig
ifM (checkpid <&&> checkshim f)
( if isJust (listenAddress o)
then error "The assistant is already running, so --listen cannot be used."
then giveup "The assistant is already running, so --listen cannot be used."
else do
url <- liftIO . readFile
=<< fromRepo gitAnnexUrlFile
@ -125,7 +125,7 @@ startNoRepo o = go =<< liftIO (filterM doesDirectoryExist =<< readAutoStartFile)
go ds
Right state -> void $ Annex.eval state $ do
whenM (fromRepo Git.repoIsLocalBare) $
error $ d ++ " is a bare git repository, cannot run the webapp in it"
giveup $ d ++ " is a bare git repository, cannot run the webapp in it"
callCommandAction $
start' False o