From 441543a5691aee865916176339f8c26949ef24a5 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 8 Dec 2017 15:35:02 -0400 Subject: 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. --- Command/LookupKey.hs | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) (limited to 'Command') diff --git a/Command/LookupKey.hs b/Command/LookupKey.hs index 609fe562e..1a2a57f22 100644 --- a/Command/LookupKey.hs +++ b/Command/LookupKey.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2013 Joey Hess + - Copyright 2013-2017 Joey Hess - - 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 -- cgit v1.2.3