From 1042fdecc202eda90f1171e1a97a763e0e0750ce Mon Sep 17 00:00:00 2001 From: Hogeyama Date: Tue, 30 Apr 2019 14:56:41 +0900 Subject: [PATCH 1/4] Prevent hie crash if apply-refact crashes Catch all SomeExceptions that apply-refact might throw --- src/Haskell/Ide/Engine/Plugin/ApplyRefact.hs | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/src/Haskell/Ide/Engine/Plugin/ApplyRefact.hs b/src/Haskell/Ide/Engine/Plugin/ApplyRefact.hs index 47d99f128..c758f297c 100644 --- a/src/Haskell/Ide/Engine/Plugin/ApplyRefact.hs +++ b/src/Haskell/Ide/Engine/Plugin/ApplyRefact.hs @@ -6,6 +6,7 @@ module Haskell.Ide.Engine.Plugin.ApplyRefact where import Control.Arrow import Control.Exception ( IOException + , SomeException , try ) import Control.Lens hiding ( List ) @@ -251,10 +252,15 @@ 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 + (try $ applyRefactorings Nothing commands fp :: IO (Either SomeException String)) + 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] From a185f77e92d3dcb73e454e4cefad44cdc46cd9b1 Mon Sep 17 00:00:00 2001 From: Hogeyama Date: Tue, 30 Apr 2019 23:47:10 +0900 Subject: [PATCH 2/4] Catch only `ErrorCall` and `IOException` --- src/Haskell/Ide/Engine/Plugin/ApplyRefact.hs | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/src/Haskell/Ide/Engine/Plugin/ApplyRefact.hs b/src/Haskell/Ide/Engine/Plugin/ApplyRefact.hs index c758f297c..c57eb5687 100644 --- a/src/Haskell/Ide/Engine/Plugin/ApplyRefact.hs +++ b/src/Haskell/Ide/Engine/Plugin/ApplyRefact.hs @@ -6,7 +6,9 @@ module Haskell.Ide.Engine.Plugin.ApplyRefact where import Control.Arrow import Control.Exception ( IOException - , SomeException + , ErrorCall + , Handler(..) + , catches , try ) import Control.Lens hiding ( List ) @@ -252,8 +254,10 @@ 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). - res <- liftIO - (try $ applyRefactorings Nothing commands fp :: IO (Either SomeException String)) + 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 From 4d725b8731ad98829b7b7397d36ee040abfd17fe Mon Sep 17 00:00:00 2001 From: Hogeyama Date: Wed, 1 May 2019 01:20:51 +0900 Subject: [PATCH 3/4] Add a test case Related to #451, #1220 --- test/testdata/ApplyRefactError.hs | 2 ++ test/unit/ApplyRefactPluginSpec.hs | 13 +++++++++++++ 2 files changed, 15 insertions(+) create mode 100644 test/testdata/ApplyRefactError.hs diff --git a/test/testdata/ApplyRefactError.hs b/test/testdata/ApplyRefactError.hs new file mode 100644 index 000000000..08ae22468 --- /dev/null +++ b/test/testdata/ApplyRefactError.hs @@ -0,0 +1,2 @@ +hoge :: forall a. (a -> a) -> a -> a +hoge 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 From ab8d76403fa87179884f963c9cc0a8019df937dc Mon Sep 17 00:00:00 2001 From: Hogeyama Date: Wed, 1 May 2019 01:30:03 +0900 Subject: [PATCH 4/4] Rename a function in a test program --- test/testdata/ApplyRefactError.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/testdata/ApplyRefactError.hs b/test/testdata/ApplyRefactError.hs index 08ae22468..89ad34d32 100644 --- a/test/testdata/ApplyRefactError.hs +++ b/test/testdata/ApplyRefactError.hs @@ -1,2 +1,2 @@ -hoge :: forall a. (a -> a) -> a -> a -hoge f x = f $ x +foo :: forall a. (a -> a) -> a -> a +foo f x = f $ x