command output cleanup

Backend/File.hs

@@ -53,12 +53,13 @@ copyKeyFile key file = do
 	remotes <- Remotes.withKey key
 	if (0 == length remotes)
 		then cantfind
-		else return ()
+		else trycopy remotes remotes
-	trycopy remotes remotes
 	where
-		trycopy full [] = error $ "unable to get file with key: " ++ (keyFile key) ++ "\n" ++
+		trycopy full [] = do
-			"To get that file, need access to one of these remotes: " ++
+			showNote $
-			(Remotes.list full)
+				"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: " ++
+			showNote $ "No available git remotes have the file."
-				(keyFile key) ++ 
+			if (0 < length uuids)
-				if (0 < length uuids)
+				then showLongNote $ "It has been seen before in these repositories:\n" ++ ppuuids
-					then "\nIt has been seen before in these repositories:\n" ++ ppuuids
+				else return ()
-					else ""
+			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 $
+		notEnoughCopiesSeen bad = do
-				"I failed to find enough other copies of: " ++
+			showNote "failed to find enough other copies of the file"
-				(keyFile key) ++
+			if (0 /= length bad) then listbad bad else return ()
-				(if (0 /= length bad) then listbad bad else "")
+			unsafe
-				++ unsafe
+			return False
-		listbad bad = "\nI was unable to access these remotes: " ++
+		listbad bad =
+			showLongNote $ 
+				"I was unable to access these remotes: " ++
 				(Remotes.list bad)
-		retNotEnoughCopiesKnown remotes numcopies = failMsg $ 
+		retNotEnoughCopiesKnown remotes numcopies = do
+			showNote $
 				"I only know about " ++ (show $ length remotes) ++ 
 				" out of " ++ (show numcopies) ++ 
-				" necessary copies of: " ++ (keyFile key) ++
+				" necessary copies of the file"
-				unsafe
+			unsafe
-		unsafe = "\n" ++
+			return False
-			"  -- According to the " ++ config ++
+		unsafe = do
-			" setting, it is not safe to remove it!\n" ++
+			showLongNote $ "According to the " ++ config ++
-			"     (Use --force to override.)"
+				" setting, it is not safe to remove it!"
+			showLongNote "(Use --force to override.)"
 
 		config = "annex.numcopies"

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",
+				then liftIO $ Git.run g ["commit", "--quiet",
-					("git-annex unannexed " ++ file), file]
+					"-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 ()
+					showEndOk
-				else error $ "failed to get " ++ file
+				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
+				then do
-				else error $ "backend refused to drop " ++ file
+					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

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",
+				then liftIO $ Git.run g ["commit", "--quiet", 
-					(fromJust commitmessage), file]
+					"-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"

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))