diff options
author | Joey Hess <joey@kitenet.net> | 2011-07-19 14:07:23 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2011-07-19 14:07:23 -0400 |
commit | 00153eed48a2328969cc08688ef674a4c19c2014 (patch) | |
tree | f2ee8ac90225d1d2329f45b43061b53b7757d815 | |
parent | ec9e9343d9fa99b0786ee93ff142484e2402d3c8 (diff) |
unify elipsis handling
And add a simple dots-based progress display, currently only used in v2
upgrade.
-rw-r--r-- | AnnexQueue.hs | 2 | ||||
-rw-r--r-- | Backend/SHA.hs | 2 | ||||
-rw-r--r-- | Branch.hs | 2 | ||||
-rw-r--r-- | Command.hs | 2 | ||||
-rw-r--r-- | Command/AddUrl.hs | 2 | ||||
-rw-r--r-- | Command/DropUnused.hs | 2 | ||||
-rw-r--r-- | Command/Get.hs | 2 | ||||
-rw-r--r-- | Command/Map.hs | 8 | ||||
-rw-r--r-- | Command/Move.hs | 14 | ||||
-rw-r--r-- | Command/Unlock.hs | 2 | ||||
-rw-r--r-- | Command/Unused.hs | 4 | ||||
-rw-r--r-- | Command/Whereis.hs | 2 | ||||
-rw-r--r-- | Messages.hs | 39 | ||||
-rw-r--r-- | Remote/Bup.hs | 10 | ||||
-rw-r--r-- | Remote/Git.hs | 4 | ||||
-rw-r--r-- | Remote/Hook.hs | 4 | ||||
-rw-r--r-- | Remote/Rsync.hs | 4 | ||||
-rw-r--r-- | Remote/S3real.hs | 6 | ||||
-rw-r--r-- | Remote/Web.hs | 4 | ||||
-rw-r--r-- | Upgrade/V0.hs | 2 | ||||
-rw-r--r-- | Upgrade/V1.hs | 8 | ||||
-rw-r--r-- | Upgrade/V2.hs | 13 |
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 @@ -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] |