Merge branch 'master' into tor
This commit is contained in:
Joey Hess
commit
95916b2ecf
149 changed files with 925 additions and 305 deletions
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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."
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
)
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)"
|
||||
|
|
|
|||
|
|
@ -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."
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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."
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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."
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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."
|
||||
|
|
|
|||
|
|
@ -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) }
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue