diff options
| -rw-r--r-- | Backend/File.hs | 59 | ||||
| -rw-r--r-- | Commands.hs | 33 | ||||
| -rw-r--r-- | Core.hs | 26 | ||||
| -rw-r--r-- | UUID.hs | 2 |
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 @@ -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" @@ -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)) |