whereused implemented

except --historical

Sponsored-by: Jack Hill on Patreon
This commit is contained in:
Joey Hess 2021-07-14 14:25:52 -04:00
parent 12e48fcebe
commit 47d3dccf19
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
6 changed files with 84 additions and 5 deletions

View file

@ -1,3 +1,10 @@
git-annex (8.20210715) UNRELEASED; urgency=medium
* whereused: New command, finds what files use a key, or where a key
was used historically.
-- Joey Hess <id@joeyh.name> Wed, 14 Jul 2021 14:26:36 -0400
git-annex (8.20210714) upstream; urgency=medium git-annex (8.20210714) upstream; urgency=medium
* assistant: Avoid unncessary git repository repair in a situation where * assistant: Avoid unncessary git repository repair in a situation where

View file

@ -72,6 +72,7 @@ import qualified Command.FilterBranch
import qualified Command.Find import qualified Command.Find
import qualified Command.FindRef import qualified Command.FindRef
import qualified Command.Whereis import qualified Command.Whereis
import qualified Command.WhereUsed
import qualified Command.List import qualified Command.List
import qualified Command.Log import qualified Command.Log
import qualified Command.Merge import qualified Command.Merge
@ -207,6 +208,7 @@ cmds testoptparser testrunner mkbenchmarkgenerator = map addGitAnnexGlobalOption
, Command.Find.cmd , Command.Find.cmd
, Command.FindRef.cmd , Command.FindRef.cmd
, Command.Whereis.cmd , Command.Whereis.cmd
, Command.WhereUsed.cmd
, Command.List.cmd , Command.List.cmd
, Command.Log.cmd , Command.Log.cmd
, Command.Merge.cmd , Command.Merge.cmd

68
Command/WhereUsed.hs Normal file
View file

@ -0,0 +1,68 @@
{- git-annex command
-
- Copyright 2021 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
module Command.WhereUsed where
import Command
import Git.FilePath
import Annex.CatFile
import Database.Keys
cmd :: Command
cmd = noCommit $ withGlobalOptions [annexedMatchingOptions] $
command "whereused" SectionQuery
"lists repositories that have file content"
paramNothing (seek <$$> optParser)
data WhereUsedOptions = WhereUsedOptions
{ keyOptions :: KeyOptions
, historicalOption :: Bool
}
optParser :: CmdParamsDesc -> Parser WhereUsedOptions
optParser _desc = WhereUsedOptions
<$> (parseUnusedKeysOption <|> parseSpecificKeyOption)
<*> switch
( long "historical"
<> help "find historical uses"
)
seek :: WhereUsedOptions -> CommandSeek
seek o = withKeyOptions (Just (keyOptions o)) False dummyfileseeker
(commandAction . start o) dummyfilecommandseek (WorkTreeItems [])
where
dummyfileseeker = AnnexedFileSeeker
{ startAction = \_ _ _ -> return Nothing
, checkContentPresent = Nothing
, usesLocationLog = False
}
dummyfilecommandseek = const noop
start :: WhereUsedOptions -> (SeekInput, Key, ActionItem) -> CommandStart
start o (_, key, _) = startingCustomOutput key $ do
fs <- filterM stillassociated
=<< mapM (fromRepo . fromTopFilePath)
=<< getAssociatedFiles key
liftIO $ forM_ fs $ display key . fromRawFilePath
when (historicalOption o && null fs) $
findHistorical key
next $ return True
where
-- Some associated files that are in the keys database may no
-- longer correspond to files in the repository.
stillassociated f = catKeyFile f >>= \case
Just k | k == key -> return True
_ -> return False
display :: Key -> FilePath -> IO ()
display key f = putStrLn (serializeKey key ++ " " ++ f)
findHistorical :: Key -> Annex ()
findHistorical key = do
error "TODO"

View file

@ -4,7 +4,7 @@ git-annex whereused - find what files use, or used a key
# SYNOPSIS # SYNOPSIS
git annex whereused `--key=K|--unused` git annex whereused `--key=keyname|--unused`
# DESCRIPTION # DESCRIPTION

View file

@ -373,10 +373,6 @@ content from the key-value store.
See [[git-annex-addunused]](1) for details. See [[git-annex-addunused]](1) for details.
* `whereused`
Finds what files use, or used a key.
* `fix [path ...]` * `fix [path ...]`
Fixes up symlinks that have become broken to again point to annexed content. Fixes up symlinks that have become broken to again point to annexed content.
@ -451,6 +447,10 @@ content from the key-value store.
See [[git-annex-list]](1) for details. See [[git-annex-list]](1) for details.
* `whereused`
Finds what files use, or used a key.
* `log [path ...]` * `log [path ...]`
Displays the location log for the specified file or files, Displays the location log for the specified file or files,

View file

@ -144,6 +144,7 @@ Extra-Source-Files:
doc/git-annex-watch.mdwn doc/git-annex-watch.mdwn
doc/git-annex-webapp.mdwn doc/git-annex-webapp.mdwn
doc/git-annex-whereis.mdwn doc/git-annex-whereis.mdwn
doc/git-annex-whereused.mdwn
doc/git-remote-tor-annex.mdwn doc/git-remote-tor-annex.mdwn
doc/logo.svg doc/logo.svg
doc/logo_16x16.png doc/logo_16x16.png
@ -830,6 +831,7 @@ Executable git-annex
Command.View Command.View
Command.Wanted Command.Wanted
Command.Whereis Command.Whereis
Command.WhereUsed
Common Common
Config Config
Config.Cost Config.Cost