make usage less terrifying

Need to make `git annex help command` show the options for that command.

CmdLine.hs

@@ -45,7 +45,7 @@ dispatch fuzzyok allargs allcmds commonoptions fields header getgitrepo = do
 				prepCommand cmd params
 		 	tryRun state' cmd $ [startup] ++ actions ++ [shutdown $ cmdnocommit cmd]
   where
-	err msg = msg ++ "\n\n" ++ usage header allcmds commonoptions
+	err msg = msg ++ "\n\n" ++ usage header allcmds
 	cmd = Prelude.head cmds
 	(fuzzy, cmds, name, args) = findCmd fuzzyok allargs allcmds err
 	(flags, params) = getOptCmd args cmd commonoptions err

GitAnnexShell.hs

@@ -126,7 +126,7 @@ checkField (field, value)
 	| otherwise = False
 
 failure :: IO ()
-failure = error $ "bad parameters\n\n" ++ usage header cmds options
+failure = error $ "bad parameters\n\n" ++ usage header cmds
 
 checkNotLimited :: IO ()
 checkNotLimited = checkEnv "GIT_ANNEX_SHELL_LIMITED"

Types/Command.hs

@@ -53,9 +53,9 @@ instance Eq CommandCheck where
 instance Eq Command where
 	a == b = cmdname a == cmdname b
 
-{- Order commands by section and then by name -}
+{- Order commands by name. -}
 instance Ord Command where
-	compare = comparing (\c -> (cmdsection c, cmdname c))
+	compare = comparing cmdname
 
 {- The same sections are listed in doc/git-annex.mdwn -}
 data CommandSection 

Usage.hs

@@ -8,41 +8,29 @@
 module Usage where
 
 import Common.Annex
-import System.Console.GetOpt
 
 import Types.Command
 
-{- Usage message with lists of commands and options. -}
+{- Usage message with lists of commands by section. -}
-usage :: String -> [Command] -> [Option] -> String
+usage :: String -> [Command] -> String
-usage header cmds commonoptions = unlines $ 
+usage header cmds = unlines $ header : concatMap go [minBound..]
-	[ header
-	, ""
-	, "Options:"
-	] ++ optlines ++ cmdlines
   where
-	-- To get consistent indentation of options, generate the
+	go section
-	-- usage for all options at once. A command's options will
+		| null cs = []
-	-- be displayed after the command.
+		| otherwise =
-	alloptlines = filter (not . null) $
+			[ ""
-		lines $ usageInfo "" $
+			, descSection section ++ ":"
-			concatMap cmdoptions scmds ++ commonoptions
+			, ""
-	(cmdlines, optlines) = go Nothing scmds alloptlines []
+			] ++ map cmdline cs
-	go _ [] os ls = (ls, os)
-	go section (c:cs) os ls = go section' cs os' ls'
 	  where
-		ls' = ls++sectionheader++(l:o)
+		cs = filter (\c -> cmdsection c == section) scmds
-		sectionheader
+	cmdline c = concat
-			| section == section' = []
+		[ cmdname c
-			| otherwise = ["", descSection (cmdsection c) ++ ":", ""]
+		, namepad (cmdname c)
-		section' = Just (cmdsection c)
+		, cmdparamdesc c
-		(o, os') = splitAt (length $ cmdoptions c) os
+		, descpad (cmdparamdesc c)
-		l = concat
+		, cmddesc c
-			[ cmdname c
+		]
-			, namepad (cmdname c)
-			, cmdparamdesc c
-			, descpad (cmdparamdesc c)
-			, cmddesc c
-			]
 	pad n s = replicate (n - length s) ' '
 	namepad = pad $ longest cmdname + 1
 	descpad = pad $ longest cmdparamdesc + 2