summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2010-10-17 13:13:49 -0400
committerGravatar Joey Hess <joey@kitenet.net>2010-10-17 13:13:49 -0400
commit6d4fc0ca7eb220298e42d368ead57622e80929a3 (patch)
tree9b45c0f0a18e54cc999f487de509269c5bab4aa7
parent8f6e5da18f80ea5dfc124afed0ff2671a3909d56 (diff)
command output cleanup
-rw-r--r--Backend/File.hs59
-rw-r--r--Commands.hs33
-rw-r--r--Core.hs26
-rw-r--r--UUID.hs2
4 files changed, 75 insertions, 45 deletions
diff --git a/Backend/File.hs b/Backend/File.hs
index 591ff3db4..f7796532b 100644
--- a/Backend/File.hs
+++ b/Backend/File.hs
@@ -53,12 +53,13 @@ copyKeyFile key file = do
remotes <- Remotes.withKey key
if (0 == length remotes)
then cantfind
- else return ()
- trycopy remotes remotes
+ else trycopy remotes remotes
where
- trycopy full [] = error $ "unable to get file with key: " ++ (keyFile key) ++ "\n" ++
- "To get that file, need access to one of these remotes: " ++
- (Remotes.list full)
+ trycopy full [] = do
+ showNote $
+ "need access to one of these remotes: " ++
+ (Remotes.list full)
+ return False
trycopy full (r:rs) = do
-- annexLocation needs the git config to have been
-- read for a remote, so do that now,
@@ -67,6 +68,7 @@ copyKeyFile key file = do
case (result) of
Nothing -> trycopy full rs
Just r' -> do
+ showNote $ "copying from " ++ (Git.repoDescribe r ) ++ "..."
result <- liftIO $ (try (copyFromRemote r' key file)::IO (Either SomeException ()))
case (result) of
Left err -> do
@@ -77,17 +79,15 @@ copyKeyFile key file = do
g <- Annex.gitRepo
uuids <- liftIO $ keyLocations g key
ppuuids <- prettyPrintUUIDs uuids
- error $ "no available git remotes have file with key: " ++
- (keyFile key) ++
- if (0 < length uuids)
- then "\nIt has been seen before in these repositories:\n" ++ ppuuids
- else ""
+ showNote $ "No available git remotes have the file."
+ if (0 < length uuids)
+ then showLongNote $ "It has been seen before in these repositories:\n" ++ ppuuids
+ else return ()
+ return False
{- Tries to copy a file from a remote, exception on error. -}
copyFromRemote :: Git.Repo -> Key -> FilePath -> IO ()
copyFromRemote r key file = do
- putStrLn $ "copy from " ++ (Git.repoDescribe r ) ++ " " ++ file
-
if (Git.repoIsLocal r)
then getlocal
else getremote
@@ -116,9 +116,6 @@ checkRemoveKey key = do
then retNotEnoughCopiesKnown remotes numcopies
else findcopies numcopies remotes []
where
- failMsg w = do
- liftIO $ hPutStrLn stderr $ "git-annex: " ++ w
- return False -- failure, not enough copies found
findcopies 0 _ _ = return True -- success, enough copies found
findcopies _ [] bad = notEnoughCopiesSeen bad
findcopies n (r:rs) bad = do
@@ -134,21 +131,25 @@ checkRemoveKey key = do
a <- Annex.new r all
(result, _) <- Annex.run a (Backend.hasKey key)
return result
- notEnoughCopiesSeen bad = failMsg $
- "I failed to find enough other copies of: " ++
- (keyFile key) ++
- (if (0 /= length bad) then listbad bad else "")
- ++ unsafe
- listbad bad = "\nI was unable to access these remotes: " ++
- (Remotes.list bad)
- retNotEnoughCopiesKnown remotes numcopies = failMsg $
+ notEnoughCopiesSeen bad = do
+ showNote "failed to find enough other copies of the file"
+ if (0 /= length bad) then listbad bad else return ()
+ unsafe
+ return False
+ listbad bad =
+ showLongNote $
+ "I was unable to access these remotes: " ++
+ (Remotes.list bad)
+ retNotEnoughCopiesKnown remotes numcopies = do
+ showNote $
"I only know about " ++ (show $ length remotes) ++
" out of " ++ (show numcopies) ++
- " necessary copies of: " ++ (keyFile key) ++
- unsafe
- unsafe = "\n" ++
- " -- According to the " ++ config ++
- " setting, it is not safe to remove it!\n" ++
- " (Use --force to override.)"
+ " necessary copies of the file"
+ unsafe
+ return False
+ unsafe = do
+ showLongNote $ "According to the " ++ config ++
+ " setting, it is not safe to remove it!"
+ showLongNote "(Use --force to override.)"
config = "annex.numcopies"
diff --git a/Commands.hs b/Commands.hs
index e9b5ddcbd..8591dbf6a 100644
--- a/Commands.hs
+++ b/Commands.hs
@@ -95,11 +95,11 @@ parseCmd argv state = do
addCmd :: FilePath -> Annex ()
addCmd file = inBackend file err $ do
liftIO $ checkLegal file
- liftIO $ putStrLn $ "add " ++ file
+ showStart "add" file
g <- Annex.gitRepo
stored <- Backend.storeFileKey file
case (stored) of
- Nothing -> error $ "no backend could store: " ++ file
+ Nothing -> showEndFail "no backend could store" file
Just (key, backend) -> do
logStatus key ValuePresent
setup g key
@@ -117,11 +117,13 @@ addCmd file = inBackend file err $ do
link <- calcGitLink file key
liftIO $ createSymbolicLink link file
gitAdd file $ Just $ "git-annex annexed " ++ file
+ showEndOk
{- Undo addCmd. -}
unannexCmd :: FilePath -> Annex ()
unannexCmd file = notinBackend file err $ \(key, backend) -> do
- liftIO $ putStrLn $ "unannex " ++ file
+ showStart "unannex" file
+ Annex.flagChange Force True -- force backend to always remove
Backend.removeKey backend key
logStatus key ValueMissing
g <- Annex.gitRepo
@@ -132,16 +134,17 @@ unannexCmd file = notinBackend file err $ \(key, backend) -> do
moveout g src = do
nocommit <- Annex.flagIsSet NoCommit
liftIO $ removeFile file
- liftIO $ Git.run g ["rm", file]
+ liftIO $ Git.run g ["rm", "--quiet", file]
if (not nocommit)
- then liftIO $ Git.run g ["commit", "-m",
- ("git-annex unannexed " ++ file), file]
+ then liftIO $ Git.run g ["commit", "--quiet",
+ "-m", ("git-annex unannexed " ++ file),
+ file]
else return ()
-- git rm deletes empty directories;
-- put them back
liftIO $ createDirectoryIfMissing True (parentDir file)
liftIO $ renameFile src file
- return ()
+ showEndOk
{- Gets an annexed file from one of the backends. -}
getCmd :: FilePath -> Annex ()
@@ -150,6 +153,7 @@ getCmd file = notinBackend file err $ \(key, backend) -> do
if (inannex)
then return ()
else do
+ showStart "get" file
g <- Annex.gitRepo
let dest = annexLocation g key
liftIO $ createDirectoryIfMissing True (parentDir dest)
@@ -157,8 +161,8 @@ getCmd file = notinBackend file err $ \(key, backend) -> do
if (success)
then do
logStatus key ValuePresent
- return ()
- else error $ "failed to get " ++ file
+ showEndOk
+ else showEndFail "get" file
where
err = error $ "not annexed " ++ file
@@ -170,11 +174,13 @@ dropCmd file = notinBackend file err $ \(key, backend) -> do
if (not inbackend)
then return () -- no-op
else do
- liftIO $ putStrLn $ "drop " ++ file
+ showStart "drop" file
success <- Backend.removeKey backend key
if (success)
- then cleanup key
- else error $ "backend refused to drop " ++ file
+ then do
+ cleanup key
+ showEndOk
+ else showEndFail "backend refused to drop" file
where
cleanup key = do
logStatus key ValueMissing
@@ -191,13 +197,14 @@ dropCmd file = notinBackend file err $ \(key, backend) -> do
{- Fixes the symlink to an annexed file. -}
fixCmd :: String -> Annex ()
fixCmd file = notinBackend file err $ \(key, backend) -> do
- liftIO $ putStrLn $ "fix " ++ file
link <- calcGitLink file key
checkLegal file link
+ showStart "fix" file
liftIO $ createDirectoryIfMissing True (parentDir file)
liftIO $ removeFile file
liftIO $ createSymbolicLink link file
gitAdd file $ Just $ "git-annex fix " ++ file
+ showEndOk
where
checkLegal file link = do
l <- liftIO $ readSymbolicLink file
diff --git a/Core.hs b/Core.hs
index 70ec2eca0..27411b2e6 100644
--- a/Core.hs
+++ b/Core.hs
@@ -7,6 +7,7 @@ import System.IO
import System.Directory
import Control.Monad.State (liftIO)
import System.Path
+import Data.String.Utils
import Types
import Locations
@@ -81,8 +82,8 @@ gitAdd file commitmessage = do
g <- Annex.gitRepo
liftIO $ Git.run g ["add", file]
if (isJust commitmessage)
- then liftIO $ Git.run g ["commit", "-m",
- (fromJust commitmessage), file]
+ then liftIO $ Git.run g ["commit", "--quiet",
+ "-m", (fromJust commitmessage), file]
else Annex.flagChange NeedCommit True
{- Calculates the relative path to use to link a file to a key. -}
@@ -104,3 +105,24 @@ logStatus key status = do
f <- liftIO $ logChange g key u status
gitAdd f Nothing -- all logs are committed at end
+{- Output logging -}
+showStart :: String -> String -> Annex ()
+showStart command file = do
+ liftIO $ putStr $ command ++ " " ++ file
+ liftIO $ hFlush stdout
+showNote :: String -> Annex ()
+showNote s = do
+ liftIO $ putStr $ " (" ++ s ++ ")"
+ liftIO $ hFlush stdout
+showLongNote :: String -> Annex ()
+showLongNote s = do
+ liftIO $ putStr $ "\n" ++ (indent s)
+ where
+ indent s = join "\n" $ map (\l -> " " ++ l) $ lines s
+showEndOk :: Annex ()
+showEndOk = do
+ liftIO $ putStrLn " ok"
+showEndFail :: String -> String -> Annex ()
+showEndFail command file = do
+ liftIO $ putStrLn ""
+ error $ command ++ " " ++ file ++ " failed"
diff --git a/UUID.hs b/UUID.hs
index 6bd483a18..b665c27e9 100644
--- a/UUID.hs
+++ b/UUID.hs
@@ -100,7 +100,7 @@ reposByUUID repos uuids = do
prettyPrintUUIDs :: [UUID] -> Annex String
prettyPrintUUIDs uuids = do
m <- uuidMap
- return $ unwords $ map (\u -> " "++(prettify m u)++"\n") uuids
+ return $ unwords $ map (\u -> "\t"++(prettify m u)++"\n") uuids
where
prettify m u =
if (0 < (length $ findlog m u))