Suggest adding pragmas for parse errors too (#1165)

* 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.

* Find pragma suggestions for all diagnostics, not just for GHC

Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com>

Author: mrBliss

plugins/default/src/Ide/Plugin/Pragmas.hs

@@ -67,10 +67,8 @@ 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
-    -- 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
@@ -81,13 +79,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.
+              = []
 
 -- ---------------------------------------------------------------------
 

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

test/testdata/addPragmas/NeedsPragmas.hs

@@ -1,3 +1,4 @@
+module NeedsPragmas where
 
 import GHC.Generics
 

test/testdata/addPragmas/TypeApplications.hs

@@ -0,0 +1,5 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module TypeApplications where
+
+foo :: forall a. a -> a
+foo = id @a

test/testdata/addPragmas/hie.yaml

@@ -2,3 +2,4 @@ cradle:
   direct:
     arguments:
       - "NeedsPragmas"
+      - "TypeApplications"

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