Remove dedicated exception handling in check completely
				
					
				
			Exceptions are already caught at the top level so this is unnecessary.
This commit is contained in:
		
							parent
							
								
									1b5917c70e
								
							
						
					
					
						commit
						147dd90ee7
					
				| @ -12,7 +12,6 @@ import qualified GHC as G | |||||||
| import Language.Haskell.GhcMod.Logger | import Language.Haskell.GhcMod.Logger | ||||||
| import Language.Haskell.GhcMod.Monad (IOish, GhcModT, overrideGhcUserOptions) | import Language.Haskell.GhcMod.Monad (IOish, GhcModT, overrideGhcUserOptions) | ||||||
| import Language.Haskell.GhcMod.Target (setTargetFiles) | import Language.Haskell.GhcMod.Target (setTargetFiles) | ||||||
| import Language.Haskell.GhcMod.Utils (liftExceptions) |  | ||||||
| 
 | 
 | ||||||
| ---------------------------------------------------------------- | ---------------------------------------------------------------- | ||||||
| 
 | 
 | ||||||
| @ -22,7 +21,7 @@ checkSyntax :: IOish m | |||||||
|             => [FilePath]  -- ^ The target files. |             => [FilePath]  -- ^ The target files. | ||||||
|             -> GhcModT m String |             -> GhcModT m String | ||||||
| checkSyntax []    = return "" | checkSyntax []    = return "" | ||||||
| checkSyntax files = liftExceptions $ either id id <$> check files | checkSyntax files = either id id <$> check files | ||||||
| 
 | 
 | ||||||
| ---------------------------------------------------------------- | ---------------------------------------------------------------- | ||||||
| 
 | 
 | ||||||
| @ -47,7 +46,7 @@ expandTemplate :: IOish m | |||||||
|                => [FilePath]  -- ^ The target files. |                => [FilePath]  -- ^ The target files. | ||||||
|                -> GhcModT m String |                -> GhcModT m String | ||||||
| expandTemplate []    = return "" | expandTemplate []    = return "" | ||||||
| expandTemplate files = liftExceptions $ either id id <$> expand files | expandTemplate files = either id id <$> expand files | ||||||
| 
 | 
 | ||||||
| ---------------------------------------------------------------- | ---------------------------------------------------------------- | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -2,15 +2,12 @@ module Language.Haskell.GhcMod.Types where | |||||||
| 
 | 
 | ||||||
| import Data.List (intercalate) | import Data.List (intercalate) | ||||||
| import qualified Data.Map as M | import qualified Data.Map as M | ||||||
| import Control.Exception (SomeException) |  | ||||||
| import Control.Monad.Error (Error(..)) | import Control.Monad.Error (Error(..)) | ||||||
| 
 | 
 | ||||||
| import PackageConfig (PackageConfig) | import PackageConfig (PackageConfig) | ||||||
| 
 | 
 | ||||||
| data GhcModError = GMENoMsg | data GhcModError = GMENoMsg | ||||||
|                  -- ^ Unknown error |                  -- ^ Unknown error | ||||||
|                  | GMEException SomeException |  | ||||||
|                  -- ^ Regular exception lifted by 'liftExceptions' |  | ||||||
|                  | GMEString { gmeMsg :: String } |                  | GMEString { gmeMsg :: String } | ||||||
|                  -- ^ Some Error with a message. These are produced mostly by |                  -- ^ Some Error with a message. These are produced mostly by | ||||||
|                  -- 'fail' calls on GhcModT. |                  -- 'fail' calls on GhcModT. | ||||||
|  | |||||||
| @ -2,7 +2,6 @@ module Language.Haskell.GhcMod.Utils where | |||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| import MonadUtils (MonadIO, liftIO) | import MonadUtils (MonadIO, liftIO) | ||||||
| import Exception (ExceptionMonad, gtry) |  | ||||||
| import Control.Exception | import Control.Exception | ||||||
| import Control.Monad.Error (MonadError(..), Error(..)) | import Control.Monad.Error (MonadError(..), Error(..)) | ||||||
| import System.Directory (getCurrentDirectory, setCurrentDirectory) | import System.Directory (getCurrentDirectory, setCurrentDirectory) | ||||||
| @ -10,7 +9,6 @@ import System.Process (readProcessWithExitCode) | |||||||
| import System.Exit (ExitCode(..)) | import System.Exit (ExitCode(..)) | ||||||
| import System.IO (hPutStrLn, stderr) | import System.IO (hPutStrLn, stderr) | ||||||
| import System.IO.Error (tryIOError) | import System.IO.Error (tryIOError) | ||||||
| import Language.Haskell.GhcMod.Types |  | ||||||
| 
 | 
 | ||||||
| -- dropWhileEnd is not provided prior to base 4.5.0.0. | -- dropWhileEnd is not provided prior to base 4.5.0.0. | ||||||
| dropWhileEnd :: (a -> Bool) -> [a] -> [a] | dropWhileEnd :: (a -> Bool) -> [a] -> [a] | ||||||
| @ -64,14 +62,3 @@ liftIOExceptions action = do | |||||||
|     Left e -> case show e of |     Left e -> case show e of | ||||||
|                 ""  -> throwError $ noMsg |                 ""  -> throwError $ noMsg | ||||||
|                 msg -> throwError $ strMsg msg |                 msg -> throwError $ strMsg msg | ||||||
| 
 |  | ||||||
| -- | Exceptions thrown in the computation passed to this function will be |  | ||||||
| -- converted to 'MonadError' failures using 'throwError'. |  | ||||||
| liftExceptions :: (MonadIO m, ExceptionMonad m, MonadError GhcModError m) |  | ||||||
|                => m a |  | ||||||
|                -> m a |  | ||||||
| liftExceptions action = do |  | ||||||
|   res <- gtry action |  | ||||||
|   case res of |  | ||||||
|     Right a -> return a |  | ||||||
|     Left e -> throwError $ GMEException e |  | ||||||
|  | |||||||
| @ -141,8 +141,6 @@ main = flip E.catches handlers $ do | |||||||
|       cmd       -> E.throw (NoSuchCommand cmd) |       cmd       -> E.throw (NoSuchCommand cmd) | ||||||
|     case res of |     case res of | ||||||
|       Right s -> putStr s |       Right s -> putStr s | ||||||
|       Left (GMEException e) -> |  | ||||||
|           hPutStrLn stderr $ "Exception: " ++ show e |  | ||||||
|       Left (GMENoMsg) -> |       Left (GMENoMsg) -> | ||||||
|           hPutStrLn stderr "Unknown error" |           hPutStrLn stderr "Unknown error" | ||||||
|       Left (GMEString msg) -> |       Left (GMEString msg) -> | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user
	 Daniel Gröber
						Daniel Gröber