git-annex/Command/Whereis.hs

169 lines
5.1 KiB
Haskell
Raw Permalink Normal View History

{- git-annex command
-
- Copyright 2010-2020 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE TupleSections #-}
module Command.Whereis where
import Command
import Remote
2011-10-15 20:21:08 +00:00
import Logs.Trust
import Logs.Web
import Remote.Web (getWebUrls)
import Annex.UUID
import Annex.NumCopies
import qualified Utility.Format
import qualified Command.Find
import qualified Data.Map as M
import qualified Data.Vector as V
cmd :: Command
cmd = noCommit $ withAnnexOptions [jsonOptions, annexedMatchingOptions] $
command "whereis" SectionQuery
"lists repositories that have file content"
2015-07-10 20:32:33 +00:00
paramPaths (seek <$$> optParser)
data WhereisOptions = WhereisOptions
{ whereisFiles :: CmdParams
, keyOptions :: Maybe KeyOptions
2016-01-20 16:46:00 +00:00
, batchOption :: BatchMode
, formatOption :: Maybe Utility.Format.Format
}
2015-07-10 20:32:33 +00:00
optParser :: CmdParamsDesc -> Parser WhereisOptions
optParser desc = WhereisOptions
<$> cmdParams desc
<*> optional parseKeyOptions
<*> parseBatchOption True
<*> optional parseFormatOption
parseFormatOption :: Parser Utility.Format.Format
parseFormatOption = option (Utility.Format.gen <$> str)
( long "format" <> metavar paramFormat
<> help "control format of output"
)
2015-07-10 20:32:33 +00:00
seek :: WhereisOptions -> CommandSeek
seek o = do
m <- remoteMap id
let seeker = AnnexedFileSeeker
{ startAction = const $ start o m
, checkContentPresent = Nothing
, usesLocationLog = True
}
2016-01-20 16:46:00 +00:00
case batchOption o of
NoBatch -> do
withKeyOptions (keyOptions o) False seeker
(commandAction . startKeys o m)
(withFilesInGitAnnex ww seeker)
=<< workTreeItems ww (whereisFiles o)
Batch fmt -> batchOnly (keyOptions o) (whereisFiles o) $
batchAnnexed fmt seeker (startKeys o m)
where
ww = WarnUnmatchLsFiles "whereis"
start :: WhereisOptions -> M.Map UUID Remote -> SeekInput -> RawFilePath -> Key -> CommandStart
start o remotemap si file key =
startKeys o remotemap (si, key, mkActionItem (key, afile))
where
afile = AssociatedFile (Just file)
2014-01-26 18:26:32 +00:00
startKeys :: WhereisOptions -> M.Map UUID Remote -> (SeekInput, Key, ActionItem) -> CommandStart
startKeys o remotemap (si, key, ai)
| isJust (formatOption o) = startingCustomOutput ai go
| otherwise = starting "whereis" ai si go
where
go = perform o remotemap key ai
perform :: WhereisOptions -> M.Map UUID Remote -> Key -> ActionItem -> CommandPerform
perform o remotemap key ai = do
locations <- keyLocations key
urls <- getUUIDUrls key locations remotemap
(untrustedlocations, safelocations) <- trustPartition UnTrusted locations
case formatOption o of
Nothing -> do
let num = numCopiesCount safelocations
showNote $ UnquotedString $ show num ++ " " ++ copiesplural num
pp <- ppwhereis "whereis" safelocations urls
unless (null safelocations) $
showLongNote (UnquotedString pp)
pp' <- ppwhereis "untrusted" untrustedlocations urls
unless (null untrustedlocations) $
showLongNote $ UnquotedString $
untrustedheader ++ pp'
mapM_ (showRemoteUrls remotemap) urls
Just formatter -> liftIO $ do
let vs = Command.Find.formatVars key
(AssociatedFile (actionItemFile ai))
let showformatted muuid murl = putStr $
Utility.Format.format formatter $
M.fromList $ vs ++ catMaybes
[ fmap ("uuid",) muuid
, fmap ("url",) murl
]
let showformatted' muuid
| Utility.Format.formatContainsVar "url" formatter =
forM_ (concatMap snd urls) $
showformatted muuid . Just
| otherwise = showformatted muuid Nothing
if Utility.Format.formatContainsVar "uuid" formatter
then forM_ locations $
showformatted' . Just . fromUUID
else showformatted' Nothing
if null safelocations then stop else next $ return True
2012-11-12 05:05:04 +00:00
where
copiesplural 1 = "copy"
copiesplural _ = "copies"
untrustedheader = "The following untrusted locations may also have copies:\n"
ppwhereis h ls urls = do
descm <- uuidDescriptions
let urlvals = map (\(u, us) -> (u, Just (V.fromList us))) $
filter (\(u,_) -> u `elem` ls) urls
prettyPrintUUIDsWith (Just "urls") h descm (const Nothing) urlvals
getUUIDUrls :: Key -> [UUID] -> M.Map UUID Remote -> Annex [(UUID, [URLString])]
getUUIDUrls key uuids remotemap = forM uuids $ \uu -> (,)
<$> pure uu
<*> maybe (pure []) (getRemoteUrls key) (M.lookup uu remotemap)
getRemoteUrls :: Key -> Remote -> Annex [URLString]
getRemoteUrls key remote
| uuid remote == webUUID =
map (fst . getDownloader) <$> getWebUrls key
| otherwise = (++)
<$> askremote
<*> claimedurls
2012-11-12 05:05:04 +00:00
where
askremote = case whereisKey remote of
Nothing -> pure []
Just w -> tryNonAsync (w key) >>= \case
Right l -> pure l
Left e -> do
warning $ UnquotedString $ unwords
[ "unable to query remote"
, name remote
, "for urls:"
, show e
]
return []
claimedurls = do
us <- map fst
. filter (\(_, d) -> d == OtherDownloader)
. map getDownloader
<$> getUrls key
filterM (\u -> (==) <$> pure remote <*> claimingUrl u) us
showRemoteUrls :: M.Map UUID Remote -> (UUID, [URLString]) -> Annex ()
showRemoteUrls remotemap (uu, us)
| null us = noop
| otherwise = case M.lookup uu remotemap of
Just r -> showLongNote $ UnquotedString $
unlines $ map (\u -> name r ++ ": " ++ u) us
Nothing -> noop