Interactive help and better error reporting

This commit is contained in:
Nikolay Yakimov 2015-12-20 14:30:30 +03:00
parent 1c45404f74
commit 631c449e0c
3 changed files with 18 additions and 10 deletions

View File

@ -107,7 +107,7 @@ legacyInteractiveLoop symdbreq world = do
when changed dropSession when changed dropSession
res <- flip gcatches interactiveHandlers $ do res <- flip gcatches interactiveHandlers $ do
pargs <- maybe (throw $ InvalidCommandLine $ Left cmdArg) return pargs <- either (throw . InvalidCommandLine . Right) return
$ parseArgsInteractive cmdArg $ parseArgsInteractive cmdArg
case pargs of case pargs of
CmdFind symbol -> CmdFind symbol ->
@ -131,6 +131,7 @@ legacyInteractiveLoop symdbreq world = do
[ GHandler $ \e@(FatalError _) -> throw e [ GHandler $ \e@(FatalError _) -> throw e
, GHandler $ \e@(ExitSuccess) -> throw e , GHandler $ \e@(ExitSuccess) -> throw e
, GHandler $ \e@(ExitFailure _) -> throw e , GHandler $ \e@(ExitFailure _) -> throw e
, GHandler $ \(InvalidCommandLine (Right e)) -> gmErrStrLn e >> return ""
, GHandler $ \(SomeException e) -> gmErrStrLn (show e) >> return "" , GHandler $ \(SomeException e) -> gmErrStrLn (show e) >> return ""
] ]

View File

@ -40,11 +40,15 @@ parseArgs =
$$ fullDesc $$ fullDesc
<=> header "ghc-mod: Happy Haskell Programming" <=> header "ghc-mod: Happy Haskell Programming"
parseArgsInteractive :: String -> Maybe GhcModCommands parseArgsInteractive :: String -> Either String GhcModCommands
parseArgsInteractive args = parseArgsInteractive args =
getParseResult $ execParserPure (prefs idm) opts $ parseCmdLine args handle $ execParserPure (prefs idm) opts $ parseCmdLine args
where where
opts = info interactiveCommandsSpec $$ fullDesc opts = info interactiveCommandsSpec $$ fullDesc
handle (Success a) = Right a
handle (Failure failure) =
Left $ fst $ renderFailure failure ""
handle _ = Left "Completion invoked"
helpVersion :: Parser (a -> a) helpVersion :: Parser (a -> a)
helpVersion = helpVersion =

View File

@ -184,16 +184,16 @@ commands =
interactiveCommandsSpec :: Parser GhcModCommands interactiveCommandsSpec :: Parser GhcModCommands
interactiveCommandsSpec = interactiveCommandsSpec =
subparser' hsubparser'
$ commands $ commands
<> command "map-file" <> command "map-file"
$$ info (helper <*> mapArgSpec) $$ info mapArgSpec
$$ progDesc "tells ghc-modi to read `file.hs` source from stdin" $$ progDesc "tells ghc-modi to read `file.hs` source from stdin"
<=> desc $$$ do <=> desc $$$ do
"Works the same as second form of" "Works the same as second form of"
\\ "`--map-file` CLI option." \\ "`--map-file` CLI option."
<> command "unmap-file" <> command "unmap-file"
$$ info (helper <*> unmapArgSpec) $$ info unmapArgSpec
$$ progDesc' $$$ do $$ progDesc' $$$ do
"unloads previously mapped file," "unloads previously mapped file,"
\\ "so that it's no longer mapped." \\ "so that it's no longer mapped."
@ -272,11 +272,14 @@ unmapArgSpec = CmdUnmapFile <$> strArg "FILE"
legacyInteractiveArgSpec = const CmdLegacyInteractive <$> legacyInteractiveArgSpec = const CmdLegacyInteractive <$>
optional interactiveCommandsSpec optional interactiveCommandsSpec
subparser' :: Mod CommandFields a -> Parser a hsubparser' :: Mod CommandFields a -> Parser a
subparser' m = mkParser d g rdr hsubparser' m = mkParser d g rdr
where where
Mod _ d g = metavar "" `mappend` m Mod _ d g = m `mappend` metavar ""
rdr = uncurry CmdReader (mkCommand m) (cmds, subs) = mkCommand m
rdr = CmdReader cmds (fmap add_helper . subs)
add_helper pinfo = pinfo
{ infoParser = infoParser pinfo <**> helper }
int :: ReadM Int int :: ReadM Int
int = do int = do