summaryrefslogtreecommitdiff
path: root/Git
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-04-12 15:34:41 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-04-12 15:37:21 -0400
commit52a158a7c6b9b7df93db30dfc802c8c350524951 (patch)
tree4dbe0e83577937cf36bd893f574a2c12046cdaf5 /Git
parentfa45175210319bfe771b15c539cf39905eb1a3c1 (diff)
autocorrection
git-annex (but not git-annex-shell) supports the git help.autocorrect configuration setting, doing fuzzy matching using the restricted Damerau-Levenshtein edit distance, just as git does. This adds a build dependency on the haskell edit-distance library.
Diffstat (limited to 'Git')
-rw-r--r--Git/AutoCorrect.hs71
1 files changed, 71 insertions, 0 deletions
diff --git a/Git/AutoCorrect.hs b/Git/AutoCorrect.hs
new file mode 100644
index 000000000..a18bf5619
--- /dev/null
+++ b/Git/AutoCorrect.hs
@@ -0,0 +1,71 @@
+{- git autocorrection using Damerau-Levenshtein edit distance
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Git.AutoCorrect where
+
+import Common
+import Git.Types
+import qualified Git.Config
+
+import Text.EditDistance
+import Control.Concurrent
+
+{- These are the same cost values as used in git. -}
+gitEditCosts :: EditCosts
+gitEditCosts = EditCosts
+ { deletionCosts = ConstantCost 4
+ , insertionCosts = ConstantCost 1
+ , substitutionCosts = ConstantCost 2
+ , transpositionCosts = ConstantCost 0
+ }
+
+{- Git's source calls this "an empirically derived magic number" -}
+similarityFloor :: Int
+similarityFloor = 7
+
+{- Finds inexact matches for the input amoung the choices.
+ - Returns an ordered list of good enough matches, or an empty list if
+ - nothing matches well. -}
+fuzzymatches :: String -> (c -> String) -> [c] -> [c]
+fuzzymatches input showchoice choices = fst $ unzip $
+ sortBy comparecost $ filter similarEnough $ zip choices costs
+ where
+ distance v = restrictedDamerauLevenshteinDistance gitEditCosts v input
+ costs = map (distance . showchoice) choices
+ comparecost a b = compare (snd a) (snd b)
+ similarEnough (_, cst) = cst < similarityFloor
+
+{- Takes action based on git's autocorrect configuration, in preparation for
+ - an autocorrected command being run. -}
+prepare :: String -> (c -> String) -> [c] -> Repo -> IO ()
+prepare input showmatch matches r =
+ case readish $ Git.Config.get "help.autocorrect" "0" r of
+ Just n
+ | n == 0 -> list
+ | n < 0 -> warn
+ | otherwise -> sleep n
+ Nothing -> list
+ where
+ list = error $ unlines $
+ [ "Unknown command '" ++ input ++ "'"
+ , ""
+ , "Did you mean one of these?"
+ ] ++ map (\m -> "\t" ++ showmatch m) matches
+ warn =
+ hPutStr stderr $ unlines
+ [ "WARNING: You called a command named '" ++
+ input ++ "', which does not exist."
+ , "Continuing under the assumption that you meant '" ++
+ showmatch (Prelude.head matches) ++ "'"
+ ]
+ sleep n = do
+ warn
+ hPutStrLn stderr $ unwords
+ [ "in"
+ , show (fromIntegral n / 10 :: Float)
+ , "seconds automatically..."]
+ threadDelay (n * 100000) -- deciseconds to microseconds