From 97129388d584457ffed5899a5b06f67aaec4d2df Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 2 Feb 2021 19:06:33 -0400 Subject: [PATCH] support fuzzy matching of addon commands Note this does find things in PATH that are not executable. Like searchPath use, the executable bit is not checked. Thing is, there does not seem to be a binding for access(), which would be the right way to check that the right execute bit is set. Anyway, if it's in PATH and it's a file, it's probably fine to treat it as something that was intended to be executable. This commit was sponsored by Brock Spratlen on Patreon. --- CmdLine.hs | 19 ++++++++++++++++--- Utility/Path.hs | 10 ++++++++-- 2 files changed, 24 insertions(+), 5 deletions(-) diff --git a/CmdLine.hs b/CmdLine.hs index 986752af7a..23dc35aa91 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -33,8 +33,8 @@ dispatch :: Bool -> Bool -> CmdParams -> [Command] -> [(String, String)] -> IO G dispatch addonok fuzzyok allargs allcmds fields getgitrepo progname progdesc = go addonok allcmds $ findAddonCommand subcommandname >>= \case - Nothing -> go False allcmds noop - Just c -> go addonok (c:allcmds) $ + Just c -> go addonok (c:allcmds) noop + Nothing -> go addonok allcmds $ findAllAddonCommands >>= \cs -> go False (cs++allcmds) noop where @@ -158,7 +158,20 @@ findAddonCommand (Just subcommandname) = c = "git-annex-" ++ subcommandname findAllAddonCommands :: IO [Command] -findAllAddonCommands = return [] -- TODO +findAllAddonCommands = + filter isaddoncommand + . map (\p -> mkAddonCommand p (deprefix p)) + <$> searchPathContents ("git-annex-" `isPrefixOf`) + where + deprefix = replace "git-annex-" "" . takeFileName + isaddoncommand c + -- git-annex-shell + | cmdname c == "shell" = False + -- external special remotes + | "remote-" `isPrefixOf` cmdname c = False + -- external backends + | "backend-" `isPrefixOf` cmdname c = False + | otherwise = True mkAddonCommand :: FilePath -> String -> Command mkAddonCommand p subcommandname = Command diff --git a/Utility/Path.hs b/Utility/Path.hs index 4889ff9c81..cfda748b9f 100644 --- a/Utility/Path.hs +++ b/Utility/Path.hs @@ -31,6 +31,7 @@ import qualified System.FilePath as P import qualified Data.ByteString as B import Data.List import Data.Maybe +import Control.Monad import Control.Applicative import Prelude @@ -218,9 +219,14 @@ searchPath command {- Finds commands in PATH that match a predicate. Note that the predicate - matches on the basename of the command, but the full path to it is - - returned. -} + - returned. + - + - Note that this will find commands in PATH that are not executable. + -} searchPathContents :: (FilePath -> Bool) -> IO [FilePath] -searchPathContents p = concat <$> (P.getSearchPath >>= mapM go) +searchPathContents p = + filterM doesFileExist + =<< (concat <$> (P.getSearchPath >>= mapM go)) where go d = map (d P.) . filter p <$> catchDefaultIO [] (getDirectoryContents d)