summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--AnnexQueue.hs2
-rw-r--r--Backend/SHA.hs2
-rw-r--r--Branch.hs2
-rw-r--r--Command.hs2
-rw-r--r--Command/AddUrl.hs2
-rw-r--r--Command/DropUnused.hs2
-rw-r--r--Command/Get.hs2
-rw-r--r--Command/Map.hs8
-rw-r--r--Command/Move.hs14
-rw-r--r--Command/Unlock.hs2
-rw-r--r--Command/Unused.hs4
-rw-r--r--Command/Whereis.hs2
-rw-r--r--Messages.hs39
-rw-r--r--Remote/Bup.hs10
-rw-r--r--Remote/Git.hs4
-rw-r--r--Remote/Hook.hs4
-rw-r--r--Remote/Rsync.hs4
-rw-r--r--Remote/S3real.hs6
-rw-r--r--Remote/Web.hs4
-rw-r--r--Upgrade/V0.hs2
-rw-r--r--Upgrade/V1.hs8
-rw-r--r--Upgrade/V2.hs13
22 files changed, 76 insertions, 62 deletions
diff --git a/AnnexQueue.hs b/AnnexQueue.hs
index b1678df07..79116c48a 100644
--- a/AnnexQueue.hs
+++ b/AnnexQueue.hs
@@ -38,7 +38,7 @@ flush silent = do
q <- getState repoqueue
unless (0 == Git.Queue.size q) $ do
unless silent $
- showSideAction "Recording state in git..."
+ showSideAction "Recording state in git"
g <- gitRepo
q' <- liftIO $ Git.Queue.flush g q
store q'
diff --git a/Backend/SHA.hs b/Backend/SHA.hs
index dc27b3000..c1d713648 100644
--- a/Backend/SHA.hs
+++ b/Backend/SHA.hs
@@ -72,7 +72,7 @@ shaNameE size = shaName size ++ "E"
shaN :: SHASize -> FilePath -> Annex String
shaN size file = do
- showNote "checksum..."
+ showAction "checksum"
liftIO $ pOpen ReadFromPipe command (toCommand [File file]) $ \h -> do
line <- hGetLine h
let bits = split " " line
diff --git a/Branch.hs b/Branch.hs
index c8e6bc2bb..35e305093 100644
--- a/Branch.hs
+++ b/Branch.hs
@@ -190,7 +190,7 @@ updateRef ref
if null diffs
then return Nothing
else do
- showSideAction $ "merging " ++ shortref ref ++ " into " ++ name ++ "..."
+ showSideAction $ "merging " ++ shortref ref ++ " into " ++ name
-- By passing only one ref, it is actually
-- merged into the index, preserving any
-- changes that may already be staged.
diff --git a/Command.hs b/Command.hs
index 729e442fc..02bbd29d4 100644
--- a/Command.hs
+++ b/Command.hs
@@ -102,7 +102,7 @@ doCommand = start
stage a b = b >>= a
success = return True
failure = do
- showProgress
+ showOutput -- avoid clutter around error message
showEndFail
return False
diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs
index e80fe9621..1b12362e9 100644
--- a/Command/AddUrl.hs
+++ b/Command/AddUrl.hs
@@ -43,7 +43,7 @@ start s = do
perform :: String -> FilePath -> CommandPerform
perform url file = do
g <- Annex.gitRepo
- showNote $ "downloading " ++ url
+ showAction $ "downloading " ++ url ++ " "
let dummykey = stubKey { keyName = url, keyBackendName = "URL" }
let tmp = gitAnnexTmpLocation g dummykey
liftIO $ createDirectoryIfMissing True (parentDir tmp)
diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs
index a01e08ab5..41bcd6aa7 100644
--- a/Command/DropUnused.hs
+++ b/Command/DropUnused.hs
@@ -61,7 +61,7 @@ perform key = maybe droplocal dropremote =<< Annex.getState Annex.fromremote
where
dropremote name = do
r <- Remote.byName name
- showNote $ "from " ++ Remote.name r ++ "..."
+ showAction $ "from " ++ Remote.name r
next $ Command.Move.fromCleanup r True key
droplocal = Command.Drop.perform key (Just 0) -- force drop
diff --git a/Command/Get.hs b/Command/Get.hs
index cc780cb6a..e0436a868 100644
--- a/Command/Get.hs
+++ b/Command/Get.hs
@@ -75,7 +75,7 @@ getKeyFile key file = do
Left _ -> return False
else return True
docopy r continue = do
- showNote $ "from " ++ Remote.name r ++ "..."
+ showAction $ "from " ++ Remote.name r
copied <- Remote.retrieveKeyFile r key file
if copied
then return True
diff --git a/Command/Map.hs b/Command/Map.hs
index 557ae2787..07f127f14 100644
--- a/Command/Map.hs
+++ b/Command/Map.hs
@@ -44,7 +44,7 @@ start = do
liftIO $ writeFile file (drawMap rs umap trusted)
showLongNote $ "running: dot -Tx11 " ++ file
- showProgress
+ showOutput
r <- liftIO $ boolSystem "dot" [Param "-Tx11", File file]
next $ next $ return r
where
@@ -176,7 +176,7 @@ scan r = do
showEndOk
return r'
Nothing -> do
- showProgress
+ showOutput
showEndFail
return r
@@ -224,5 +224,5 @@ tryScan r
ok -> return ok
sshnote = do
- showNote "sshing..."
- showProgress
+ showAction "sshing"
+ showOutput
diff --git a/Command/Move.hs b/Command/Move.hs
index a98276e7e..a081a863f 100644
--- a/Command/Move.hs
+++ b/Command/Move.hs
@@ -44,9 +44,9 @@ start move file = do
fromStart src move file
(_ , _) -> error "only one of --from or --to can be specified"
-showAction :: Bool -> FilePath -> Annex ()
-showAction True file = showStart "move" file
-showAction False file = showStart "copy" file
+showMoveAction :: Bool -> FilePath -> Annex ()
+showMoveAction True file = showStart "move" file
+showMoveAction False file = showStart "copy" file
{- Used to log a change in a remote's having a key. The change is logged
- in the local repo, not on the remote. The process of transferring the
@@ -77,7 +77,7 @@ toStart dest move file = isAnnexed file $ \(key, _) -> do
if not ishere || u == Remote.uuid dest
then stop -- not here, so nothing to do
else do
- showAction move file
+ showMoveAction move file
next $ toPerform dest move key
toPerform :: Remote.Remote Annex -> Bool -> Key -> CommandPerform
toPerform dest move key = do
@@ -97,7 +97,7 @@ toPerform dest move key = do
showNote $ show err
stop
Right False -> do
- showNote $ "to " ++ Remote.name dest ++ "..."
+ showAction $ "to " ++ Remote.name dest
ok <- Remote.storeKey dest key
if ok
then next $ toCleanup dest move key
@@ -127,7 +127,7 @@ fromStart src move file = isAnnexed file $ \(key, _) -> do
if u == Remote.uuid src || not (any (== src) remotes)
then stop
else do
- showAction move file
+ showMoveAction move file
next $ fromPerform src move key
fromPerform :: Remote.Remote Annex -> Bool -> Key -> CommandPerform
fromPerform src move key = do
@@ -135,7 +135,7 @@ fromPerform src move key = do
if ishere
then next $ fromCleanup src move key
else do
- showNote $ "from " ++ Remote.name src ++ "..."
+ showAction $ "from " ++ Remote.name src
ok <- getViaTmp key $ Remote.retrieveKeyFile src key
if ok
then next $ fromCleanup src move key
diff --git a/Command/Unlock.hs b/Command/Unlock.hs
index d189545f5..280eff9de 100644
--- a/Command/Unlock.hs
+++ b/Command/Unlock.hs
@@ -45,7 +45,7 @@ perform dest key = do
let src = gitAnnexLocation g key
let tmpdest = gitAnnexTmpLocation g key
liftIO $ createDirectoryIfMissing True (parentDir tmpdest)
- showNote "copying..."
+ showAction "copying"
ok <- liftIO $ copyFile src tmpdest
if ok
then do
diff --git a/Command/Unused.hs b/Command/Unused.hs
index 870c993f1..e7065b3c3 100644
--- a/Command/Unused.hs
+++ b/Command/Unused.hs
@@ -68,7 +68,7 @@ checkRemoteUnused name = do
checkRemoteUnused' :: Remote.Remote Annex -> Annex ()
checkRemoteUnused' r = do
- showNote "checking for unused data..."
+ showAction "checking for unused data"
referenced <- getKeysReferenced
remotehas <- filterM isthere =<< loggedKeys
let remoteunused = remotehas `exclude` referenced
@@ -152,7 +152,7 @@ unusedKeys = do
bad <- staleKeys gitAnnexBadDir
return ([], bad, tmp)
else do
- showNote "checking for unused data..."
+ showAction "checking for unused data"
present <- getKeysPresent
referenced <- getKeysReferenced
let unused = present `exclude` referenced
diff --git a/Command/Whereis.hs b/Command/Whereis.hs
index 05748e8d6..314fef782 100644
--- a/Command/Whereis.hs
+++ b/Command/Whereis.hs
@@ -35,7 +35,7 @@ perform key = do
else do
pp <- prettyPrintUUIDs uuids
showLongNote pp
- showProgress
+ showOutput
next $ return True
where
copiesplural 1 = "copy"
diff --git a/Messages.hs b/Messages.hs
index 5f150aafb..36f0b89c5 100644
--- a/Messages.hs
+++ b/Messages.hs
@@ -20,21 +20,29 @@ verbose a = do
q <- Annex.getState Annex.quiet
unless q a
-showSideAction :: String -> Annex ()
-showSideAction s = verbose $ liftIO $ putStrLn $ "(" ++ s ++ ")"
-
showStart :: String -> String -> Annex ()
-showStart command file = verbose $ do
- liftIO $ putStr $ command ++ " " ++ file ++ " "
- liftIO $ hFlush stdout
+showStart command file = verbose $ liftIO $ do
+ putStr $ command ++ " " ++ file ++ " "
+ hFlush stdout
showNote :: String -> Annex ()
-showNote s = verbose $ do
- liftIO $ putStr $ "(" ++ s ++ ") "
- liftIO $ hFlush stdout
+showNote s = verbose $ liftIO $ do
+ putStr $ "(" ++ s ++ ") "
+ hFlush stdout
+
+showAction :: String -> Annex ()
+showAction s = showNote $ s ++ "..."
showProgress :: Annex ()
-showProgress = verbose $ liftIO $ putStr "\n"
+showProgress = verbose $ liftIO $ do
+ putStr "."
+ hFlush stdout
+
+showSideAction :: String -> Annex ()
+showSideAction s = verbose $ liftIO $ putStrLn $ "(" ++ s ++ "...)"
+
+showOutput :: Annex ()
+showOutput = verbose $ liftIO $ putStr "\n"
showLongNote :: String -> Annex ()
showLongNote s = verbose $ liftIO $ putStr $ '\n' : indent s
@@ -50,15 +58,16 @@ showEndResult True = showEndOk
showEndResult False = showEndFail
showErr :: (Show a) => a -> Annex ()
-showErr e = do
- liftIO $ hFlush stdout
- liftIO $ hPutStrLn stderr $ "git-annex: " ++ show e
+showErr e = liftIO $ do
+ hFlush stdout
+ hPutStrLn stderr $ "git-annex: " ++ show e
warning :: String -> Annex ()
warning w = do
verbose $ liftIO $ putStr "\n"
- liftIO $ hFlush stdout
- liftIO $ hPutStrLn stderr $ indent w
+ liftIO $ do
+ hFlush stdout
+ hPutStrLn stderr $ indent w
indent :: String -> String
indent s = join "\n" $ map (\l -> " " ++ l) $ lines s
diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index 4ea455226..1023cda18 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -76,7 +76,7 @@ bupSetup u c = do
-- bup init will create the repository.
-- (If the repository already exists, bup init again appears safe.)
- showNote "bup init"
+ showAction "bup init"
bup "init" buprepo [] >>! error "bup init failed"
storeBupUUID u buprepo
@@ -93,7 +93,7 @@ bupParams command buprepo params =
bup :: String -> BupRepo -> [CommandParam] -> Annex Bool
bup command buprepo params = do
- showProgress -- make way for bup output
+ showOutput -- make way for bup output
liftIO $ boolSystem "bup" $ bupParams command buprepo params
pipeBup :: [CommandParam] -> Maybe Handle -> Maybe Handle -> IO Bool
@@ -109,7 +109,7 @@ bupSplitParams :: Git.Repo -> BupRepo -> Key -> CommandParam -> Annex [CommandPa
bupSplitParams r buprepo k src = do
o <- getConfig r "bup-split-options" ""
let os = map Param $ words o
- showProgress -- make way for bup output
+ showOutput -- make way for bup output
return $ bupParams "split" buprepo
(os ++ [Param "-n", Param (show k), src])
@@ -157,7 +157,7 @@ remove _ = do
checkPresent :: Git.Repo -> Git.Repo -> Key -> Annex (Either IOException Bool)
checkPresent r bupr k
| Git.repoIsUrl bupr = do
- showNote ("checking " ++ Git.repoDescribe r ++ "...")
+ showAction $ "checking " ++ Git.repoDescribe r
ok <- onBupRemote bupr boolSystem "git" params
return $ Right ok
| otherwise = liftIO $ try $ boolSystem "git" $ Git.gitCommandLine bupr params
@@ -172,7 +172,7 @@ storeBupUUID u buprepo = do
r <- liftIO $ bup2GitRemote buprepo
if Git.repoIsUrl r
then do
- showNote "storing uuid"
+ showAction "storing uuid"
onBupRemote r boolSystem "git"
[Params $ "config annex.uuid " ++ u]
>>! error "ssh failed"
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 1f22ad11c..de51c891e 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -115,7 +115,7 @@ inAnnex r key = if Git.repoIsUrl r
a <- Annex.new r
Annex.eval a (Content.inAnnex key)
checkremote = do
- showNote ("checking " ++ Git.repoDescribe r ++ "...")
+ showAction $ "checking " ++ Git.repoDescribe r
inannex <- onRemote r (boolSystem, False) "inannex"
[Param (show key)]
return $ Right inannex
@@ -156,7 +156,7 @@ copyToRemote r key
rsyncHelper :: [CommandParam] -> Annex Bool
rsyncHelper p = do
- showProgress -- make way for progress bar
+ showOutput -- make way for progress bar
res <- liftIO $ rsync p
if res
then return res
diff --git a/Remote/Hook.hs b/Remote/Hook.hs
index f0e4d5bfb..87f86ffe4 100644
--- a/Remote/Hook.hs
+++ b/Remote/Hook.hs
@@ -98,7 +98,7 @@ runHook :: String -> String -> Key -> Maybe FilePath -> Annex Bool -> Annex Bool
runHook hooktype hook k f a = maybe (return False) run =<< lookupHook hooktype hook
where
run command = do
- showProgress -- make way for hook output
+ showOutput -- make way for hook output
res <- liftIO $ boolSystemEnv
"sh" [Param "-c", Param command] $ hookEnv k f
if res
@@ -133,7 +133,7 @@ remove h k = runHook h "remove" k Nothing $ return True
checkPresent :: Git.Repo -> String -> Key -> Annex (Either IOException Bool)
checkPresent r h k = do
- showNote ("checking " ++ Git.repoDescribe r ++ "...")
+ showAction $ "checking " ++ Git.repoDescribe r
v <- lookupHook h "checkpresent"
liftIO (try (check v) ::IO (Either IOException Bool))
where
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index ca4236276..f073e7bd7 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -141,7 +141,7 @@ remove o k = withRsyncScratchDir $ \tmp -> do
checkPresent :: Git.Repo -> RsyncOpts -> Key -> Annex (Either IOException Bool)
checkPresent r o k = do
- showNote ("checking " ++ Git.repoDescribe r ++ "...")
+ showAction $ "checking " ++ Git.repoDescribe r
-- note: Does not currently differnetiate between rsync failing
-- to connect, and the file not being present.
res <- liftIO $ boolSystem "sh" [Param "-c", Param cmd]
@@ -174,7 +174,7 @@ withRsyncScratchDir a = do
rsyncRemote :: RsyncOpts -> [CommandParam] -> Annex Bool
rsyncRemote o params = do
- showProgress -- make way for progress bar
+ showOutput -- make way for progress bar
res <- liftIO $ rsync $ rsyncOptions o ++ defaultParams ++ params
if res
then return res
diff --git a/Remote/S3real.hs b/Remote/S3real.hs
index cbd3ef622..e4dcc2a71 100644
--- a/Remote/S3real.hs
+++ b/Remote/S3real.hs
@@ -185,7 +185,7 @@ remove r k = s3Action r False $ \(conn, bucket) -> do
checkPresent :: Remote Annex -> Key -> Annex (Either IOException Bool)
checkPresent r k = s3Action r noconn $ \(conn, bucket) -> do
- showNote ("checking " ++ name r ++ "...")
+ showAction $ "checking " ++ name r
res <- liftIO $ getObjectInfo conn $ bucketKey r bucket k
case res of
Right _ -> return $ Right True
@@ -241,13 +241,13 @@ iaMunge = (>>= munge)
genBucket :: RemoteConfig -> Annex ()
genBucket c = do
conn <- s3ConnectionRequired c
- showNote "checking bucket"
+ showAction "checking bucket"
loc <- liftIO $ getBucketLocation conn bucket
case loc of
Right _ -> return ()
Left err@(NetworkError _) -> s3Error err
Left (AWSError _ _) -> do
- showNote $ "creating bucket in " ++ datacenter
+ showAction $ "creating bucket in " ++ datacenter
res <- liftIO $ createBucketIn conn bucket datacenter
case res of
Right _ -> return ()
diff --git a/Remote/Web.hs b/Remote/Web.hs
index 60f64cfe0..2f8fac23b 100644
--- a/Remote/Web.hs
+++ b/Remote/Web.hs
@@ -106,7 +106,7 @@ checkKey key = do
checkKey' :: [URLString] -> Annex Bool
checkKey' [] = return False
checkKey' (u:us) = do
- showNote ("checking " ++ u)
+ showAction $ "checking " ++ u
e <- liftIO $ urlexists u
if e then return e else checkKey' us
@@ -129,6 +129,6 @@ urlexists url =
download :: [URLString] -> FilePath -> Annex Bool
download [] _ = return False
download (url:us) file = do
- showProgress -- make way for curl progress bar
+ showOutput -- make way for curl progress bar
ok <- liftIO $ boolSystem "curl" [Params "-L -C - -# -o", File file, File url]
if ok then return ok else download us file
diff --git a/Upgrade/V0.hs b/Upgrade/V0.hs
index 071fd12ee..3aabe0770 100644
--- a/Upgrade/V0.hs
+++ b/Upgrade/V0.hs
@@ -23,7 +23,7 @@ import qualified Upgrade.V1
upgrade :: Annex Bool
upgrade = do
- showNote "v0 to v1..."
+ showAction "v0 to v1"
g <- Annex.gitRepo
-- do the reorganisation of the key files
diff --git a/Upgrade/V1.hs b/Upgrade/V1.hs
index 8a3d37a64..c41310880 100644
--- a/Upgrade/V1.hs
+++ b/Upgrade/V1.hs
@@ -58,7 +58,7 @@ import qualified Upgrade.V2
upgrade :: Annex Bool
upgrade = do
- showNote "v1 to v2"
+ showAction "v1 to v2"
g <- Annex.gitRepo
if Git.repoIsLocalBare g
@@ -77,7 +77,7 @@ upgrade = do
moveContent :: Annex ()
moveContent = do
- showNote "moving content..."
+ showAction "moving content"
files <- getKeyFilesPresent1
forM_ files move
where
@@ -91,7 +91,7 @@ moveContent = do
updateSymlinks :: Annex ()
updateSymlinks = do
- showNote "updating symlinks..."
+ showAction "updating symlinks"
g <- Annex.gitRepo
files <- liftIO $ LsFiles.inRepo g [Git.workTree g]
forM_ files fixlink
@@ -108,7 +108,7 @@ updateSymlinks = do
moveLocationLogs :: Annex ()
moveLocationLogs = do
- showNote "moving location logs..."
+ showAction "moving location logs"
logkeys <- oldlocationlogs
forM_ logkeys move
where
diff --git a/Upgrade/V2.hs b/Upgrade/V2.hs
index 99c7806d2..0b1d69f8e 100644
--- a/Upgrade/V2.hs
+++ b/Upgrade/V2.hs
@@ -45,21 +45,25 @@ olddir g
-}
upgrade :: Annex Bool
upgrade = do
- showNote "v2 to v3"
+ showAction "v2 to v3"
g <- Annex.gitRepo
let bare = Git.repoIsLocalBare g
Branch.create
+ showProgress
+
e <- liftIO $ doesDirectoryExist (olddir g)
when e $ do
mapM_ (\(k, f) -> inject f $ logFile k) =<< locationLogs g
mapM_ (\f -> inject f f) =<< logFiles (olddir g)
saveState
+ showProgress
when e $ liftIO $ do
Git.run g "rm" [Param "-r", Param "-f", Param "-q", File (olddir g)]
unless bare $ gitAttributesUnWrite g
+ showProgress
unless bare push
@@ -83,6 +87,7 @@ inject source dest = do
new <- liftIO (readFile $ olddir g </> source)
prev <- Branch.get dest
Branch.change dest $ unlines $ nub $ lines prev ++ lines new
+ showProgress
logFiles :: FilePath -> Annex [FilePath]
logFiles dir = return . filter (".log" `isSuffixOf`)
@@ -105,8 +110,8 @@ push = do
-- "git push" will from then on
-- automatically push it
Branch.update -- just in case
- showNote "pushing new git-annex branch to origin"
- showProgress
+ showAction "pushing new git-annex branch to origin"
+ showOutput
g <- Annex.gitRepo
liftIO $ Git.run g "push" [Param "origin", Param Branch.name]
_ -> do
@@ -116,7 +121,7 @@ push = do
showLongNote $
"git-annex branch created\n" ++
"Be sure to push this branch when pushing to remotes.\n"
- showProgress
+ showOutput
{- Old .gitattributes contents, not needed anymore. -}
attrLines :: [String]
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-04 12:38:17 +0000