From 631c449e0c695e1b1b3b26140fbdcb8f5fcf6a1a Mon Sep 17 00:00:00 2001
From: Nikolay Yakimov <root@livid.pp.ru>
Date: Sun, 20 Dec 2015 14:30:30 +0300
Subject: [PATCH] Interactive help and better error reporting

---
 src/GHCMod.hs                  |  3 ++-
 src/GHCMod/Options.hs          |  8 ++++++--
 src/GHCMod/Options/Commands.hs | 17 ++++++++++-------
 3 files changed, 18 insertions(+), 10 deletions(-)

diff --git a/src/GHCMod.hs b/src/GHCMod.hs
index 5061241..4b239e7 100644
--- a/src/GHCMod.hs
+++ b/src/GHCMod.hs
@@ -107,7 +107,7 @@ legacyInteractiveLoop symdbreq world = do
     when changed dropSession
 
     res <- flip gcatches interactiveHandlers $ do
-      pargs <- maybe (throw $ InvalidCommandLine $ Left cmdArg) return
+      pargs <- either (throw . InvalidCommandLine . Right) return
               $ parseArgsInteractive cmdArg
       case pargs of
         CmdFind symbol ->
@@ -131,6 +131,7 @@ legacyInteractiveLoop symdbreq world = do
           [ GHandler $ \e@(FatalError _) -> throw e
           , GHandler $ \e@(ExitSuccess) -> throw e
           , GHandler $ \e@(ExitFailure _) -> throw e
+          , GHandler $ \(InvalidCommandLine (Right e)) -> gmErrStrLn e >> return ""
           , GHandler $ \(SomeException e) -> gmErrStrLn (show e) >> return ""
           ]
 
diff --git a/src/GHCMod/Options.hs b/src/GHCMod/Options.hs
index 625d319..6c6d789 100644
--- a/src/GHCMod/Options.hs
+++ b/src/GHCMod/Options.hs
@@ -40,11 +40,15 @@ parseArgs =
            $$  fullDesc
            <=> header "ghc-mod: Happy Haskell Programming"
 
-parseArgsInteractive :: String -> Maybe GhcModCommands
+parseArgsInteractive :: String -> Either String GhcModCommands
 parseArgsInteractive args =
-  getParseResult $ execParserPure (prefs idm) opts $ parseCmdLine args
+  handle $ execParserPure (prefs idm) opts $ parseCmdLine args
   where
     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 =
diff --git a/src/GHCMod/Options/Commands.hs b/src/GHCMod/Options/Commands.hs
index 0a6adb7..b8c40a1 100644
--- a/src/GHCMod/Options/Commands.hs
+++ b/src/GHCMod/Options/Commands.hs
@@ -184,16 +184,16 @@ commands =
 
 interactiveCommandsSpec :: Parser GhcModCommands
 interactiveCommandsSpec =
-    subparser'
+    hsubparser'
         $  commands
         <> command "map-file"
-              $$  info (helper <*> mapArgSpec)
+              $$  info mapArgSpec
               $$  progDesc "tells ghc-modi to read `file.hs` source from stdin"
               <=> desc $$$ do
                 "Works the same as second form of"
                   \\ "`--map-file` CLI option."
         <> command "unmap-file"
-              $$  info (helper <*> unmapArgSpec)
+              $$  info unmapArgSpec
               $$  progDesc' $$$ do
                     "unloads previously mapped file,"
                       \\ "so that it's no longer mapped."
@@ -272,11 +272,14 @@ unmapArgSpec = CmdUnmapFile <$> strArg "FILE"
 legacyInteractiveArgSpec = const CmdLegacyInteractive <$>
   optional interactiveCommandsSpec
 
-subparser' :: Mod CommandFields a -> Parser a
-subparser' m = mkParser d g rdr
+hsubparser' :: Mod CommandFields a -> Parser a
+hsubparser' m = mkParser d g rdr
   where
-    Mod _ d g = metavar "" `mappend` m
-    rdr = uncurry CmdReader (mkCommand m)
+    Mod _ d g = m `mappend` metavar ""
+    (cmds, subs) = mkCommand m
+    rdr = CmdReader cmds (fmap add_helper . subs)
+    add_helper pinfo = pinfo
+      { infoParser = infoParser pinfo <**> helper }
 
 int :: ReadM Int
 int = do