summaryrefslogtreecommitdiff
path: root/CmdLine.hs
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 /CmdLine.hs
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 'CmdLine.hs')
-rw-r--r--CmdLine.hs51
1 files changed, 34 insertions, 17 deletions
diff --git a/CmdLine.hs b/CmdLine.hs
index 05f7bfe2e..5330f40fc 100644
--- a/CmdLine.hs
+++ b/CmdLine.hs
@@ -1,6 +1,6 @@
{- git-annex command line parsing and dispatch
-
- - Copyright 2010 Joey Hess <joey@kitenet.net>
+ - Copyright 2010-2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -21,6 +21,7 @@ import qualified Annex
import qualified Annex.Queue
import qualified Git
import qualified Git.Command
+import qualified Git.AutoCorrect
import Annex.Content
import Annex.Ssh
import Command
@@ -29,8 +30,8 @@ type Params = [String]
type Flags = [Annex ()]
{- Runs the passed command line. -}
-dispatch :: Params -> [Command] -> [Option] -> String -> IO Git.Repo -> IO ()
-dispatch args cmds commonoptions header getgitrepo = do
+dispatch :: Bool -> Params -> [Command] -> [Option] -> String -> IO Git.Repo -> IO ()
+dispatch fuzzyok allargs allcmds commonoptions header getgitrepo = do
setupConsole
r <- E.try getgitrepo :: IO (Either E.SomeException Git.Repo)
case r of
@@ -38,30 +39,46 @@ dispatch args cmds commonoptions header getgitrepo = do
Right g -> do
state <- Annex.new g
(actions, state') <- Annex.run state $ do
+ checkfuzzy
sequence_ flags
prepCommand cmd params
- tryRun state' cmd $ [startup] ++ actions ++ [shutdown $ cmdoneshot cmd]
+ tryRun state' cmd $ [startup] ++ actions ++ [shutdown $ cmdoneshot cmd]
where
- (flags, cmd, params) = parseCmd args cmds commonoptions header
+ err msg = msg ++ "\n\n" ++ usage header allcmds commonoptions
+ cmd = Prelude.head cmds
+ (cmds, name, args) = findCmd fuzzyok allargs allcmds err
+ (flags, params) = getOptCmd args cmd commonoptions err
+ checkfuzzy = when (length cmds > 1) $
+ inRepo $ Git.AutoCorrect.prepare name cmdname cmds
-{- Parses command line, and returns actions to run to configure flags,
- - the Command being run, and the remaining parameters for the command. -}
-parseCmd :: Params -> [Command] -> [Option] -> String -> (Flags, Command, Params)
-parseCmd argv cmds commonoptions header
- | isNothing name = err "missing command"
- | null matches = err $ "unknown command " ++ fromJust name
- | otherwise = check $ getOpt Permute (commonoptions ++ cmdoptions cmd) args
+{- Parses command line params far enough to find the Command to run, and
+ - returns the remaining params.
+ - Does fuzzy matching if necessary, which may result in multiple Commands. -}
+findCmd :: Bool -> Params -> [Command] -> (String -> String) -> ([Command], String, Params)
+findCmd fuzzyok argv cmds err
+ | isNothing name = error $ err "missing command"
+ | not (null exactcmds) = (exactcmds, fromJust name, args)
+ | fuzzyok && not (null inexactcmds) = (inexactcmds, fromJust name, args)
+ | otherwise = error $ err $ "unknown command " ++ fromJust name
where
(name, args) = findname argv []
findname [] c = (Nothing, reverse c)
findname (a:as) c
| "-" `isPrefixOf` a = findname as (a:c)
| otherwise = (Just a, reverse c ++ as)
- matches = filter (\c -> name == Just (cmdname c)) cmds
- cmd = Prelude.head matches
- check (flags, rest, []) = (flags, cmd, rest)
- check (_, _, errs) = err $ concat errs
- err msg = error $ msg ++ "\n\n" ++ usage header cmds commonoptions
+ exactcmds = filter (\c -> name == Just (cmdname c)) cmds
+ inexactcmds = case name of
+ Nothing -> []
+ Just n -> Git.AutoCorrect.fuzzymatches n cmdname cmds
+
+{- Parses command line options, and returns actions to run to configure flags
+ - and the remaining parameters for the command. -}
+getOptCmd :: Params -> Command -> [Option] -> (String -> String) -> (Flags, Params)
+getOptCmd argv cmd commonoptions err = check $
+ getOpt Permute (commonoptions ++ cmdoptions cmd) argv
+ where
+ check (flags, rest, []) = (flags, rest)
+ check (_, _, errs) = error $ err $ concat errs
{- Runs a list of Annex actions. Catches IO errors and continues
- (but explicitly thrown errors terminate the whole command).