Support help.autocorrect=prompt

This commit is contained in:
Joey Hess 2025-01-20 10:56:12 -04:00
parent 524298d983
commit b0ef04f0b7
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 36 additions and 13 deletions

View file

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

View file

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

View file

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