diff options
| -rw-r--r-- | CmdLine.hs | 45 | ||||
| -rw-r--r-- | CmdLine/GitAnnex.hs | 11 | ||||
| -rw-r--r-- | CmdLine/GitAnnexShell.hs | 4 | ||||
| -rw-r--r-- | CmdLine/Usage.hs | 8 | ||||
| -rw-r--r-- | Command/Help.hs | 4 |
5 files changed, 42 insertions, 30 deletions
diff --git a/CmdLine.hs b/CmdLine.hs index b4e0ea044..5114bc984 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -14,6 +14,7 @@ module CmdLine ( ) where import qualified Options.Applicative as O +import qualified Options.Applicative.Help as H import qualified Control.Exception as E import qualified Data.Map as M import Control.Exception (throw) @@ -32,8 +33,8 @@ import Command import Types.Messages {- Runs the passed command line. -} -dispatch :: Bool -> CmdParams -> [Command] -> [Option] -> [(String, String)] -> String -> IO Git.Repo -> IO () -dispatch fuzzyok allargs allcmds commonoptions fields header getgitrepo = do +dispatch :: Bool -> CmdParams -> [Command] -> [Option] -> [(String, String)] -> IO Git.Repo -> String -> String -> IO () +dispatch fuzzyok allargs allcmds commonoptions fields getgitrepo progname progdesc = do setupConsole go =<< (E.try getgitrepo :: IO (Either E.SomeException Git.Repo)) where @@ -59,46 +60,52 @@ dispatch fuzzyok allargs allcmds commonoptions fields header getgitrepo = do a parsewith getparser ingitrepo = - case parseCmd allargs allcmds getparser of + case parseCmd progname progdesc allargs allcmds getparser of O.Failure _ -> do -- parse failed, so fall back to -- fuzzy matching, or to showing usage when fuzzy $ ingitrepo autocorrect - liftIO (O.handleParseResult (parseCmd (name:args) allcmds getparser)) + liftIO (O.handleParseResult (parseCmd progname progdesc correctedargs allcmds getparser)) res -> liftIO (O.handleParseResult res) where - autocorrect = Git.AutoCorrect.prepare inputcmdname cmdname cmds - err msg = msg ++ "\n\n" ++ usage header allcmds - (fuzzy, cmds, inputcmdname, args) = findCmd fuzzyok allargs allcmds err + autocorrect = Git.AutoCorrect.prepare (fromJust inputcmdname) cmdname cmds + (fuzzy, cmds, inputcmdname, args) = findCmd fuzzyok allargs allcmds name | fuzzy = case cmds of - (c:_) -> cmdname c + (c:_) -> Just (cmdname c) _ -> inputcmdname | otherwise = inputcmdname + correctedargs = case name of + Nothing -> allargs + Just n -> n:args {- Parses command line, selecting one of the commands from the list. -} -parseCmd :: CmdParams -> [Command] -> (Command -> O.Parser v) -> O.ParserResult (Command, v) -parseCmd allargs allcmds getparser = O.execParserPure (O.prefs O.idm) pinfo allargs +parseCmd :: String -> String -> CmdParams -> [Command] -> (Command -> O.Parser v) -> O.ParserResult (Command, v) +parseCmd progname progdesc allargs allcmds getparser = O.execParserPure (O.prefs O.idm) pinfo allargs where - pinfo = O.info (O.helper <*> subcmds) O.fullDesc + pinfo = O.info (O.helper <*> subcmds) (O.progDescDoc (Just intro)) subcmds = O.hsubparser $ mconcat $ map mkcommand allcmds - mkcommand c = O.command (cmdname c) $ O.info (mkparser c) - (O.fullDesc <> O.header (cmddesc c) <> O.progDesc (cmddesc c)) + mkcommand c = O.command (cmdname c) $ O.info (mkparser c) $ O.fullDesc + <> O.header (synopsis (progname ++ " " ++ cmdname c) (cmddesc c)) + <> O.footer ("For details, run: " ++ progname ++ " help " ++ cmdname c) mkparser c = (,) <$> pure c <*> getparser c + synopsis n d = n ++ " - " ++ d + intro = mconcat $ concatMap (\l -> [H.text l, H.line]) + (synopsis progname progdesc : commandList allcmds) {- 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 -> CmdParams -> [Command] -> (String -> String) -> (Bool, [Command], String, CmdParams) -findCmd fuzzyok argv cmds err - | isNothing name = error $ err "missing command" - | not (null exactcmds) = (False, exactcmds, fromJust name, args) - | fuzzyok && not (null inexactcmds) = (True, inexactcmds, fromJust name, args) - | otherwise = error $ err $ "unknown command " ++ fromJust name +findCmd :: Bool -> CmdParams -> [Command] -> (Bool, [Command], Maybe String, CmdParams) +findCmd fuzzyok argv cmds + | not (null exactcmds) = ret (False, exactcmds) + | fuzzyok && not (null inexactcmds) = ret (True, inexactcmds) + | otherwise = ret (False, []) where + ret (fuzzy, matches) = (fuzzy, matches, name, args) (name, args) = findname argv [] findname [] c = (Nothing, reverse c) findname (a:as) c diff --git a/CmdLine/GitAnnex.hs b/CmdLine/GitAnnex.hs index 80ee876ff..5e37a885a 100644 --- a/CmdLine/GitAnnex.hs +++ b/CmdLine/GitAnnex.hs @@ -19,6 +19,7 @@ import qualified Command.Add import qualified Command.Unannex import qualified Command.Fsck {- +import qualified Command.Help import qualified Command.Drop import qualified Command.Move import qualified Command.Copy @@ -97,7 +98,6 @@ import qualified Command.Proxy import qualified Command.DiffDriver import qualified Command.Undo import qualified Command.Version -import qualified Command.Help #ifdef WITH_ASSISTANT import qualified Command.Watch import qualified Command.Assistant @@ -124,6 +124,7 @@ cmds = [ Command.Add.cmd , Command.Fsck.cmd {- + , Command.Help.cmd , Command.Get.cmd , Command.Drop.cmd , Command.Move.cmd @@ -204,7 +205,6 @@ cmds = , Command.DiffDriver.cmd , Command.Undo.cmd , Command.Version.cmd - , Command.Help.cmd #ifdef WITH_ASSISTANT , Command.Watch.cmd , Command.Assistant.cmd @@ -224,9 +224,6 @@ cmds = -} ] -header :: String -header = "git-annex command [option ...]" - run :: [String] -> IO () run args = do #ifdef WITH_EKG @@ -234,7 +231,9 @@ run args = do #endif go envmodes where - go [] = dispatch True args cmds gitAnnexOptions [] header Git.CurrentRepo.get + go [] = dispatch True args cmds gitAnnexOptions [] Git.CurrentRepo.get + "git-annex" + "manage files with git, without checking their contents in" go ((v, a):rest) = maybe (go rest) a =<< getEnv v envmodes = [ (sshOptionsEnv, runSshOptions args) diff --git a/CmdLine/GitAnnexShell.hs b/CmdLine/GitAnnexShell.hs index fca37790b..bda4f7907 100644 --- a/CmdLine/GitAnnexShell.hs +++ b/CmdLine/GitAnnexShell.hs @@ -101,7 +101,9 @@ builtin cmd dir params = do let (params', fieldparams, opts) = partitionParams params rsyncopts = ("RsyncOptions", unwords opts) fields = rsyncopts : filter checkField (parseFields fieldparams) - dispatch False (cmd : params') cmds options fields header mkrepo + dispatch False (cmd : params') cmds options fields mkrepo + "git-annex-shell" + "Restricted login shell for git-annex only SSH access" where mkrepo = do r <- Git.Construct.repoAbsPath dir >>= Git.Construct.fromAbsPath diff --git a/CmdLine/Usage.hs b/CmdLine/Usage.hs index 0b1cade05..a6cc90a71 100644 --- a/CmdLine/Usage.hs +++ b/CmdLine/Usage.hs @@ -13,9 +13,12 @@ import Types.Command usageMessage :: String -> String usageMessage s = "Usage: " ++ s -{- Usage message with lists of commands by section. -} usage :: String -> [Command] -> String -usage header cmds = unlines $ usageMessage header : concatMap go [minBound..] +usage header cmds = unlines $ usageMessage header : commandList cmds + +{- Commands listed by section, with breif usage and description. -} +commandList :: [Command] -> [String] +commandList cmds = concatMap go [minBound..] where go section | null cs = [] @@ -39,6 +42,7 @@ usage header cmds = unlines $ usageMessage header : concatMap go [minBound..] longest f = foldl max 0 $ map (length . f) cmds scmds = sort cmds + {- Descriptions of params used in usage messages. -} paramPaths :: String paramPaths = paramRepeating paramPath -- most often used diff --git a/Command/Help.hs b/Command/Help.hs index 0da7ecc46..a44dcb234 100644 --- a/Command/Help.hs +++ b/Command/Help.hs @@ -56,8 +56,8 @@ showGeneralHelp = putStrLn $ unlines , Command.Whereis.cmd , Command.Fsck.cmd ] - , "Run 'git-annex' for a complete command list." - , "Run 'git-annex help command' for help on a specific command." + , "For a complete command list, run: git-annex" + , "For help on a specific command, run: git-annex help COMMAND" ] where cmdline c = "\t" ++ cmdname c ++ "\t" ++ cmddesc c |