From a8d51b469a083339cba20db5c44c6df0cd01592c Mon Sep 17 00:00:00 2001 From: mrBliss Date: Thu, 7 Jan 2021 16:15:51 +0100 Subject: [PATCH 1/2] Suggest adding pragmas for parse errors too Only errors produced by the type checker were checked for mentions of a pragma that could be enabled. Many parse errors suggest enabling a pragma: * `@` -> `TypeApplications` * `forall` -> `RankNTypes`. Although `ScopedTypeVariables` would be a better suggestion, IMO. * ... Generate suggestions for these too. --- plugins/default/src/Ide/Plugin/Pragmas.hs | 29 ++++++++++++++------ test/functional/FunctionalCodeAction.hs | 25 +++++++++++++++++ test/testdata/addPragmas/NeedsPragmas.hs | 1 + test/testdata/addPragmas/TypeApplications.hs | 5 ++++ test/testdata/addPragmas/hie.yaml | 1 + test/testdata/addPragmas/test.cabal | 5 ++-- 6 files changed, 55 insertions(+), 11 deletions(-) create mode 100644 test/testdata/addPragmas/TypeApplications.hs diff --git a/plugins/default/src/Ide/Plugin/Pragmas.hs b/plugins/default/src/Ide/Plugin/Pragmas.hs index 040466da44..8ceb316e94 100644 --- a/plugins/default/src/Ide/Plugin/Pragmas.hs +++ b/plugins/default/src/Ide/Plugin/Pragmas.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} -- | Provides code actions to add missing pragmas (whenever GHC suggests to) @@ -67,13 +68,19 @@ codeActionProvider _ state _plId docId _ (J.CodeActionContext (J.List diags) _mo let mFile = docId ^. J.uri & uriToFilePath <&> toNormalizedFilePath' pm <- fmap join $ runAction "addPragma" state $ getParsedModule `traverse` mFile let dflags = ms_hspp_opts . pm_mod_summary <$> pm - -- Filter diagnostics that are from ghcmod - ghcDiags = filter (\d -> d ^. J.source == Just "typecheck") diags + -- Filter diagnostics that are from GHC + ghcDiags = filter isGhcDiag diags -- Get all potential Pragmas for all diagnostics. pragmas = concatMap (\d -> genPragma dflags (d ^. J.message)) ghcDiags cmds <- mapM mkCodeAction pragmas return $ Right $ List cmds where + isGhcDiag diag + | Just source <- diag ^. J.source + = source `elem` ["parser", "typecheck"] + | otherwise + = False + mkCodeAction pragmaName = do let codeAction = J.CACodeAction $ J.CodeAction title (Just J.CodeActionQuickFix) (Just (J.List [])) (Just edit) Nothing @@ -81,13 +88,17 @@ codeActionProvider _ state _plId docId _ (J.CodeActionContext (J.List diags) _mo edit = mkPragmaEdit (docId ^. J.uri) pragmaName return codeAction - genPragma mDynflags target - | Just dynFlags <- mDynflags, - -- GHC does not export 'OnOff', so we have to view it as string - disabled <- [ e | Just e <- T.stripPrefix "Off " . T.pack . prettyPrint <$> extensions dynFlags] - = [ r | r <- findPragma target, r `notElem` disabled] - | otherwise = [] - + genPragma mDynflags target = + [ r | r <- findPragma target, r `notElem` disabled] + where + disabled + | Just dynFlags <- mDynflags + -- GHC does not export 'OnOff', so we have to view it as string + = [ e | Just e <- T.stripPrefix "Off " . T.pack . prettyPrint <$> extensions dynFlags] + | otherwise + -- When the module failed to parse, we don't have access to its + -- dynFlags. In that case, simply don't disable any pragmas. + = [] -- --------------------------------------------------------------------- diff --git a/test/functional/FunctionalCodeAction.hs b/test/functional/FunctionalCodeAction.hs index 960e0bb0d1..f02b500cd1 100644 --- a/test/functional/FunctionalCodeAction.hs +++ b/test/functional/FunctionalCodeAction.hs @@ -425,6 +425,7 @@ missingPragmaTests = testGroup "missing pragma warning code actions" [ contents <- documentContents doc let expected = [ "{-# LANGUAGE TypeSynonymInstances #-}" + , "module NeedsPragmas where" , "" , "import GHC.Generics" , "" @@ -443,6 +444,30 @@ missingPragmaTests = testGroup "missing pragma warning code actions" [ ] liftIO $ (T.lines contents) @?= expected + + , testCase "Adds TypeApplications pragma" $ do + runSession hlsCommand fullCaps "test/testdata/addPragmas" $ do + doc <- openDoc "TypeApplications.hs" "haskell" + + _ <- waitForDiagnosticsFrom doc + cas <- map fromAction <$> getAllCodeActions doc + + liftIO $ "Add \"TypeApplications\"" `elem` map (^. L.title) cas @? "Contains TypeApplications code action" + + executeCodeAction $ head cas + + contents <- documentContents doc + + let expected = + [ "{-# LANGUAGE TypeApplications #-}" + , "{-# LANGUAGE ScopedTypeVariables #-}" + , "module TypeApplications where" + , "" + , "foo :: forall a. a -> a" + , "foo = id @a" + ] + + liftIO $ (T.lines contents) @?= expected ] unusedTermTests :: TestTree diff --git a/test/testdata/addPragmas/NeedsPragmas.hs b/test/testdata/addPragmas/NeedsPragmas.hs index e82ad67ec2..18a8853972 100644 --- a/test/testdata/addPragmas/NeedsPragmas.hs +++ b/test/testdata/addPragmas/NeedsPragmas.hs @@ -1,3 +1,4 @@ +module NeedsPragmas where import GHC.Generics diff --git a/test/testdata/addPragmas/TypeApplications.hs b/test/testdata/addPragmas/TypeApplications.hs new file mode 100644 index 0000000000..55e56bdd9d --- /dev/null +++ b/test/testdata/addPragmas/TypeApplications.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module TypeApplications where + +foo :: forall a. a -> a +foo = id @a diff --git a/test/testdata/addPragmas/hie.yaml b/test/testdata/addPragmas/hie.yaml index 3e0a999a90..2c7d1c81c0 100644 --- a/test/testdata/addPragmas/hie.yaml +++ b/test/testdata/addPragmas/hie.yaml @@ -2,3 +2,4 @@ cradle: direct: arguments: - "NeedsPragmas" + - "TypeApplications" diff --git a/test/testdata/addPragmas/test.cabal b/test/testdata/addPragmas/test.cabal index 68ab327aec..eab3c651d2 100644 --- a/test/testdata/addPragmas/test.cabal +++ b/test/testdata/addPragmas/test.cabal @@ -10,8 +10,9 @@ category: Web build-type: Simple cabal-version: >=1.10 -executable p - main-is: NeedsPragmas.hs +library + exposed-modules: NeedsPragmas + TypeApplications hs-source-dirs: . build-depends: base >= 4.7 && < 5 default-language: Haskell2010 From 523ae20d2f6f3434bd0c463a1803b16d3d519b99 Mon Sep 17 00:00:00 2001 From: mrBliss Date: Fri, 8 Jan 2021 10:41:12 +0100 Subject: [PATCH 2/2] Find pragma suggestions for all diagnostics, not just for GHC --- plugins/default/src/Ide/Plugin/Pragmas.hs | 13 ++----------- 1 file changed, 2 insertions(+), 11 deletions(-) diff --git a/plugins/default/src/Ide/Plugin/Pragmas.hs b/plugins/default/src/Ide/Plugin/Pragmas.hs index 8ceb316e94..ca595873f2 100644 --- a/plugins/default/src/Ide/Plugin/Pragmas.hs +++ b/plugins/default/src/Ide/Plugin/Pragmas.hs @@ -2,7 +2,6 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} -- | Provides code actions to add missing pragmas (whenever GHC suggests to) @@ -68,19 +67,11 @@ codeActionProvider _ state _plId docId _ (J.CodeActionContext (J.List diags) _mo let mFile = docId ^. J.uri & uriToFilePath <&> toNormalizedFilePath' pm <- fmap join $ runAction "addPragma" state $ getParsedModule `traverse` mFile let dflags = ms_hspp_opts . pm_mod_summary <$> pm - -- Filter diagnostics that are from GHC - ghcDiags = filter isGhcDiag diags - -- Get all potential Pragmas for all diagnostics. - pragmas = concatMap (\d -> genPragma dflags (d ^. J.message)) ghcDiags + -- Get all potential Pragmas for all diagnostics. + pragmas = concatMap (\d -> genPragma dflags (d ^. J.message)) diags cmds <- mapM mkCodeAction pragmas return $ Right $ List cmds where - isGhcDiag diag - | Just source <- diag ^. J.source - = source `elem` ["parser", "typecheck"] - | otherwise - = False - mkCodeAction pragmaName = do let codeAction = J.CACodeAction $ J.CodeAction title (Just J.CodeActionQuickFix) (Just (J.List [])) (Just edit) Nothing