Support help.autocorrect=prompt
This commit is contained in:
parent
524298d983
commit
b0ef04f0b7
3 changed files with 36 additions and 13 deletions
|
@ -1,3 +1,9 @@
|
||||||
|
git-annex (10.20250116) UNRELEASED; urgency=medium
|
||||||
|
|
||||||
|
* Support help.autocorrect=prompt.
|
||||||
|
|
||||||
|
-- Joey Hess <id@joeyh.name> Mon, 20 Jan 2025 10:24:51 -0400
|
||||||
|
|
||||||
git-annex (10.20250115) upstream; urgency=medium
|
git-annex (10.20250115) upstream; urgency=medium
|
||||||
|
|
||||||
* Improve handing of ssh connection problems during
|
* Improve handing of ssh connection problems during
|
||||||
|
|
|
@ -92,7 +92,7 @@ dispatch' subcommandname args fuzzy cmds allargs allcmds fields getgitrepo progn
|
||||||
handleresult (parseCmd progname progdesc correctedargs allcmds getparser)
|
handleresult (parseCmd progname progdesc correctedargs allcmds getparser)
|
||||||
res -> handleresult res
|
res -> handleresult res
|
||||||
where
|
where
|
||||||
autocorrect = Git.AutoCorrect.prepare (fromJust subcommandname) cmdname (NE.fromList cmds)
|
autocorrect = Git.AutoCorrect.prepare "git-annex" (fromJust subcommandname) cmdname (NE.fromList cmds)
|
||||||
name
|
name
|
||||||
| fuzzy = case cmds of
|
| fuzzy = case cmds of
|
||||||
(c:_) -> Just (cmdname c)
|
(c:_) -> Just (cmdname c)
|
||||||
|
|
|
@ -1,11 +1,11 @@
|
||||||
{- git autocorrection using Damerau-Levenshtein edit distance
|
{- git autocorrection using Damerau-Levenshtein edit distance
|
||||||
-
|
-
|
||||||
- Copyright 2012 Joey Hess <id@joeyh.name>
|
- Copyright 2012-2024 Joey Hess <id@joeyh.name>
|
||||||
-
|
-
|
||||||
- Licensed under the GNU AGPL version 3 or higher.
|
- Licensed under the GNU AGPL version 3 or higher.
|
||||||
-}
|
-}
|
||||||
|
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
|
||||||
|
|
||||||
module Git.AutoCorrect where
|
module Git.AutoCorrect where
|
||||||
|
|
||||||
|
@ -16,6 +16,7 @@ import qualified Git.Config
|
||||||
import Text.EditDistance
|
import Text.EditDistance
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import qualified Data.List.NonEmpty as NE
|
import qualified Data.List.NonEmpty as NE
|
||||||
|
import Data.Char
|
||||||
|
|
||||||
{- These are the same cost values as used in git. -}
|
{- These are the same cost values as used in git. -}
|
||||||
gitEditCosts :: EditCosts
|
gitEditCosts :: EditCosts
|
||||||
|
@ -45,30 +46,46 @@ fuzzymatches input showchoice choices = fst $ unzip $
|
||||||
{- Takes action based on git's autocorrect configuration, in preparation for
|
{- Takes action based on git's autocorrect configuration, in preparation for
|
||||||
- an autocorrected command being run.
|
- an autocorrected command being run.
|
||||||
-}
|
-}
|
||||||
prepare :: String -> (c -> String) -> NE.NonEmpty c -> Maybe Repo -> IO ()
|
prepare :: String -> String -> (c -> String) -> NE.NonEmpty c -> Maybe Repo -> IO ()
|
||||||
prepare input showmatch matches r =
|
prepare cmdname input showmatch matches r =
|
||||||
case readish . fromConfigValue . Git.Config.get "help.autocorrect" "0" =<< r of
|
case readish . getcfg =<< r of
|
||||||
Just n
|
Just n
|
||||||
| n == 0 -> list
|
| n == 0 -> list
|
||||||
| n < 0 -> warn Nothing
|
| n < 0 -> warn Nothing
|
||||||
| otherwise -> sleep n
|
| otherwise -> sleep n
|
||||||
Nothing -> list
|
Nothing -> case getcfg <$> r of
|
||||||
|
Just "prompt" -> prompt
|
||||||
|
_ -> list
|
||||||
where
|
where
|
||||||
|
getcfg = fromConfigValue . Git.Config.get "help.autocorrect" "0"
|
||||||
|
|
||||||
list = giveup $ unlines $
|
list = giveup $ unlines $
|
||||||
[ "Unknown command '" ++ input ++ "'"
|
[ "Unknown command '" ++ input ++ "'"
|
||||||
, ""
|
, ""
|
||||||
, "Did you mean one of these?"
|
, "Did you mean one of these?"
|
||||||
] ++ map (\m -> "\t" ++ showmatch m) (NE.toList matches)
|
] ++ map (\m -> "\t" ++ showmatch m) (NE.toList matches)
|
||||||
|
|
||||||
warn :: Maybe Float -> IO ()
|
warn :: Maybe Float -> IO ()
|
||||||
warn mdelaysec = hPutStr stderr $ unlines
|
warn mdelaysec = hPutStr stderr $ unlines
|
||||||
[ "WARNING: You called a git-annex command named '" ++
|
[ warning
|
||||||
input ++ "', which does not exist."
|
|
||||||
, case mdelaysec of
|
, case mdelaysec of
|
||||||
Nothing -> "Continuing under the assumption that you meant " ++ match
|
Nothing -> "Continuing under the assumption that you meant " ++ match ++ "."
|
||||||
Just sec -> "Continuing in " ++ show sec ++ " seconds, assuming that you meant " ++ match
|
Just sec -> "Continuing in " ++ show sec ++ " seconds, assuming that you meant " ++ match ++ "."
|
||||||
]
|
]
|
||||||
where
|
|
||||||
match = "'" ++ showmatch (NE.head matches) ++ "'."
|
match = "'" ++ showmatch (NE.head matches) ++ "'"
|
||||||
|
|
||||||
|
warning = "WARNING: You called a " ++ cmdname ++ " command named '" ++
|
||||||
|
input ++ "', which does not exist."
|
||||||
|
|
||||||
sleep n = do
|
sleep n = do
|
||||||
warn (Just (fromIntegral n / 10 :: Float))
|
warn (Just (fromIntegral n / 10 :: Float))
|
||||||
threadDelay (n * 100000) -- deciseconds to microseconds
|
threadDelay (n * 100000) -- deciseconds to microseconds
|
||||||
|
|
||||||
|
prompt = do
|
||||||
|
hPutStrLn stderr warning
|
||||||
|
hPutStr stderr ("Run " ++ match ++ " instead [y/N]? ")
|
||||||
|
hFlush stderr
|
||||||
|
resp <- headMaybe . map toLower <$> getLine
|
||||||
|
when (resp /= Just 'y') $
|
||||||
|
exitWith (ExitFailure 1)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue