diff --git a/src/Haskell/Ide/Engine/Plugin/ApplyRefact.hs b/src/Haskell/Ide/Engine/Plugin/ApplyRefact.hs index 47d99f128..c57eb5687 100644 --- a/src/Haskell/Ide/Engine/Plugin/ApplyRefact.hs +++ b/src/Haskell/Ide/Engine/Plugin/ApplyRefact.hs @@ -6,6 +6,9 @@ module Haskell.Ide.Engine.Plugin.ApplyRefact where import Control.Arrow import Control.Exception ( IOException + , ErrorCall + , Handler(..) + , catches , try ) import Control.Lens hiding ( List ) @@ -251,10 +254,17 @@ applyHint fp mhint fileMap = do -- If we provide "applyRefactorings" with "Just (1,13)" then -- the "Redundant bracket" hint will never be executed -- because SrcSpan (1,20,??,??) doesn't contain position (1,13). - appliedFile <- liftIO $ applyRefactorings Nothing commands fp - diff <- ExceptT $ Right <$> makeDiffResult fp (T.pack appliedFile) fileMap - liftIO $ logm $ "applyHint:diff=" ++ show diff - return diff + res <- liftIO $ (Right <$> applyRefactorings Nothing commands fp) `catches` + [ Handler $ \e -> return (Left (show (e :: IOException))) + , Handler $ \e -> return (Left (show (e :: ErrorCall))) + ] + case res of + Right appliedFile -> do + diff <- ExceptT $ Right <$> makeDiffResult fp (T.pack appliedFile) fileMap + liftIO $ logm $ "applyHint:diff=" ++ show diff + return diff + Left err -> + throwE (show err) -- | Gets HLint ideas for getIdeas :: MonadIO m => FilePath -> Maybe OneHint -> ExceptT String m [Idea] diff --git a/test/testdata/ApplyRefactError.hs b/test/testdata/ApplyRefactError.hs new file mode 100644 index 000000000..89ad34d32 --- /dev/null +++ b/test/testdata/ApplyRefactError.hs @@ -0,0 +1,2 @@ +foo :: forall a. (a -> a) -> a -> a +foo f x = f $ x diff --git a/test/unit/ApplyRefactPluginSpec.hs b/test/unit/ApplyRefactPluginSpec.hs index c00ee44c9..ae788a2d9 100644 --- a/test/unit/ApplyRefactPluginSpec.hs +++ b/test/unit/ApplyRefactPluginSpec.hs @@ -4,6 +4,7 @@ module ApplyRefactPluginSpec where import qualified Data.HashMap.Strict as H +import qualified Data.Text as T import Haskell.Ide.Engine.Plugin.ApplyRefact import Haskell.Ide.Engine.MonadTypes import Haskell.Ide.Engine.PluginUtils @@ -153,3 +154,15 @@ applyRefactSpec = do , _diagnostics = List [] } )) + + -- --------------------------------- + + it "reports error without crash" $ do + filePath <- filePathToUri <$> makeAbsolute "./test/testdata/ApplyRefactError.hs" + + let req = applyAllCmd' filePath + isExpectedError (IdeResultFail (IdeError PluginError err _)) = + "Illegal symbol '.' in type" `T.isInfixOf` err + isExpectedError _ = False + r <- withCurrentDirectory "./test/testdata" $ runIGM testPlugins req + r `shouldSatisfy` isExpectedError