Merge branch 'master' into fix-win-cache

Author: Ailrun

haskell-language-server.cabal

@@ -78,91 +78,97 @@ library
 
   default-language: Haskell2010
 
+-- Plugin flags are designed for 'cabal install haskell-language-server':
+-- - Packaged plugins should be manual:False
+-- - Non packaged plugins and bulk flags should be manual:True
+-- - Bulk flags should be default:False
+-- - Individual flags should be default:True
+
 flag all-plugins
   description: Enable all non formatter plugins
-  default:     True
+  default:     False
   manual:      True
 
 flag all-formatters
   description: Enable all fomatters
-  default:     True
+  default:     False
   manual:      True
 
 flag class
   description: Enable class plugin
-  default:     False
-  manual:      True
+  default:     True
+  manual:      False
 
 flag haddockComments
   description: Enable haddockComments plugin
-  default:     False
-  manual:      True
+  default:     True
+  manual:      False
 
 flag eval
   description: Enable eval plugin
-  default:     False
-  manual:      True
+  default:     True
+  manual:      False
 
 flag importLens
   description: Enable importLens plugin
-  default:     False
-  manual:      True
+  default:     True
+  manual:      False
 
 flag retrie
   description: Enable retrie plugin
-  default:     False
-  manual:      True
+  default:     True
+  manual:      False
 
 flag tactic
   description: Enable tactic plugin
-  default:     False
-  manual:      True
+  default:     True
+  manual:      False
 
 flag hlint
   description: Enable hlint plugin
-  default:     False
-  manual:      True
+  default:     True
+  manual:      False
 
 flag moduleName
   description: Enable moduleName plugin
-  default:     False
+  default:     True
   manual:      True
 
 flag pragmas
   description: Enable pragmas plugin
-  default:     False
+  default:     True
   manual:      True
 
 flag splice
   description: Enable splice plugin
-  default:     False
-  manual:      True
+  default:     True
+  manual:      False
 
 -- formatters
 
 flag floskell
   description: Enable floskell plugin
-  default:     False
+  default:     True
   manual:      True
 
 flag fourmolu
   description: Enable fourmolu plugin
-  default:     False
+  default:     True
   manual:      True
 
 flag ormolu
   description: Enable ormolu plugin
-  default:     False
+  default:     True
   manual:      True
 
 flag stylishHaskell
   description: Enable stylishHaskell plugin
-  default:     False
+  default:     True
   manual:      True
 
 flag brittany
   description: Enable brittany plugin
-  default:     False
+  default:     True
   manual:      True
 
 common example-plugins

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.
+              = []
 
 -- ---------------------------------------------------------------------
 

plugins/hls-class-plugin/hls-class-plugin.cabal

@@ -13,7 +13,7 @@ library
   exposed-modules:  Ide.Plugin.Class
   hs-source-dirs:   src
   build-depends:    aeson
-                  , base
+                  , base       >=4.12 && <5
                   , containers
                   , haskell-lsp
                   , hls-plugin-api

plugins/hls-class-plugin/src/Ide/Plugin/Class.hs

@@ -119,7 +119,7 @@ addMethodPlaceholders lf state AddMinimalMethodsParams{..} = fmap (fromMaybe err
 
     toMethodName n
       | Just (h, _) <- T.uncons n
-      , not (isAlpha h)
+      , not (isAlpha h || h == '_')
       = "(" <> n <> ")"
       | otherwise
       = n

plugins/hls-eval-plugin/hls-eval-plugin.cabal

@@ -25,7 +25,7 @@ library
 
   build-depends:
     , aeson
-    , base
+    , base       >=4.12 && <5
     , containers
     , deepseq
     , Diff

plugins/hls-explicit-imports-plugin/hls-explicit-imports-plugin.cabal

@@ -16,7 +16,7 @@ library
   exposed-modules:  Ide.Plugin.ExplicitImports
   hs-source-dirs:   src
   build-depends:    aeson
-               ,    base
+               ,    base        >=4.12 && <5
                ,    containers
                ,    deepseq
                ,    haskell-lsp-types

plugins/hls-haddock-comments-plugin/hls-haddock-comments-plugin.cabal

@@ -18,7 +18,7 @@ library
   hs-source-dirs:   src
   ghc-options:      -Wall -Wno-name-shadowing -Wredundant-constraints
   build-depends:
-    , base
+    , base       >=4.12 && <5
     , containers
     , ghc
     , ghc-exactprint

plugins/hls-hlint-plugin/hls-hlint-plugin.cabal

@@ -28,7 +28,7 @@ library
   build-depends:
     , aeson
     , apply-refact
-    , base
+    , base       >=4.12 && <5
     , binary
     , bytestring
     , containers

plugins/hls-retrie-plugin/hls-retrie-plugin.cabal

@@ -16,7 +16,7 @@ library
   exposed-modules:  Ide.Plugin.Retrie
   hs-source-dirs:   src
   build-depends:    aeson
-               ,    base
+               ,    base       >=4.12 && <5
                ,    containers
                ,    deepseq
                ,    directory

plugins/hls-splice-plugin/hls-splice-plugin.cabal

@@ -15,7 +15,7 @@ library
   other-modules:    Ide.Plugin.Splice.Types
   hs-source-dirs:   src
   build-depends:    aeson
-                  , base
+                  , base       >=4.12 && <5
                   , containers
                   , foldl
                   , haskell-lsp

test/functional/Class.hs

@@ -48,6 +48,9 @@ tests = testGroup
   , glodenTest "Creates a placeholder for multiple methods 2" "T3" "2"
     $ \(_:mmAction:_) -> do
       executeCodeAction mmAction
+  , glodenTest "Creates a placeholder for a method starting with '_'" "T4" ""
+    $ \(_fAction:_) -> do
+      executeCodeAction _fAction
   ]
 
 _CACodeAction :: Prism' CAResult CodeAction
@@ -60,14 +63,18 @@ classPath = "test" </> "testdata" </> "class"
 
 glodenTest :: String -> FilePath -> FilePath -> ([CodeAction] -> Session ()) -> TestTree
 glodenTest name fp deco execute
-  = goldenVsStringDiff name goldenGitDiff (classPath </> fp <.> deco <.> "expected" <.> "hs")
+  = goldenVsStringDiff name goldenGitDiff (classPath </> fpWithDeco <.> "expected" <.> "hs")
     $ runSession hlsCommand fullCaps classPath
     $ do
       doc <- openDoc (fp <.> "hs") "haskell"
       _ <- waitForDiagnosticsFromSource doc "typecheck"
       actions <- concatMap (^.. _CACodeAction) <$> getAllCodeActions doc
       execute actions
       BS.fromStrict . T.encodeUtf8 <$> getDocumentEdit doc
+  where
+    fpWithDeco
+      | deco == "" = fp
+      | otherwise  = fp <.> deco
 
 goldenGitDiff :: FilePath -> FilePath -> [String]
 goldenGitDiff fRef fNew = ["git", "diff", "--no-index", "--text", "--exit-code", fRef, fNew]

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

test/testdata/class/T4.expected.hs

@@ -0,0 +1,8 @@
+module T4 where
+
+class Test a where
+  _f :: a
+  {-# MINIMAL _f #-}
+
+instance Test Int where
+  _f = _

test/testdata/class/T4.hs

@@ -0,0 +1,7 @@
+module T4 where
+
+class Test a where
+  _f :: a
+  {-# MINIMAL _f #-}
+
+instance Test Int where