Support help.autocorrect=prompt

diff --git a/CHANGELOG b/CHANGELOG
index d921df7d83df8d2bab645564e78b05ac806e003f..84f4872caaa9145d2ac02f3b31ab844f7aa67646 100644 (file)
--- a/CHANGELOG
+++ b/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 

diff --git a/CmdLine.hs b/CmdLine.hs
index 0b80c47dd4f815bd33e275e28770b1d1c9dd343d..f432452e4344724a0b1e2b817138eaf8b552655b 100644 (file)
--- a/CmdLine.hs
+++ b/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)

diff --git a/Git/AutoCorrect.hs b/Git/AutoCorrect.hs
index 3bd3fff5848460aab76079d827dd3d0161ce3bf7..111cec4b6651edcfb913617d8cdd68e54a1109c6 100644 (file)
--- a/Git/AutoCorrect.hs
+++ b/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)