From 23416e9aebb900d14e869175c0ffd6882682cc18 Mon Sep 17 00:00:00 2001
From: Nikolay Yakimov <root@livid.pp.ru>
Date: Sun, 20 Dec 2015 15:02:31 +0300
Subject: [PATCH] Better error reporting, cleanup

---
 Language/Haskell/GhcMod/Types.hs |  4 +--
 src/GHCMod.hs                    | 60 +++++---------------------------
 src/GHCMod/Options/Commands.hs   |  1 +
 3 files changed, 11 insertions(+), 54 deletions(-)

diff --git a/Language/Haskell/GhcMod/Types.hs b/Language/Haskell/GhcMod/Types.hs
index b22964e..40a8a83 100644
--- a/Language/Haskell/GhcMod/Types.hs
+++ b/Language/Haskell/GhcMod/Types.hs
@@ -374,7 +374,7 @@ instance Binary ChEntrypoint where
 data LintOpts = LintOpts {
         optLintHlintOpts :: [String]
         -- ^ options that will be passed to hlint executable
-      }
+      } deriving (Show)
 
 -- | Default "LintOpts" instance
 defaultLintOpts :: LintOpts
@@ -388,7 +388,7 @@ data BrowseOpts = BrowseOpts {
         -- ^ If 'True', "browseWith" also returns types.
       , optBrowseQualified      :: Bool
         -- ^ If 'True', "browseWith" will return fully qualified name
-    }
+    } deriving (Show)
 
 -- | Default "BrowseOpts" instance
 defaultBrowseOpts :: BrowseOpts
diff --git a/src/GHCMod.hs b/src/GHCMod.hs
index 4b239e7..26ca14f 100644
--- a/src/GHCMod.hs
+++ b/src/GHCMod.hs
@@ -2,13 +2,9 @@
 
 module Main where
 
-import Control.Category
-import Control.Applicative
 import Control.Monad
 import Data.Typeable (Typeable)
 import Data.List
-import Data.List.Split
-import Data.Maybe
 import Exception
 import Language.Haskell.GhcMod
 import Language.Haskell.GhcMod.Internal hiding (MonadIO,liftIO)
@@ -20,7 +16,6 @@ import System.Directory (setCurrentDirectory, getAppUserDataDirectory,
 import System.IO
 import System.Exit
 import Text.PrettyPrint hiding ((<>))
-import Prelude hiding ((.))
 import GHCMod.Options
 
 import Misc
@@ -30,23 +25,9 @@ ghcModStyle = style { lineLength = 80, ribbonsPerLine = 1.2 }
 
 ----------------------------------------------------------------
 
-data CmdError = UnknownCommand String
-              | NoSuchFileError String
-              | LibraryError GhcModError
-
-                deriving (Show, Typeable)
-
-instance Exception CmdError
-
-data InteractiveOptions = InteractiveOptions {
-      ghcModExtensions :: Bool
-    }
-
 handler :: IOish m => GhcModT m a -> GhcModT m a
-handler = flip gcatches $
-          [ GHandler $ \(FatalError msg) -> exitError msg
-          , GHandler $ \e@(ExitSuccess) -> throw e
-          , GHandler $ \e@(ExitFailure _) -> throw e
+handler = flip gcatches
+          [ GHandler $ \(e :: ExitCode) -> throw e
           , GHandler $ \(SomeException e) -> exitError $ "ghc-mod: " ++ show e
           ]
 
@@ -74,20 +55,6 @@ legacyInteractive = do
     world <- getCurrentWorld
     legacyInteractiveLoop symdbreq world
 
-bug :: IOish m => String -> GhcModT m ()
-bug msg = do
-  gmPutStrLn $ notGood $ "BUG: " ++ msg
-  liftIO exitFailure
-
-notGood :: String -> String
-notGood msg = "NG " ++ escapeNewlines msg
-
-escapeNewlines :: String -> String
-escapeNewlines = replace "\n" "\\n" . replace "\\n" "\\\\n"
-
-replace :: String -> String -> String -> String
-replace needle replacement = intercalate replacement . splitOn needle
-
 legacyInteractiveLoop :: IOish m
                       => SymDbReq -> World -> GhcModT m ()
 legacyInteractiveLoop symdbreq world = do
@@ -128,10 +95,10 @@ legacyInteractiveLoop symdbreq world = do
     legacyInteractiveLoop symdbreq world'
  where
     interactiveHandlers =
-          [ GHandler $ \e@(FatalError _) -> throw e
-          , GHandler $ \e@(ExitSuccess) -> throw e
-          , GHandler $ \e@(ExitFailure _) -> throw e
-          , GHandler $ \(InvalidCommandLine (Right e)) -> gmErrStrLn e >> return ""
+          [ GHandler $ \(e :: ExitCode) -> throw e
+          , GHandler $ \(InvalidCommandLine e) -> do
+              gmErrStrLn $ either ("Invalid command line: "++) Prelude.id e
+              return ""
           , GHandler $ \(SomeException e) -> gmErrStrLn (show e) >> return ""
           ]
 
@@ -149,7 +116,7 @@ getFileSourceFromStdin = do
 -- Someone please already rewrite the cmdline parsing code *weep* :'(
 wrapGhcCommands :: (IOish m, GmOut m) => Options -> GhcModCommands -> m ()
 wrapGhcCommands _opts CmdRoot = gmPutStr =<< rootInfo
-wrapGhcCommands opts cmd = do
+wrapGhcCommands opts cmd =
     handleGmError $ runGhcModT opts $ handler $ do
       forM_ (reverse $ optFileMappings opts) $
         uncurry loadMMappedFiles
@@ -194,10 +161,7 @@ ghcCommands (CmdSplit file (line, col)) = splits file line col
 ghcCommands (CmdSig file (line, col)) = sig file line col
 ghcCommands (CmdAuto file (line, col)) = auto file line col
 ghcCommands (CmdRefine file (line, col) expr) = refine file line col $ Expression expr
-ghcCommands _ = fatalError "Unknown command"
-
-newtype FatalError = FatalError String deriving (Show, Typeable)
-instance Exception FatalError
+ghcCommands cmd = throw $ InvalidCommandLine $ Left $ show cmd
 
 newtype InvalidCommandLine = InvalidCommandLine (Either String String)
     deriving (Show, Typeable)
@@ -206,14 +170,6 @@ instance Exception InvalidCommandLine
 exitError :: (MonadIO m, GmOut m) => String -> m a
 exitError msg = gmErrStrLn (dropWhileEnd (=='\n') msg) >> liftIO exitFailure
 
-fatalError :: String -> a
-fatalError s = throw $ FatalError $ "ghc-mod: " ++ s
-
-catchArgs :: (Monad m, ExceptionMonad m) => String -> m a -> m a
-catchArgs cmd action =
-    action `gcatch` \(PatternMatchFail _) ->
-        throw $ InvalidCommandLine (Left cmd)
-
 nukeCaches :: IOish m => GhcModT m ()
 nukeCaches = do
   chdir <- liftIO $ (</> "cabal-helper") <$> getAppUserDataDirectory "ghc-mod"
diff --git a/src/GHCMod/Options/Commands.hs b/src/GHCMod/Options/Commands.hs
index b8c40a1..1026c52 100644
--- a/src/GHCMod/Options/Commands.hs
+++ b/src/GHCMod/Options/Commands.hs
@@ -60,6 +60,7 @@ data GhcModCommands =
   | CmdMapFile FilePath
   | CmdUnmapFile FilePath
   | CmdQuit
+  deriving (Show)
 
 commandsSpec :: Parser GhcModCommands
 commandsSpec =