whereis: Prints the urls of files that the web special remote knows about.

Command/Status.hs

@@ -113,7 +113,7 @@ supported_remote_types = stat "supported remote types" $ json unwords $
 
 remote_list :: TrustLevel -> String -> Stat
 remote_list level desc = stat n $ nojson $ lift $ do
-	us <- M.keys <$> (M.union <$> uuidMap <*> remoteMap)
+	us <- M.keys <$> (M.union <$> uuidMap <*> remoteMap Remote.name)
 	rs <- fst <$> trustPartition level us
 	s <- prettyPrintUUIDs n rs
 	return $ if null s then "0" else show (length rs) ++ "\n" ++ beginning s

Command/Whereis.hs

@@ -7,6 +7,8 @@
 
 module Command.Whereis where
 
+import qualified Data.Map as M
+
 import Common.Annex
 import Command
 import Remote
@@ -17,24 +19,36 @@ def = [command "whereis" paramPaths seek
 	"lists repositories that have file content"]
 
 seek :: [CommandSeek]
-seek = [withFilesInGit $ whenAnnexed start]
+seek = [withValue (remoteMap id) $ \m ->
+	withFilesInGit $ whenAnnexed $ start m]
 
-start :: FilePath -> (Key, Backend) -> CommandStart
+start :: (M.Map UUID Remote) -> FilePath -> (Key, Backend) -> CommandStart
-start file (key, _) = do
+start remotemap file (key, _) = do
 	showStart "whereis" file
-	next $ perform key
+	next $ perform remotemap key
 
-perform :: Key -> CommandPerform
+perform :: (M.Map UUID Remote) -> Key -> CommandPerform
-perform key = do
+perform remotemap key = do
-	(untrustedlocations, safelocations) <- trustPartition UnTrusted =<< keyLocations key
+	locations <- keyLocations key
+	(untrustedlocations, safelocations) <- trustPartition UnTrusted locations
 	let num = length safelocations
 	showNote $ show num ++ " " ++ copiesplural num
 	pp <- prettyPrintUUIDs "whereis" safelocations
 	unless (null safelocations) $ showLongNote pp
 	pp' <- prettyPrintUUIDs "untrusted" untrustedlocations
 	unless (null untrustedlocations) $ showLongNote $ untrustedheader ++ pp'
+	forM_ (catMaybes $ map (`M.lookup` remotemap) locations) $
+		performRemote key
 	if null safelocations then stop else next $ return True
 	where
 		copiesplural 1 = "copy"
 		copiesplural _ = "copies"
 		untrustedheader = "The following untrusted locations may also have copies:\n"
+
+performRemote :: Key -> Remote -> Annex () 
+performRemote key remote = case whereisKey remote of
+	Nothing -> return ()
+	Just a -> do
+		ls <- a key
+		unless (null ls) $ showLongNote $
+			unlines $ map (\l -> name remote ++ ": " ++ l) ls

Remote.hs

@@ -15,6 +15,7 @@ module Remote (
 	removeKey,
 	hasKey,
 	hasKeyCheap,
+	whereisKey,
 
 	remoteTypes,
 	remoteList,
@@ -48,16 +49,16 @@ import Logs.Trust
 import Logs.Location
 import Remote.List
 
-{- Map of UUIDs of Remotes and their names. -}
+{- Map from UUIDs of Remotes to a calculated value. -}
-remoteMap :: Annex (M.Map UUID String)
+remoteMap :: (Remote -> a) -> Annex (M.Map UUID a)
-remoteMap = M.fromList . map (\r -> (uuid r, name r)) .
+remoteMap c = M.fromList . map (\r -> (uuid r, c r)) .
 	filter (\r -> uuid r /= NoUUID) <$> remoteList
 
 {- Map of UUIDs and their descriptions.
  - The names of Remotes are added to suppliment any description that has
  - been set for a repository. -}
 uuidDescriptions :: Annex (M.Map UUID String)
-uuidDescriptions = M.unionWith addName <$> uuidMap <*> remoteMap
+uuidDescriptions = M.unionWith addName <$> uuidMap <*> remoteMap name
 
 addName :: String -> String -> String
 addName desc n

Remote/Bup.hs

@@ -53,6 +53,7 @@ gen r u c = do
 			removeKey = remove,
 			hasKey = checkPresent r bupr',
 			hasKeyCheap = bupLocal buprepo,
+			whereisKey = Nothing,
 			config = c,
 			repo = r,
 			remotetype = remote

Remote/Directory.hs

@@ -45,6 +45,7 @@ gen r u c = do
 			removeKey = remove dir,
 			hasKey = checkPresent dir,
 			hasKeyCheap = True,
+			whereisKey = Nothing,
 			config = Nothing,
 			repo = r,
 			remotetype = remote

Remote/Git.hs

@@ -81,6 +81,7 @@ gen r u _ = do
 		removeKey = dropKey r',
 		hasKey = inAnnex r',
 		hasKeyCheap = cheap,
+		whereisKey = Nothing,
 		config = Nothing,
 		repo = r',
 		remotetype = remote

Remote/Hook.hs

@@ -45,6 +45,7 @@ gen r u c = do
 			removeKey = remove hooktype,
 			hasKey = checkPresent r hooktype,
 			hasKeyCheap = False,
+			whereisKey = Nothing,
 			config = Nothing,
 			repo = r,
 			remotetype = remote

Remote/Rsync.hs

@@ -52,6 +52,7 @@ gen r u c = do
 			removeKey = remove o,
 			hasKey = checkPresent r o,
 			hasKeyCheap = False,
+			whereisKey = Nothing,
 			config = Nothing,
 			repo = r,
 			remotetype = remote

Remote/S3.hs

@@ -57,6 +57,7 @@ gen' r u c cst =
 			removeKey = remove this,
 			hasKey = checkPresent this,
 			hasKeyCheap = False,
+			whereisKey = Nothing,
 			config = c,
 			repo = r,
 			remotetype = remote

Remote/Web.hs

@@ -45,6 +45,7 @@ gen r _ _ =
 		removeKey = dropKey,
 		hasKey = checkKey,
 		hasKeyCheap = False,
+		whereisKey = Just getUrls,
 		config = Nothing,
 		repo = r,
 		remotetype = remote

Types/Remote.hs

@@ -55,6 +55,8 @@ data RemoteA a = Remote {
 	-- Some remotes can check hasKey without an expensive network
 	-- operation.
 	hasKeyCheap :: Bool,
+	-- Some remotes can provide additional details for whereis.
+	whereisKey :: Maybe (Key -> a [String]),
 	-- a Remote can have a persistent configuration store
 	config :: Maybe RemoteConfig,
 	-- git configuration for the remote

debian/changelog

@@ -24,6 +24,7 @@ git-annex (3.20120124) UNRELEASED; urgency=low
     its head), and records the size in the key.
   * Fixed to use the strict state monad, to avoid leaking all kinds of memory
     due to lazy state update thunks when adding/fixing many files.
+  * whereis: Prints the urls of files that the web special remote knows about.
 
  -- Joey Hess <joeyh@debian.org>  Tue, 24 Jan 2012 16:21:55 -0400