lookupkey absolute path support

lookupkey: Support being given an absolute filename to a file within the
current git repository.

This commit was supported by the NSF-funded DataLad project.
This commit is contained in:
Joey Hess 2017-12-08 15:35:02 -04:00
parent 8990afaef0
commit cfdfe4df6c
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
4 changed files with 47 additions and 4 deletions

View file

@ -1,6 +1,6 @@
{- git-annex command
-
- Copyright 2013 Joey Hess <id@joeyh.name>
- Copyright 2013-2017 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@ -9,6 +9,7 @@ module Command.LookupKey where
import Command
import Annex.CatFile
import qualified Git.LsFiles
cmd :: Command
cmd = notBareRepo $ noCommit $ noMessages $
@ -18,10 +19,21 @@ cmd = notBareRepo $ noCommit $ noMessages $
(batchable run (pure ()))
run :: () -> String -> Annex Bool
run _ file = do
mk <- catKeyFile file
case mk of
run _ file = seekSingleGitFile file >>= \case
Nothing -> return False
Just file' -> catKeyFile file' >>= \case
Just k -> do
liftIO $ putStrLn $ key2file k
return True
Nothing -> return False
-- To support absolute filenames, pass through git ls-files.
-- But, this plumbing command does not recurse through directories.
seekSingleGitFile :: FilePath -> Annex (Maybe FilePath)
seekSingleGitFile file = do
(l, cleanup) <- inRepo (Git.LsFiles.inRepo [file])
r <- case l of
(f:[]) | takeFileName f == takeFileName file -> return (Just f)
_ -> return Nothing
void $ liftIO cleanup
return r