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:
parent
1b63132ca3
commit
97129388d5
2 changed files with 24 additions and 5 deletions
19
CmdLine.hs
19
CmdLine.hs
|
@ -33,8 +33,8 @@ dispatch :: Bool -> Bool -> CmdParams -> [Command] -> [(String, String)] -> IO G
|
||||||
dispatch addonok fuzzyok allargs allcmds fields getgitrepo progname progdesc =
|
dispatch addonok fuzzyok allargs allcmds fields getgitrepo progname progdesc =
|
||||||
go addonok allcmds $
|
go addonok allcmds $
|
||||||
findAddonCommand subcommandname >>= \case
|
findAddonCommand subcommandname >>= \case
|
||||||
Nothing -> go False allcmds noop
|
Just c -> go addonok (c:allcmds) noop
|
||||||
Just c -> go addonok (c:allcmds) $
|
Nothing -> go addonok allcmds $
|
||||||
findAllAddonCommands >>= \cs ->
|
findAllAddonCommands >>= \cs ->
|
||||||
go False (cs++allcmds) noop
|
go False (cs++allcmds) noop
|
||||||
where
|
where
|
||||||
|
@ -158,7 +158,20 @@ findAddonCommand (Just subcommandname) =
|
||||||
c = "git-annex-" ++ subcommandname
|
c = "git-annex-" ++ subcommandname
|
||||||
|
|
||||||
findAllAddonCommands :: IO [Command]
|
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 :: FilePath -> String -> Command
|
||||||
mkAddonCommand p subcommandname = Command
|
mkAddonCommand p subcommandname = Command
|
||||||
|
|
|
@ -31,6 +31,7 @@ import qualified System.FilePath as P
|
||||||
import qualified Data.ByteString as B
|
import qualified Data.ByteString as B
|
||||||
import Data.List
|
import Data.List
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
|
import Control.Monad
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
import Prelude
|
import Prelude
|
||||||
|
|
||||||
|
@ -218,9 +219,14 @@ searchPath command
|
||||||
|
|
||||||
{- Finds commands in PATH that match a predicate. Note that the predicate
|
{- 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
|
- 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 :: (FilePath -> Bool) -> IO [FilePath]
|
||||||
searchPathContents p = concat <$> (P.getSearchPath >>= mapM go)
|
searchPathContents p =
|
||||||
|
filterM doesFileExist
|
||||||
|
=<< (concat <$> (P.getSearchPath >>= mapM go))
|
||||||
where
|
where
|
||||||
go d = map (d P.</>) . filter p
|
go d = map (d P.</>) . filter p
|
||||||
<$> catchDefaultIO [] (getDirectoryContents d)
|
<$> catchDefaultIO [] (getDirectoryContents d)
|
||||||
|
|
Loading…
Reference in a new issue