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.
This commit is contained in:
Joey Hess 2021-02-02 19:06:33 -04:00
parent 1b63132ca3
commit 97129388d5
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
2 changed files with 24 additions and 5 deletions

View file

@ -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

View file

@ -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)