showStart variant for when there's no worktree file
Clean up some uses of showStart with "" for the file, or in some cases, a non-filename description string. That would generate bad json, although none of the commands doing that supported --json. Using "" for the file resulted in output like "foo rest"; now the extra space is eliminated. This commit was sponsored by Fernando Jimenez on Patreon.
This commit is contained in:
parent
d6d8f72957
commit
4781ca297b
46 changed files with 74 additions and 67 deletions
|
@ -38,5 +38,5 @@ seek = commandAction . start
|
||||||
start :: Adjustment -> CommandStart
|
start :: Adjustment -> CommandStart
|
||||||
start adj = do
|
start adj = do
|
||||||
checkVersionSupported
|
checkVersionSupported
|
||||||
showStart "adjust" ""
|
showStart' "adjust" Nothing
|
||||||
next $ next $ enterAdjustedBranch adj
|
next $ next $ enterAdjustedBranch adj
|
||||||
|
|
|
@ -50,14 +50,14 @@ optParser _ = setconfig <|> getconfig <|> unsetconfig
|
||||||
seek :: Action -> CommandSeek
|
seek :: Action -> CommandSeek
|
||||||
seek (SetConfig name val) = commandAction $ do
|
seek (SetConfig name val) = commandAction $ do
|
||||||
allowMessages
|
allowMessages
|
||||||
showStart name val
|
showStart' name (Just val)
|
||||||
next $ next $ do
|
next $ next $ do
|
||||||
setGlobalConfig name val
|
setGlobalConfig name val
|
||||||
setConfig (ConfigKey name) val
|
setConfig (ConfigKey name) val
|
||||||
return True
|
return True
|
||||||
seek (UnsetConfig name) = commandAction $ do
|
seek (UnsetConfig name) = commandAction $ do
|
||||||
allowMessages
|
allowMessages
|
||||||
showStart name "unset"
|
showStart' name (Just "unset")
|
||||||
next $ next $ do
|
next $ next $ do
|
||||||
unsetGlobalConfig name
|
unsetGlobalConfig name
|
||||||
unsetConfig (ConfigKey name)
|
unsetConfig (ConfigKey name)
|
||||||
|
|
|
@ -33,7 +33,7 @@ seek (DeadKeys ks) = seekActions $ pure $ map startKey ks
|
||||||
|
|
||||||
startKey :: Key -> CommandStart
|
startKey :: Key -> CommandStart
|
||||||
startKey key = do
|
startKey key = do
|
||||||
showStart "dead" (key2file key)
|
showStart' "dead" (Just $ key2file key)
|
||||||
ls <- keyLocations key
|
ls <- keyLocations key
|
||||||
case ls of
|
case ls of
|
||||||
[] -> next $ performKey key
|
[] -> next $ performKey key
|
||||||
|
|
|
@ -22,7 +22,7 @@ seek = withWords start
|
||||||
|
|
||||||
start :: [String] -> CommandStart
|
start :: [String] -> CommandStart
|
||||||
start (name:description) = do
|
start (name:description) = do
|
||||||
showStart "describe" name
|
showStart' "describe" (Just name)
|
||||||
u <- Remote.nameToUUID name
|
u <- Remote.nameToUUID name
|
||||||
next $ perform u $ unwords description
|
next $ perform u $ unwords description
|
||||||
start _ = giveup "Specify a repository and a description."
|
start _ = giveup "Specify a repository and a description."
|
||||||
|
|
|
@ -31,7 +31,7 @@ start = ifM versionSupportsDirectMode
|
||||||
|
|
||||||
perform :: CommandPerform
|
perform :: CommandPerform
|
||||||
perform = do
|
perform = do
|
||||||
showStart "commit" ""
|
showStart' "commit" Nothing
|
||||||
showOutput
|
showOutput
|
||||||
_ <- inRepo $ Git.Branch.commitCommand Git.Branch.ManualCommit
|
_ <- inRepo $ Git.Branch.commitCommand Git.Branch.ManualCommit
|
||||||
[ Param "-a"
|
[ Param "-a"
|
||||||
|
@ -65,6 +65,6 @@ perform = do
|
||||||
|
|
||||||
cleanup :: CommandCleanup
|
cleanup :: CommandCleanup
|
||||||
cleanup = do
|
cleanup = do
|
||||||
showStart "direct" ""
|
showStart' "direct" Nothing
|
||||||
setDirect True
|
setDirect True
|
||||||
return True
|
return True
|
||||||
|
|
|
@ -89,12 +89,12 @@ startKeys o key = start' o key (AssociatedFile Nothing)
|
||||||
|
|
||||||
startLocal :: AssociatedFile -> ActionItem -> NumCopies -> Key -> [VerifiedCopy] -> CommandStart
|
startLocal :: AssociatedFile -> ActionItem -> NumCopies -> Key -> [VerifiedCopy] -> CommandStart
|
||||||
startLocal afile ai numcopies key preverified = stopUnless (inAnnex key) $ do
|
startLocal afile ai numcopies key preverified = stopUnless (inAnnex key) $ do
|
||||||
showStart' "drop" key ai
|
showStartKey "drop" key ai
|
||||||
next $ performLocal key afile numcopies preverified
|
next $ performLocal key afile numcopies preverified
|
||||||
|
|
||||||
startRemote :: AssociatedFile -> ActionItem -> NumCopies -> Key -> Remote -> CommandStart
|
startRemote :: AssociatedFile -> ActionItem -> NumCopies -> Key -> Remote -> CommandStart
|
||||||
startRemote afile ai numcopies key remote = do
|
startRemote afile ai numcopies key remote = do
|
||||||
showStart' ("drop " ++ Remote.name remote) key ai
|
showStartKey ("drop " ++ Remote.name remote) key ai
|
||||||
next $ performRemote key afile numcopies remote
|
next $ performRemote key afile numcopies remote
|
||||||
|
|
||||||
performLocal :: Key -> AssociatedFile -> NumCopies -> [VerifiedCopy] -> CommandPerform
|
performLocal :: Key -> AssociatedFile -> NumCopies -> [VerifiedCopy] -> CommandPerform
|
||||||
|
|
|
@ -42,7 +42,7 @@ seek o = do
|
||||||
|
|
||||||
start :: Key -> CommandStart
|
start :: Key -> CommandStart
|
||||||
start key = do
|
start key = do
|
||||||
showStart' "dropkey" key (mkActionItem key)
|
showStartKey "dropkey" key (mkActionItem key)
|
||||||
next $ perform key
|
next $ perform key
|
||||||
|
|
||||||
perform :: Key -> CommandPerform
|
perform :: Key -> CommandPerform
|
||||||
|
|
|
@ -55,7 +55,7 @@ start (name:rest) = go =<< filter matchingname <$> Annex.fromRepo Git.remotes
|
||||||
startNormalRemote :: Git.RemoteName -> [String] -> Git.Repo -> CommandStart
|
startNormalRemote :: Git.RemoteName -> [String] -> Git.Repo -> CommandStart
|
||||||
startNormalRemote name restparams r
|
startNormalRemote name restparams r
|
||||||
| null restparams = do
|
| null restparams = do
|
||||||
showStart "enableremote" name
|
showStart' "enableremote" (Just name)
|
||||||
next $ next $ do
|
next $ next $ do
|
||||||
setRemoteIgnore r False
|
setRemoteIgnore r False
|
||||||
r' <- Remote.Git.configRead False r
|
r' <- Remote.Git.configRead False r
|
||||||
|
@ -77,7 +77,7 @@ startSpecialRemote name config Nothing = do
|
||||||
startSpecialRemote name config (Just (u, c)) = do
|
startSpecialRemote name config (Just (u, c)) = do
|
||||||
let fullconfig = config `M.union` c
|
let fullconfig = config `M.union` c
|
||||||
t <- either giveup return (Annex.SpecialRemote.findType fullconfig)
|
t <- either giveup return (Annex.SpecialRemote.findType fullconfig)
|
||||||
showStart "enableremote" name
|
showStart' "enableremote" (Just name)
|
||||||
gc <- maybe (liftIO dummyRemoteGitConfig)
|
gc <- maybe (liftIO dummyRemoteGitConfig)
|
||||||
(return . Remote.gitconfig)
|
(return . Remote.gitconfig)
|
||||||
=<< Remote.byUUID u
|
=<< Remote.byUUID u
|
||||||
|
|
|
@ -51,7 +51,7 @@ start os = do
|
||||||
Nothing -> giveup "Need user-id parameter."
|
Nothing -> giveup "Need user-id parameter."
|
||||||
Just userid -> go uuid userid
|
Just userid -> go uuid userid
|
||||||
else do
|
else do
|
||||||
showStart "enable-tor" ""
|
showStart' "enable-tor" Nothing
|
||||||
gitannex <- liftIO readProgramFile
|
gitannex <- liftIO readProgramFile
|
||||||
let ps = [Param (cmdname cmd), Param (show curruserid)]
|
let ps = [Param (cmdname cmd), Param (show curruserid)]
|
||||||
sucommand <- liftIO $ mkSuCommand gitannex ps
|
sucommand <- liftIO $ mkSuCommand gitannex ps
|
||||||
|
|
|
@ -59,12 +59,12 @@ start :: Expire -> Bool -> Log Activity -> M.Map UUID String -> UUID -> CommandS
|
||||||
start (Expire expire) noact actlog descs u =
|
start (Expire expire) noact actlog descs u =
|
||||||
case lastact of
|
case lastact of
|
||||||
Just ent | notexpired ent -> checktrust (== DeadTrusted) $ do
|
Just ent | notexpired ent -> checktrust (== DeadTrusted) $ do
|
||||||
showStart "unexpire" desc
|
showStart' "unexpire" (Just desc)
|
||||||
showNote =<< whenactive
|
showNote =<< whenactive
|
||||||
unless noact $
|
unless noact $
|
||||||
trustSet u SemiTrusted
|
trustSet u SemiTrusted
|
||||||
_ -> checktrust (/= DeadTrusted) $ do
|
_ -> checktrust (/= DeadTrusted) $ do
|
||||||
showStart "expire" desc
|
showStart' "expire" (Just desc)
|
||||||
showNote =<< whenactive
|
showNote =<< whenactive
|
||||||
unless noact $
|
unless noact $
|
||||||
trustSet u DeadTrusted
|
trustSet u DeadTrusted
|
||||||
|
|
|
@ -34,7 +34,7 @@ seek = commandAction . start
|
||||||
|
|
||||||
start :: ForgetOptions -> CommandStart
|
start :: ForgetOptions -> CommandStart
|
||||||
start o = do
|
start o = do
|
||||||
showStart "forget" "git-annex"
|
showStart' "forget" (Just "git-annex")
|
||||||
c <- liftIO currentVectorClock
|
c <- liftIO currentVectorClock
|
||||||
let basets = addTransition c ForgetGitHistory noTransitions
|
let basets = addTransition c ForgetGitHistory noTransitions
|
||||||
let ts = if dropDead o
|
let ts = if dropDead o
|
||||||
|
|
|
@ -41,7 +41,7 @@ start force (keyname, file) = do
|
||||||
|
|
||||||
startMass :: CommandStart
|
startMass :: CommandStart
|
||||||
startMass = do
|
startMass = do
|
||||||
showStart "fromkey" "stdin"
|
showStart' "fromkey" (Just "stdin")
|
||||||
next massAdd
|
next massAdd
|
||||||
|
|
||||||
massAdd :: CommandPerform
|
massAdd :: CommandPerform
|
||||||
|
|
|
@ -536,7 +536,7 @@ badContentRemote remote localcopy key = do
|
||||||
runFsck :: Incremental -> ActionItem -> Key -> Annex Bool -> CommandStart
|
runFsck :: Incremental -> ActionItem -> Key -> Annex Bool -> CommandStart
|
||||||
runFsck inc ai key a = ifM (needFsck inc key)
|
runFsck inc ai key a = ifM (needFsck inc key)
|
||||||
( do
|
( do
|
||||||
showStart' "fsck" key ai
|
showStartKey "fsck" key ai
|
||||||
next $ do
|
next $ do
|
||||||
ok <- a
|
ok <- a
|
||||||
when ok $
|
when ok $
|
||||||
|
|
|
@ -71,7 +71,7 @@ start' expensivecheck from key afile ai = onlyActionOn key $
|
||||||
go $ Command.Move.fromPerform src False key afile
|
go $ Command.Move.fromPerform src False key afile
|
||||||
where
|
where
|
||||||
go a = do
|
go a = do
|
||||||
showStart' "get" key ai
|
showStartKey "get" key ai
|
||||||
next a
|
next a
|
||||||
|
|
||||||
perform :: Key -> AssociatedFile -> CommandPerform
|
perform :: Key -> AssociatedFile -> CommandPerform
|
||||||
|
|
|
@ -24,7 +24,7 @@ seek = withWords start
|
||||||
start :: [String] -> CommandStart
|
start :: [String] -> CommandStart
|
||||||
start (name:g:[]) = do
|
start (name:g:[]) = do
|
||||||
allowMessages
|
allowMessages
|
||||||
showStart "group" name
|
showStart' "group" (Just name)
|
||||||
u <- Remote.nameToUUID name
|
u <- Remote.nameToUUID name
|
||||||
next $ setGroup u g
|
next $ setGroup u g
|
||||||
start (name:[]) = do
|
start (name:[]) = do
|
||||||
|
|
|
@ -24,6 +24,6 @@ start :: [String] -> CommandStart
|
||||||
start (g:[]) = next $ performGet groupPreferredContentMapRaw g
|
start (g:[]) = next $ performGet groupPreferredContentMapRaw g
|
||||||
start (g:expr:[]) = do
|
start (g:expr:[]) = do
|
||||||
allowMessages
|
allowMessages
|
||||||
showStart "groupwanted" g
|
showStart' "groupwanted" (Just g)
|
||||||
next $ performSet groupPreferredContentSet expr g
|
next $ performSet groupPreferredContentSet expr g
|
||||||
start _ = giveup "Specify a group."
|
start _ = giveup "Specify a group."
|
||||||
|
|
|
@ -72,7 +72,7 @@ seek o = do
|
||||||
|
|
||||||
start :: ImportFeedOptions -> Cache -> URLString -> CommandStart
|
start :: ImportFeedOptions -> Cache -> URLString -> CommandStart
|
||||||
start opts cache url = do
|
start opts cache url = do
|
||||||
showStart "importfeed" url
|
showStart' "importfeed" (Just url)
|
||||||
next $ perform opts cache url
|
next $ perform opts cache url
|
||||||
|
|
||||||
perform :: ImportFeedOptions -> Cache -> URLString -> CommandPerform
|
perform :: ImportFeedOptions -> Cache -> URLString -> CommandPerform
|
||||||
|
|
|
@ -42,7 +42,7 @@ start = ifM isDirect
|
||||||
|
|
||||||
perform :: CommandPerform
|
perform :: CommandPerform
|
||||||
perform = do
|
perform = do
|
||||||
showStart "commit" ""
|
showStart' "commit" Nothing
|
||||||
whenM stageDirect $ do
|
whenM stageDirect $ do
|
||||||
showOutput
|
showOutput
|
||||||
void $ inRepo $ Git.Branch.commitCommand Git.Branch.ManualCommit
|
void $ inRepo $ Git.Branch.commitCommand Git.Branch.ManualCommit
|
||||||
|
@ -100,6 +100,6 @@ perform = do
|
||||||
|
|
||||||
cleanup :: CommandCleanup
|
cleanup :: CommandCleanup
|
||||||
cleanup = do
|
cleanup = do
|
||||||
showStart "indirect" ""
|
showStart' "indirect" Nothing
|
||||||
showEndOk
|
showEndOk
|
||||||
return True
|
return True
|
||||||
|
|
|
@ -40,7 +40,7 @@ seek = commandAction . start
|
||||||
|
|
||||||
start :: InitOptions -> CommandStart
|
start :: InitOptions -> CommandStart
|
||||||
start os = do
|
start os = do
|
||||||
showStart "init" (initDesc os)
|
showStart' "init" (Just $ initDesc os)
|
||||||
next $ perform os
|
next $ perform os
|
||||||
|
|
||||||
perform :: InitOptions -> CommandPerform
|
perform :: InitOptions -> CommandPerform
|
||||||
|
|
|
@ -38,7 +38,7 @@ start (name:ws) = ifM (isJust <$> findExisting name)
|
||||||
let c = newConfig name
|
let c = newConfig name
|
||||||
t <- either giveup return (findType config)
|
t <- either giveup return (findType config)
|
||||||
|
|
||||||
showStart "initremote" name
|
showStart' "initremote" (Just name)
|
||||||
next $ perform t name $ M.union config c
|
next $ perform t name $ M.union config c
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
|
@ -189,7 +189,7 @@ same a b
|
||||||
{- reads the config of a remote, with progress display -}
|
{- reads the config of a remote, with progress display -}
|
||||||
scan :: Git.Repo -> Annex Git.Repo
|
scan :: Git.Repo -> Annex Git.Repo
|
||||||
scan r = do
|
scan r = do
|
||||||
showStart "map" $ Git.repoDescribe r
|
showStart' "map" (Just $ Git.repoDescribe r)
|
||||||
v <- tryScan r
|
v <- tryScan r
|
||||||
case v of
|
case v of
|
||||||
Just r' -> do
|
Just r' -> do
|
||||||
|
|
|
@ -23,7 +23,7 @@ seek _ = do
|
||||||
|
|
||||||
mergeBranch :: CommandStart
|
mergeBranch :: CommandStart
|
||||||
mergeBranch = do
|
mergeBranch = do
|
||||||
showStart "merge" "git-annex"
|
showStart' "merge" (Just "git-annex")
|
||||||
next $ do
|
next $ do
|
||||||
Annex.Branch.update
|
Annex.Branch.update
|
||||||
-- commit explicitly, in case no remote branches were merged
|
-- commit explicitly, in case no remote branches were merged
|
||||||
|
|
|
@ -100,7 +100,7 @@ startKeys c o k ai = case getSet o of
|
||||||
putStrLn . fromMetaValue
|
putStrLn . fromMetaValue
|
||||||
stop
|
stop
|
||||||
_ -> do
|
_ -> do
|
||||||
showStart' "metadata" k ai
|
showStartKey "metadata" k ai
|
||||||
next $ perform c o k
|
next $ perform c o k
|
||||||
|
|
||||||
perform :: VectorClock -> MetaDataOptions -> Key -> CommandPerform
|
perform :: VectorClock -> MetaDataOptions -> Key -> CommandPerform
|
||||||
|
@ -164,7 +164,7 @@ startBatch (i, (MetaData m)) = case i of
|
||||||
Right k -> go k (mkActionItem k)
|
Right k -> go k (mkActionItem k)
|
||||||
where
|
where
|
||||||
go k ai = do
|
go k ai = do
|
||||||
showStart' "metadata" k ai
|
showStartKey "metadata" k ai
|
||||||
let o = MetaDataOptions
|
let o = MetaDataOptions
|
||||||
{ forFiles = []
|
{ forFiles = []
|
||||||
, getSet = if MetaData m == emptyMetaData
|
, getSet = if MetaData m == emptyMetaData
|
||||||
|
|
|
@ -87,7 +87,7 @@ start' o move afile key ai = onlyActionOn key $
|
||||||
toHereStart move afile key ai
|
toHereStart move afile key ai
|
||||||
|
|
||||||
showMoveAction :: Bool -> Key -> ActionItem -> Annex ()
|
showMoveAction :: Bool -> Key -> ActionItem -> Annex ()
|
||||||
showMoveAction move = showStart' (if move then "move" else "copy")
|
showMoveAction move = showStartKey (if move then "move" else "copy")
|
||||||
|
|
||||||
{- Moves (or copies) the content of an annexed file to a remote.
|
{- Moves (or copies) the content of an annexed file to a remote.
|
||||||
-
|
-
|
||||||
|
|
|
@ -78,7 +78,7 @@ seek (MultiCastOptions Receive _ _) = giveup "Cannot specify list of files with
|
||||||
|
|
||||||
genAddress :: CommandStart
|
genAddress :: CommandStart
|
||||||
genAddress = do
|
genAddress = do
|
||||||
showStart "gen-address" ""
|
showStart' "gen-address" Nothing
|
||||||
k <- uftpKey
|
k <- uftpKey
|
||||||
(s, ok) <- case k of
|
(s, ok) <- case k of
|
||||||
KeyContainer s -> liftIO $ genkey (Param s)
|
KeyContainer s -> liftIO $ genkey (Param s)
|
||||||
|
@ -130,7 +130,7 @@ send ups fs = withTmpFile "send" $ \t h -> do
|
||||||
whenM isDirect $
|
whenM isDirect $
|
||||||
giveup "Sorry, multicast send cannot be done from a direct mode repository."
|
giveup "Sorry, multicast send cannot be done from a direct mode repository."
|
||||||
|
|
||||||
showStart "generating file list" ""
|
showStart' "generating file list" Nothing
|
||||||
fs' <- seekHelper LsFiles.inRepo =<< workTreeItems fs
|
fs' <- seekHelper LsFiles.inRepo =<< workTreeItems fs
|
||||||
matcher <- Limit.getMatcher
|
matcher <- Limit.getMatcher
|
||||||
let addlist f o = whenM (matcher $ MatchingFile $ FileInfo f f) $
|
let addlist f o = whenM (matcher $ MatchingFile $ FileInfo f f) $
|
||||||
|
@ -143,7 +143,7 @@ send ups fs = withTmpFile "send" $ \t h -> do
|
||||||
liftIO $ hClose h
|
liftIO $ hClose h
|
||||||
showEndOk
|
showEndOk
|
||||||
|
|
||||||
showStart "sending files" ""
|
showStart' "sending files" Nothing
|
||||||
showOutput
|
showOutput
|
||||||
serverkey <- uftpKey
|
serverkey <- uftpKey
|
||||||
u <- getUUID
|
u <- getUUID
|
||||||
|
@ -169,7 +169,7 @@ send ups fs = withTmpFile "send" $ \t h -> do
|
||||||
|
|
||||||
receive :: [CommandParam] -> CommandStart
|
receive :: [CommandParam] -> CommandStart
|
||||||
receive ups = do
|
receive ups = do
|
||||||
showStart "receiving multicast files" ""
|
showStart' "receiving multicast files" Nothing
|
||||||
showNote "Will continue to run until stopped by ctrl-c"
|
showNote "Will continue to run until stopped by ctrl-c"
|
||||||
|
|
||||||
showOutput
|
showOutput
|
||||||
|
|
|
@ -48,7 +48,7 @@ startGet = next $ next $ do
|
||||||
startSet :: Int -> CommandStart
|
startSet :: Int -> CommandStart
|
||||||
startSet n = do
|
startSet n = do
|
||||||
allowMessages
|
allowMessages
|
||||||
showStart "numcopies" (show n)
|
showStart' "numcopies" (Just $ show n)
|
||||||
next $ next $ do
|
next $ next $ do
|
||||||
setGlobalNumCopies $ NumCopies n
|
setGlobalNumCopies $ NumCopies n
|
||||||
return True
|
return True
|
||||||
|
|
|
@ -97,7 +97,7 @@ genAddresses addrs = do
|
||||||
-- Address is read from stdin, to avoid leaking it in shell history.
|
-- Address is read from stdin, to avoid leaking it in shell history.
|
||||||
linkRemote :: RemoteName -> CommandStart
|
linkRemote :: RemoteName -> CommandStart
|
||||||
linkRemote remotename = do
|
linkRemote remotename = do
|
||||||
showStart "p2p link" remotename
|
showStart' "p2p link" (Just remotename)
|
||||||
next $ next promptaddr
|
next $ next promptaddr
|
||||||
where
|
where
|
||||||
promptaddr = do
|
promptaddr = do
|
||||||
|
@ -123,7 +123,7 @@ linkRemote remotename = do
|
||||||
startPairing :: RemoteName -> [P2PAddress] -> CommandStart
|
startPairing :: RemoteName -> [P2PAddress] -> CommandStart
|
||||||
startPairing _ [] = giveup "No P2P networks are currrently available."
|
startPairing _ [] = giveup "No P2P networks are currrently available."
|
||||||
startPairing remotename addrs = do
|
startPairing remotename addrs = do
|
||||||
showStart "p2p pair" remotename
|
showStart' "p2p pair" (Just remotename)
|
||||||
ifM (liftIO Wormhole.isInstalled)
|
ifM (liftIO Wormhole.isInstalled)
|
||||||
( next $ performPairing remotename addrs
|
( next $ performPairing remotename addrs
|
||||||
, giveup "Magic Wormhole is not installed, and is needed for pairing. Install it from your distribution or from https://github.com/warner/magic-wormhole/"
|
, giveup "Magic Wormhole is not installed, and is needed for pairing. Install it from your distribution or from https://github.com/warner/magic-wormhole/"
|
||||||
|
|
|
@ -27,10 +27,10 @@ seek = withWords start
|
||||||
start :: [String] -> CommandStart
|
start :: [String] -> CommandStart
|
||||||
start (keyname:url:[]) = do
|
start (keyname:url:[]) = do
|
||||||
let key = mkKey keyname
|
let key = mkKey keyname
|
||||||
showStart "registerurl" url
|
showStart' "registerurl" (Just url)
|
||||||
next $ perform key url
|
next $ perform key url
|
||||||
start [] = do
|
start [] = do
|
||||||
showStart "registerurl" "stdin"
|
showStart' "registerurl" (Just "stdin")
|
||||||
next massAdd
|
next massAdd
|
||||||
start _ = giveup "specify a key and an url"
|
start _ = giveup "specify a key and an url"
|
||||||
|
|
||||||
|
|
|
@ -25,7 +25,7 @@ seek = withWords start
|
||||||
|
|
||||||
start :: [String] -> CommandStart
|
start :: [String] -> CommandStart
|
||||||
start ws = do
|
start ws = do
|
||||||
showStart "reinit" s
|
showStart' "reinit" (Just s)
|
||||||
next $ perform s
|
next $ perform s
|
||||||
where
|
where
|
||||||
s = unwords ws
|
s = unwords ws
|
||||||
|
|
|
@ -23,7 +23,7 @@ seek = withNothing start
|
||||||
|
|
||||||
start :: CommandStart
|
start :: CommandStart
|
||||||
start = do
|
start = do
|
||||||
showStart "resolvemerge" ""
|
showStart' "resolvemerge" Nothing
|
||||||
us <- fromMaybe nobranch <$> inRepo Git.Branch.current
|
us <- fromMaybe nobranch <$> inRepo Git.Branch.current
|
||||||
d <- fromRepo Git.localGitDir
|
d <- fromRepo Git.localGitDir
|
||||||
let merge_head = d </> "MERGE_HEAD"
|
let merge_head = d </> "MERGE_HEAD"
|
||||||
|
|
|
@ -28,7 +28,7 @@ start = parse
|
||||||
parse (name:[]) = go name performGet
|
parse (name:[]) = go name performGet
|
||||||
parse (name:expr:[]) = go name $ \uuid -> do
|
parse (name:expr:[]) = go name $ \uuid -> do
|
||||||
allowMessages
|
allowMessages
|
||||||
showStart "schedule" name
|
showStart' "schedule" (Just name)
|
||||||
performSet expr uuid
|
performSet expr uuid
|
||||||
parse _ = giveup "Specify a repository."
|
parse _ = giveup "Specify a repository."
|
||||||
|
|
||||||
|
|
|
@ -23,7 +23,7 @@ seek = withWords start
|
||||||
|
|
||||||
start :: [String] -> CommandStart
|
start :: [String] -> CommandStart
|
||||||
start (ks:us:vs:[]) = do
|
start (ks:us:vs:[]) = do
|
||||||
showStart' "setpresentkey" k (mkActionItem k)
|
showStartKey "setpresentkey" k (mkActionItem k)
|
||||||
next $ perform k (toUUID us) s
|
next $ perform k (toUUID us) s
|
||||||
where
|
where
|
||||||
k = fromMaybe (giveup "bad key") (file2key ks)
|
k = fromMaybe (giveup "bad key") (file2key ks)
|
||||||
|
|
|
@ -299,7 +299,7 @@ syncRemotes' ps available =
|
||||||
commit :: SyncOptions -> CommandStart
|
commit :: SyncOptions -> CommandStart
|
||||||
commit o = stopUnless shouldcommit $ next $ next $ do
|
commit o = stopUnless shouldcommit $ next $ next $ do
|
||||||
commitmessage <- maybe commitMsg return (messageOption o)
|
commitmessage <- maybe commitMsg return (messageOption o)
|
||||||
showStart "commit" ""
|
showStart' "commit" Nothing
|
||||||
Annex.Branch.commit "update"
|
Annex.Branch.commit "update"
|
||||||
ifM isDirect
|
ifM isDirect
|
||||||
( do
|
( do
|
||||||
|
@ -342,7 +342,7 @@ mergeLocal mergeconfig resolvemergeoverride currbranch@(Just _, _) =
|
||||||
where
|
where
|
||||||
go Nothing = stop
|
go Nothing = stop
|
||||||
go (Just syncbranch) = do
|
go (Just syncbranch) = do
|
||||||
showStart "merge" $ Git.Ref.describe syncbranch
|
showStart' "merge" (Just $ Git.Ref.describe syncbranch)
|
||||||
next $ next $ merge currbranch mergeconfig resolvemergeoverride Git.Branch.ManualCommit syncbranch
|
next $ next $ merge currbranch mergeconfig resolvemergeoverride Git.Branch.ManualCommit syncbranch
|
||||||
mergeLocal _ _ (Nothing, madj) = do
|
mergeLocal _ _ (Nothing, madj) = do
|
||||||
b <- inRepo Git.Branch.currentUnsafe
|
b <- inRepo Git.Branch.currentUnsafe
|
||||||
|
@ -401,7 +401,7 @@ updateBranch syncbranch updateto g =
|
||||||
|
|
||||||
pullRemote :: SyncOptions -> [Git.Merge.MergeConfig] -> Remote -> CurrBranch -> CommandStart
|
pullRemote :: SyncOptions -> [Git.Merge.MergeConfig] -> Remote -> CurrBranch -> CommandStart
|
||||||
pullRemote o mergeconfig remote branch = stopUnless (pure $ pullOption o && wantpull) $ do
|
pullRemote o mergeconfig remote branch = stopUnless (pure $ pullOption o && wantpull) $ do
|
||||||
showStart "pull" (Remote.name remote)
|
showStart' "pull" (Just (Remote.name remote))
|
||||||
next $ do
|
next $ do
|
||||||
showOutput
|
showOutput
|
||||||
stopUnless fetch $
|
stopUnless fetch $
|
||||||
|
@ -438,7 +438,7 @@ mergeRemote remote currbranch mergeconfig resolvemergeoverride = ifM isBareRepo
|
||||||
pushRemote :: SyncOptions -> Remote -> CurrBranch -> CommandStart
|
pushRemote :: SyncOptions -> Remote -> CurrBranch -> CommandStart
|
||||||
pushRemote _o _remote (Nothing, _) = stop
|
pushRemote _o _remote (Nothing, _) = stop
|
||||||
pushRemote o remote (Just branch, _) = stopUnless (pure (pushOption o) <&&> needpush) $ do
|
pushRemote o remote (Just branch, _) = stopUnless (pure (pushOption o) <&&> needpush) $ do
|
||||||
showStart "push" (Remote.name remote)
|
showStart' "push" (Just (Remote.name remote))
|
||||||
next $ next $ do
|
next $ next $ do
|
||||||
showOutput
|
showOutput
|
||||||
ok <- inRepoWithSshOptionsTo (Remote.repo remote) gc $
|
ok <- inRepoWithSshOptionsTo (Remote.repo remote) gc $
|
||||||
|
@ -651,7 +651,7 @@ syncFile ebloom rs af k = onlyActionOn' k $ do
|
||||||
, return []
|
, return []
|
||||||
)
|
)
|
||||||
get have = includeCommandAction $ do
|
get have = includeCommandAction $ do
|
||||||
showStart' "get" k (mkActionItem af)
|
showStartKey "get" k (mkActionItem af)
|
||||||
next $ next $ getKey' k af have
|
next $ next $ getKey' k af have
|
||||||
|
|
||||||
wantput r
|
wantput r
|
||||||
|
@ -703,7 +703,7 @@ seekExportContent rs = or <$> forM rs go
|
||||||
cleanupLocal :: CurrBranch -> CommandStart
|
cleanupLocal :: CurrBranch -> CommandStart
|
||||||
cleanupLocal (Nothing, _) = stop
|
cleanupLocal (Nothing, _) = stop
|
||||||
cleanupLocal (Just currb, _) = do
|
cleanupLocal (Just currb, _) = do
|
||||||
showStart "cleanup" "local"
|
showStart' "cleanup" (Just "local")
|
||||||
next $ next $ do
|
next $ next $ do
|
||||||
delbranch $ syncBranch currb
|
delbranch $ syncBranch currb
|
||||||
delbranch $ syncBranch $ Git.Ref.base $ Annex.Branch.name
|
delbranch $ syncBranch $ Git.Ref.base $ Annex.Branch.name
|
||||||
|
@ -717,7 +717,7 @@ cleanupLocal (Just currb, _) = do
|
||||||
cleanupRemote :: Remote -> CurrBranch -> CommandStart
|
cleanupRemote :: Remote -> CurrBranch -> CommandStart
|
||||||
cleanupRemote _ (Nothing, _) = stop
|
cleanupRemote _ (Nothing, _) = stop
|
||||||
cleanupRemote remote (Just b, _) = do
|
cleanupRemote remote (Just b, _) = do
|
||||||
showStart "cleanup" (Remote.name remote)
|
showStart' "cleanup" (Just (Remote.name remote))
|
||||||
next $ next $
|
next $ next $
|
||||||
inRepo $ Git.Command.runBool
|
inRepo $ Git.Command.runBool
|
||||||
[ Param "push"
|
[ Param "push"
|
||||||
|
|
|
@ -58,7 +58,7 @@ seek o = commandAction $ start (fromInteger $ sizeOption o) (testRemote o)
|
||||||
|
|
||||||
start :: Int -> RemoteName -> CommandStart
|
start :: Int -> RemoteName -> CommandStart
|
||||||
start basesz name = do
|
start basesz name = do
|
||||||
showStart "testremote" name
|
showStart' "testremote" (Just name)
|
||||||
fast <- Annex.getState Annex.fast
|
fast <- Annex.getState Annex.fast
|
||||||
r <- either giveup disableExportTree =<< Remote.byName' name
|
r <- either giveup disableExportTree =<< Remote.byName' name
|
||||||
rs <- catMaybes <$> mapM (adjustChunkSize r) (chunkSizes basesz fast)
|
rs <- catMaybes <$> mapM (adjustChunkSize r) (chunkSizes basesz fast)
|
||||||
|
|
|
@ -27,7 +27,7 @@ trustCommand c level = withWords start
|
||||||
where
|
where
|
||||||
start ws = do
|
start ws = do
|
||||||
let name = unwords ws
|
let name = unwords ws
|
||||||
showStart c name
|
showStart' c (Just name)
|
||||||
u <- Remote.nameToUUID name
|
u <- Remote.nameToUUID name
|
||||||
next $ perform u
|
next $ perform u
|
||||||
perform uuid = do
|
perform uuid = do
|
||||||
|
|
|
@ -23,7 +23,7 @@ seek = withWords start
|
||||||
|
|
||||||
start :: [String] -> CommandStart
|
start :: [String] -> CommandStart
|
||||||
start (name:g:[]) = do
|
start (name:g:[]) = do
|
||||||
showStart "ungroup" name
|
showStart' "ungroup" (Just name)
|
||||||
u <- Remote.nameToUUID name
|
u <- Remote.nameToUUID name
|
||||||
next $ perform u g
|
next $ perform u g
|
||||||
start _ = giveup "Specify a repository and a group."
|
start _ = giveup "Specify a repository and a group."
|
||||||
|
|
|
@ -70,7 +70,7 @@ start o = do
|
||||||
Just "." -> (".", checkUnused refspec)
|
Just "." -> (".", checkUnused refspec)
|
||||||
Just "here" -> (".", checkUnused refspec)
|
Just "here" -> (".", checkUnused refspec)
|
||||||
Just n -> (n, checkRemoteUnused n refspec)
|
Just n -> (n, checkRemoteUnused n refspec)
|
||||||
showStart "unused" name
|
showStart' "unused" (Just name)
|
||||||
next perform
|
next perform
|
||||||
|
|
||||||
checkUnused :: RefSpec -> CommandPerform
|
checkUnused :: RefSpec -> CommandPerform
|
||||||
|
@ -338,5 +338,5 @@ startUnused message unused badunused tmpunused maps n = search
|
||||||
case M.lookup n m of
|
case M.lookup n m of
|
||||||
Nothing -> search rest
|
Nothing -> search rest
|
||||||
Just key -> do
|
Just key -> do
|
||||||
showStart message (show n)
|
showStart' message (Just $ show n)
|
||||||
next $ a key
|
next $ a key
|
||||||
|
|
|
@ -23,7 +23,7 @@ seek = withNothing start
|
||||||
|
|
||||||
start :: CommandStart
|
start :: CommandStart
|
||||||
start = do
|
start = do
|
||||||
showStart "upgrade" "."
|
showStart' "upgrade" Nothing
|
||||||
whenM (isNothing <$> getVersion) $ do
|
whenM (isNothing <$> getVersion) $ do
|
||||||
initialize Nothing Nothing
|
initialize Nothing Nothing
|
||||||
r <- upgrade False latestVersion
|
r <- upgrade False latestVersion
|
||||||
|
|
|
@ -23,7 +23,7 @@ seek = withWords start
|
||||||
|
|
||||||
start :: [String] -> CommandStart
|
start :: [String] -> CommandStart
|
||||||
start params = do
|
start params = do
|
||||||
showStart "vadd" ""
|
showStart' "vadd" Nothing
|
||||||
withCurrentView $ \view -> do
|
withCurrentView $ \view -> do
|
||||||
let (view', change) = refineView view $
|
let (view', change) = refineView view $
|
||||||
map parseViewParam $ reverse params
|
map parseViewParam $ reverse params
|
||||||
|
|
|
@ -27,7 +27,7 @@ start = go =<< currentView
|
||||||
where
|
where
|
||||||
go Nothing = giveup "Not in a view."
|
go Nothing = giveup "Not in a view."
|
||||||
go (Just v) = do
|
go (Just v) = do
|
||||||
showStart "vcycle" ""
|
showStart' "vcycle" Nothing
|
||||||
let v' = v { viewComponents = vcycle [] (viewComponents v) }
|
let v' = v { viewComponents = vcycle [] (viewComponents v) }
|
||||||
if v == v'
|
if v == v'
|
||||||
then do
|
then do
|
||||||
|
|
|
@ -21,7 +21,7 @@ seek = withWords start
|
||||||
|
|
||||||
start :: [String] -> CommandStart
|
start :: [String] -> CommandStart
|
||||||
start params = do
|
start params = do
|
||||||
showStart "vfilter" ""
|
showStart' "vfilter" Nothing
|
||||||
withCurrentView $ \view -> do
|
withCurrentView $ \view -> do
|
||||||
let view' = filterView view $
|
let view' = filterView view $
|
||||||
map parseViewParam $ reverse params
|
map parseViewParam $ reverse params
|
||||||
|
|
|
@ -28,7 +28,7 @@ start ps = go =<< currentView
|
||||||
where
|
where
|
||||||
go Nothing = giveup "Not in a view."
|
go Nothing = giveup "Not in a view."
|
||||||
go (Just v) = do
|
go (Just v) = do
|
||||||
showStart "vpop" (show num)
|
showStart' "vpop" (Just $ show num)
|
||||||
removeView v
|
removeView v
|
||||||
(oldvs, vs) <- splitAt (num - 1) . filter (sameparentbranch v)
|
(oldvs, vs) <- splitAt (num - 1) . filter (sameparentbranch v)
|
||||||
<$> recentViews
|
<$> recentViews
|
||||||
|
|
|
@ -27,7 +27,7 @@ seek = withWords start
|
||||||
start :: [String] -> CommandStart
|
start :: [String] -> CommandStart
|
||||||
start [] = giveup "Specify metadata to include in view"
|
start [] = giveup "Specify metadata to include in view"
|
||||||
start ps = do
|
start ps = do
|
||||||
showStart "view" ""
|
showStart' "view" Nothing
|
||||||
view <- mkView ps
|
view <- mkView ps
|
||||||
go view =<< currentView
|
go view =<< currentView
|
||||||
where
|
where
|
||||||
|
|
|
@ -35,7 +35,7 @@ cmd' name desc getter setter = noMessages $
|
||||||
start (rname:[]) = go rname (performGet getter)
|
start (rname:[]) = go rname (performGet getter)
|
||||||
start (rname:expr:[]) = go rname $ \uuid -> do
|
start (rname:expr:[]) = go rname $ \uuid -> do
|
||||||
allowMessages
|
allowMessages
|
||||||
showStart name rname
|
showStart' name (Just rname)
|
||||||
performSet setter expr uuid
|
performSet setter expr uuid
|
||||||
start _ = giveup "Specify a repository."
|
start _ = giveup "Specify a repository."
|
||||||
|
|
||||||
|
|
|
@ -53,7 +53,7 @@ start remotemap file key = startKeys remotemap key (mkActionItem afile)
|
||||||
|
|
||||||
startKeys :: M.Map UUID Remote -> Key -> ActionItem -> CommandStart
|
startKeys :: M.Map UUID Remote -> Key -> ActionItem -> CommandStart
|
||||||
startKeys remotemap key ai = do
|
startKeys remotemap key ai = do
|
||||||
showStart' "whereis" key ai
|
showStartKey "whereis" key ai
|
||||||
next $ perform remotemap key
|
next $ perform remotemap key
|
||||||
|
|
||||||
perform :: M.Map UUID Remote -> Key -> CommandPerform
|
perform :: M.Map UUID Remote -> Key -> CommandPerform
|
||||||
|
|
13
Messages.hs
13
Messages.hs
|
@ -7,9 +7,10 @@
|
||||||
|
|
||||||
module Messages (
|
module Messages (
|
||||||
showStart,
|
showStart,
|
||||||
|
showStart',
|
||||||
|
showStartKey,
|
||||||
ActionItem,
|
ActionItem,
|
||||||
mkActionItem,
|
mkActionItem,
|
||||||
showStart',
|
|
||||||
showNote,
|
showNote,
|
||||||
showAction,
|
showAction,
|
||||||
showSideAction,
|
showSideAction,
|
||||||
|
@ -66,8 +67,14 @@ showStart command file = outputMessage json $
|
||||||
where
|
where
|
||||||
json = JSON.start command (Just file) Nothing
|
json = JSON.start command (Just file) Nothing
|
||||||
|
|
||||||
showStart' :: String -> Key -> ActionItem -> Annex ()
|
showStart' :: String -> Maybe String -> Annex ()
|
||||||
showStart' command key i = outputMessage json $
|
showStart' command mdesc = outputMessage json $
|
||||||
|
command ++ (maybe "" (" " ++) mdesc) ++ " "
|
||||||
|
where
|
||||||
|
json = JSON.start command Nothing Nothing
|
||||||
|
|
||||||
|
showStartKey :: String -> Key -> ActionItem -> Annex ()
|
||||||
|
showStartKey command key i = outputMessage json $
|
||||||
command ++ " " ++ actionItemDesc i key ++ " "
|
command ++ " " ++ actionItemDesc i key ++ " "
|
||||||
where
|
where
|
||||||
json = JSON.start command (actionItemWorkTreeFile i) (Just key)
|
json = JSON.start command (actionItemWorkTreeFile i) (Just key)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue