Support help.autocorrect=prompt

CHANGELOG

@@ -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
 
   * Improve handing of ssh connection problems during 

CmdLine.hs

@@ -92,7 +92,7 @@ dispatch' subcommandname args fuzzy cmds allargs allcmds fields getgitrepo progn
 				handleresult (parseCmd progname progdesc correctedargs allcmds getparser)
 			res -> handleresult res
 	  where
-		autocorrect = Git.AutoCorrect.prepare (fromJust subcommandname) cmdname (NE.fromList cmds)
+		autocorrect = Git.AutoCorrect.prepare "git-annex" (fromJust subcommandname) cmdname (NE.fromList cmds)
 		name
 			| fuzzy = case cmds of
 				(c:_) -> Just (cmdname c)

Git/AutoCorrect.hs

@@ -1,11 +1,11 @@
 {- 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.
  -}
 
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
 
 module Git.AutoCorrect where
 
@@ -16,6 +16,7 @@ import qualified Git.Config
 import Text.EditDistance
 import Control.Concurrent
 import qualified Data.List.NonEmpty as NE
+import Data.Char
 
 {- These are the same cost values as used in git. -}
 gitEditCosts :: EditCosts
@@ -45,30 +46,46 @@ fuzzymatches input showchoice choices = fst $ unzip $
 {- Takes action based on git's autocorrect configuration, in preparation for
  - an autocorrected command being run.
  -}
-prepare :: String -> (c -> String) -> NE.NonEmpty c -> Maybe Repo -> IO ()
-prepare input showmatch matches r =
-	case readish . fromConfigValue . Git.Config.get "help.autocorrect" "0" =<< r of
+prepare :: String -> String -> (c -> String) -> NE.NonEmpty c -> Maybe Repo -> IO ()
+prepare cmdname input showmatch matches r =
+	case readish . getcfg =<< r of
 		Just n
 			| n == 0 -> list
 			| n < 0 -> warn Nothing
 			| otherwise -> sleep n
-		Nothing -> list
+		Nothing -> case getcfg <$> r of
+			Just "prompt" -> prompt
+			_ -> list
   where
+	getcfg = fromConfigValue . Git.Config.get "help.autocorrect" "0"
+	
 	list = giveup $ unlines $
 		[ "Unknown command '" ++ input ++ "'"
 		, ""
 		, "Did you mean one of these?"
 		] ++ map (\m -> "\t" ++ showmatch m) (NE.toList matches)
+
 	warn :: Maybe Float -> IO ()
 	warn mdelaysec = hPutStr stderr $ unlines
-		[ "WARNING: You called a git-annex command named '" ++
-		  input ++ "', which does not exist."
+		[ warning
 		, case mdelaysec of
-			Nothing -> "Continuing under the assumption that you meant " ++ match
-			Just sec -> "Continuing in " ++ show sec ++ " seconds, assuming 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 ++ "."
 		]
-	  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
 		warn (Just (fromIntegral n / 10 :: Float))
 		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)