summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--CmdLine.hs45
-rw-r--r--CmdLine/GitAnnex.hs11
-rw-r--r--CmdLine/GitAnnexShell.hs4
-rw-r--r--CmdLine/Usage.hs8
-rw-r--r--Command/Help.hs4
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