unify elipsis handling

And add a simple dots-based progress display, currently only used in v2
upgrade.

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'

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

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.

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
 

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)

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
 

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

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

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

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

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

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"

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

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"

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

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

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

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

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

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

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

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]