diff --git a/Command/Remotes.hs b/Command/Remotes.hs new file mode 100644 index 0000000000..f9ae9b3cd4 --- /dev/null +++ b/Command/Remotes.hs @@ -0,0 +1,64 @@ +{- git-annex command + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.Remotes where + +import qualified Data.Set as S + +import Common.Annex +import Command +import Remote +import Logs.Trust +import Annex.UUID + +def :: [Command] +def = [noCommit $ command "remotes" paramPaths seek + SectionQuery "show which remotes contain files"] + +seek :: [CommandSeek] +seek = + [ withValue getList $ \l -> withNothing $ startHeader l + , withValue getList $ \l -> withFilesInGit $ whenAnnexed $ start l + ] + +getList :: Annex [(UUID, RemoteName, TrustLevel)] +getList = do + rs <- remoteList + ts <- mapM (lookupTrust . uuid) rs + hereu <- getUUID + heretrust <- lookupTrust hereu + return $ (hereu, "here", heretrust) : zip3 (map uuid rs) (map name rs) ts + +startHeader :: [(UUID, RemoteName, TrustLevel)] -> CommandStart +startHeader l = do + liftIO $ putStrLn $ header $ map (\(_, n, t) -> (n, t)) l + stop + +start :: [(UUID, RemoteName, TrustLevel)] -> FilePath -> (Key, Backend) -> CommandStart +start l file (key, _) = do + ls <- S.fromList <$> keyLocations key + liftIO $ putStrLn $ format (map (\(u, _, t) -> (t, S.member u ls)) l) file + stop + +type RemoteName = String +type Present = Bool + +header :: [(RemoteName, TrustLevel)] -> String +header remotes = (unlines $ zipWith formatheader [0..] remotes) ++ (pipes (length remotes)) + where + formatheader n (remotename, trustlevel) = (pipes n) ++ remotename ++ (trust trustlevel) + pipes = flip replicate '|' + trust UnTrusted = " (untrusted)" + trust _ = "" + +format :: [(TrustLevel, Present)] -> FilePath -> String +format remotes file = thereMap ++ " " ++ file + where + thereMap = concatMap there remotes + there (UnTrusted, True) = "x" + there (_, True) = "X" + there (_, False) = "_" diff --git a/GitAnnex.hs b/GitAnnex.hs index 1212edf9fe..ab1e8c3d0d 100644 --- a/GitAnnex.hs +++ b/GitAnnex.hs @@ -42,6 +42,7 @@ import qualified Command.Lock import qualified Command.PreCommit import qualified Command.Find import qualified Command.Whereis +import qualified Command.Remotes import qualified Command.Log import qualified Command.Merge import qualified Command.Status @@ -132,6 +133,7 @@ cmds = concat , Command.AddUnused.def , Command.Find.def , Command.Whereis.def + , Command.Remotes.def , Command.Log.def , Command.Merge.def , Command.Status.def diff --git a/debian/changelog b/debian/changelog index 88c833d783..493e13aa3c 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,11 @@ +git-annex (4.20130912) UNRELEASED; urgency=low + + * remotes: New command, displays a compact table of remotes that + contain files. + (Thanks, anarcat for display code and mastensg for inspiration.) + + -- Joey Hess Thu, 12 Sep 2013 12:14:46 -0400 + git-annex (4.20130911) unstable; urgency=low * Fix problem with test suite in non-unicode locale. diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index adb21428fd..b753e54621 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -549,9 +549,15 @@ subdirectories). * `whereis [path ...]` - Displays a list of repositories known to contain the content of the + Displays a list of repositories known to contain the contents of the specified file or files. +* `remotes` [path ...] + + Displays a table of remotes that contain the contents of the specified + files. Unlike whereis, this only shows configured remotes, not other + repositories. However it is a more compact display. + * `log [path ...]` Displays the location log for the specified file or files,