Interactive help and better error reporting
This commit is contained in:
parent
1c45404f74
commit
631c449e0c
@ -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 ""
|
||||||
]
|
]
|
||||||
|
|
||||||
|
@ -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 =
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user