another part of add-on command detection that was missed
This commit is contained in:
		
							parent
							
								
									dc43ca2d00
								
							
						
					
					
						commit
						17fbc9de14
					
				| @ -67,24 +67,27 @@ main = do | ||||
|   opts <- getHledgerCliOpts addons | ||||
|   when (debug_ opts) $ printf "%s\n" progversion >> printf "opts: %s\n" (show opts) | ||||
|   run' opts addons args | ||||
|     where  | ||||
|       cmd = command_ opts | ||||
|       run' opts | ||||
|           | null cmd                                       = printModeHelpAndExit mainmode | ||||
|           | any (cmd `isPrefixOf`) ["accounts","balance"]  = showModeHelpOr accountsmode $ withJournalDo opts balance | ||||
|           | any (cmd `isPrefixOf`) ["activity","histogram"] = showModeHelpOr activitymode $ withJournalDo opts histogram | ||||
|           | cmd `isPrefixOf` "add"                         = showModeHelpOr addmode $ withJournalDo opts add | ||||
|           | cmd `isPrefixOf` "convert"                     = showModeHelpOr convertmode $ withJournalDo opts convert | ||||
|           | any (cmd `isPrefixOf`) ["entries","print"]     = showModeHelpOr entriesmode $ withJournalDo opts print' | ||||
|           | any (cmd `isPrefixOf`) ["postings","register"] = showModeHelpOr postingsmode $ withJournalDo opts register | ||||
|           | cmd `isPrefixOf` "stats"                       = showModeHelpOr statsmode $ withJournalDo opts stats | ||||
|           | cmd `isPrefixOf` "test"                        = showModeHelpOr testmode $ runtests opts >> return () | ||||
|           | cmd `isPrefixOf` "binaryfilename"              = showModeHelpOr binaryfilenamemode $ putStrLn $ binaryfilename progname | ||||
|           | otherwise                                      = showModeHelpOr mainmode $ optserror $ "command "++cmd++" is not recognized" | ||||
|       showModeHelpOr mode f = do | ||||
|         when ("help" `in_` (rawopts_ opts)) $ printModeHelpAndExit mode | ||||
|         when ("version" `in_` (rawopts_ opts)) $ printVersionAndExit | ||||
|         f | ||||
|     where | ||||
|       run' opts@CliOpts{command_=cmd} addons args | ||||
|        | "version" `in_` (rawopts_ opts)                 = putStrLn progversion | ||||
|        | "binary-filename" `in_` (rawopts_ opts)         = putStrLn $ binaryfilename progname | ||||
|        | null cmd                                        = putStr $ showModeHelp mainmode' | ||||
|        | cmd `isPrefixOf` "add"                          = showModeHelpOr addmode      $ withJournalDo opts add | ||||
|        | cmd `isPrefixOf` "convert"                      = showModeHelpOr convertmode  $ convert opts | ||||
|        | cmd `isPrefixOf` "test"                         = showModeHelpOr testmode     $ runtests opts | ||||
|        | any (cmd `isPrefixOf`) ["accounts","balance"]   = showModeHelpOr accountsmode $ withJournalDo opts balance | ||||
|        | any (cmd `isPrefixOf`) ["entries","print"]      = showModeHelpOr entriesmode  $ withJournalDo opts print' | ||||
|        | any (cmd `isPrefixOf`) ["postings","register"]  = showModeHelpOr postingsmode $ withJournalDo opts register | ||||
|        | any (cmd `isPrefixOf`) ["activity","histogram"] = showModeHelpOr activitymode $ withJournalDo opts histogram | ||||
|        | cmd `isPrefixOf` "stats"                        = showModeHelpOr statsmode    $ withJournalDo opts stats | ||||
|        | not (null matchedaddon)                           = system shellcmd >>= exitWith | ||||
|        | otherwise                                       = optserror ("command "++cmd++" is not recognized") >> exitFailure | ||||
|        where | ||||
|         mainmode' = mainmode addons | ||||
|         showModeHelpOr mode f | "help" `in_` (rawopts_ opts) = putStr $ showModeHelp mode | ||||
|                               | otherwise = f | ||||
|         matchedaddon = headDef "" $ filter (cmd `isPrefixOf`) addons | ||||
|         shellcmd = printf "%s-%s %s" progname matchedaddon (unwords' args) | ||||
| 
 | ||||
| {- tests: | ||||
| 
 | ||||
|  | ||||
| @ -326,7 +326,7 @@ toCliOpts rawopts = do | ||||
| getHledgerCliOpts :: [String] -> IO CliOpts | ||||
| getHledgerCliOpts addons = do | ||||
|   args <- getArgs | ||||
|   toCliOpts (decodeRawOpts $ processValue (mainmode addons) $ tempMoveFlagsAfterCommand args) >>= checkCliOpts | ||||
|   toCliOpts (decodeRawOpts $ processValue (mainmode addons) $ moveFileOption args) >>= checkCliOpts | ||||
| 
 | ||||
| -- utils | ||||
| 
 | ||||
| @ -352,11 +352,12 @@ getDirectoryContentsSafe d = getDirectoryContents d `catch` (\_ -> return []) | ||||
| -- | Convert possibly encoded option values to regular unicode strings. | ||||
| decodeRawOpts = map (\(name,val) -> (name, fromPlatformString val)) | ||||
| 
 | ||||
| -- workaround for http://code.google.com/p/ndmitchell/issues/detail?id=457 | ||||
| -- just handles commonest case, -f option before command | ||||
| tempMoveFlagsAfterCommand (fflagandval@('-':'f':_:_):cmd:rest) = cmd:fflagandval:rest | ||||
| tempMoveFlagsAfterCommand ("-f":fval:cmd:rest) = cmd:"-f":fval:rest | ||||
| tempMoveFlagsAfterCommand as = as | ||||
| -- A workaround related to http://code.google.com/p/ndmitchell/issues/detail?id=457 : | ||||
| -- we'd like to permit options before COMMAND as well as after it. Here we | ||||
| -- make sure at least -f FILE will be accepted in either position. | ||||
| moveFileOption (fopt@('-':'f':_:_):cmd:rest) = cmd:fopt:rest | ||||
| moveFileOption ("-f":fval:cmd:rest) = cmd:"-f":fval:rest | ||||
| moveFileOption as = as | ||||
| 
 | ||||
| optserror = error' . (++ " (run with --help for usage)") | ||||
| 
 | ||||
| @ -448,12 +449,8 @@ aliasesFromOpts = map parseAlias . alias_ | ||||
|             alias' = case alias of ('=':rest) -> rest | ||||
|                                    _ -> orig | ||||
| 
 | ||||
| printModeHelpAndExit mode = putStr (showModeHelp mode) >> exitSuccess | ||||
| 
 | ||||
| showModeHelp = showText defaultWrap . helpText HelpFormatDefault | ||||
| 
 | ||||
| printVersionAndExit = putStrLn progversion >> exitSuccess | ||||
| 
 | ||||
| tests_Hledger_Cli_Options = TestList | ||||
|  [ | ||||
|  ] | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user