Merge branch 'master' into harder_hlint_fixes

Author: peterwicksstringfield

cabal.project

@@ -4,7 +4,7 @@ packages:
          ./shake-bench
          ./ghcide
          ./hls-plugin-api
-         ./plugins/tactics
+         ./plugins/hls-tactics-plugin
          ./plugins/hls-class-plugin
          ./plugins/hls-eval-plugin
          ./plugins/hls-explicit-imports-plugin

haskell-language-server.cabal

@@ -8,11 +8,12 @@ description:
 
 homepage:           https://github.com/haskell/haskell-language-server#readme
 bug-reports:        https://github.com/haskell/haskell-language-server/issues
-author:             Alan Zimmerman
+author:             The Haskell IDE Team
 maintainer:         [email protected]
-copyright:          Alan Zimmerman
+copyright:          The Haskell IDE Team
 license:            Apache-2.0
 license-file:       LICENSE
+category:           Development
 build-type:         Simple
 tested-with:        GHC == 8.6.4 || == 8.6.5 || == 8.8.2 || == 8.8.3 || == 8.8.4 || == 8.10.1 || == 8.10.2 || == 8.10.3
 extra-source-files:
@@ -413,7 +414,7 @@ test-suite func-test
     , tasty-rerun
     , ghcide
 
-  hs-source-dirs:     test/functional plugins/tactics/src plugins/hls-eval-plugin/test plugins/hls-splice-plugin/src
+  hs-source-dirs:     test/functional plugins/hls-tactics-plugin/src plugins/hls-eval-plugin/test plugins/hls-splice-plugin/src
 
   main-is:            Main.hs
   other-modules:

hls-plugin-api/hls-plugin-api.cabal

@@ -8,10 +8,10 @@ homepage:      https://github.com/haskell/haskell-language-server/hls-plugin-api
 bug-reports:   https://github.com/haskell/haskell-language-server/issues
 license:       Apache-2.0
 license-file:  LICENSE
-author:        Many,TBD when we release
-maintainer:    [email protected] (for now)
-copyright:     Alan Zimmerman
-category:      Web
+author:        The Haskell IDE Team
+maintainer:    [email protected]
+copyright:     The Haskell IDE Team
+category:      Development
 build-type:    Simple
 
 flag pedantic

nix/default.nix

@@ -27,7 +27,7 @@ let
             hls-hlint-plugin = gitignoreSource ../plugins/hls-hlint-plugin;
             hls-retrie-plugin = gitignoreSource ../plugins/hls-retrie-plugin;
             hls-splice-plugin = gitignoreSource ../plugins/hls-splice-plugin;
-            hls-tactics-plugin = gitignoreSource ../plugins/tactics;
+            hls-tactics-plugin = gitignoreSource ../plugins/hls-tactics-plugin;
           });
         in
         {

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

@@ -100,12 +100,26 @@ findPragma str = concatMap check possiblePragmas
   where
     check p = [p | T.isInfixOf p str]
 
+    -- We exclude the Strict extension as it causes many false positives, see
+    -- the discussion at https://github.com/haskell/ghcide/pull/638
+    --
+    -- We don't include the No- variants, as GHC never suggests disabling an
+    -- extension in an error message.
+    possiblePragmas :: [T.Text]
+    possiblePragmas =
+       [ name
+       | FlagSpec{flagSpecName = T.pack -> name} <- xFlags
+       , "Strict" /= name
+       ]
+
 -- ---------------------------------------------------------------------
 
--- | Possible Pragma names.
--- See discussion at https://github.com/haskell/ghcide/pull/638
-possiblePragmas :: [T.Text]
-possiblePragmas = [name | FlagSpec{flagSpecName = T.pack -> name} <- xFlags, "Strict" /= name]
+-- | All language pragmas, including the No- variants
+allPragmas :: [T.Text]
+allPragmas = concat
+    [ [name, "No" <> name]
+    | FlagSpec{flagSpecName = T.pack -> name} <- xFlags
+    ]
 
 -- ---------------------------------------------------------------------
 
@@ -121,7 +135,7 @@ completion lspFuncs _ide complParams = do
             where
                 result (Just pfix)
                     | "{-# LANGUAGE" `T.isPrefixOf` VFS.fullLine pfix
-                    = Completions $ List $ map buildCompletion possiblePragmas
+                    = Completions $ List $ map buildCompletion allPragmas
                     | otherwise
                     = Completions $ List []
                 result Nothing = Completions $ List []

plugins/hls-haddock-comments-plugin/src/Ide/Plugin/HaddockComments.hs

@@ -1,17 +1,19 @@
 {-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ViewPatterns #-}
 
-module Ide.Plugin.HaddockComments where
+module Ide.Plugin.HaddockComments (descriptor) where
 
 import Control.Monad (join)
 import qualified Data.HashMap.Strict as HashMap
 import qualified Data.Map as Map
 import qualified Data.Text as T
 import Development.IDE
 import Development.IDE.GHC.Compat
+import Development.IDE.GHC.ExactPrint (GetAnnotatedParsedSource (..), annsA, astA)
 import Ide.Types
 import Language.Haskell.GHC.ExactPrint
 import Language.Haskell.GHC.ExactPrint.Types hiding (GhcPs)
@@ -25,17 +27,14 @@ descriptor plId =
     { pluginCodeActionProvider = Just codeActionProvider
     }
 
-haddockCommentsId :: CommandId
-haddockCommentsId = "HaddockCommentsCommand"
-
 codeActionProvider :: CodeActionProvider IdeState
 codeActionProvider _lspFuncs ideState _pId (TextDocumentIdentifier uri) range CodeActionContext {_diagnostics = List diags} =
   do
     let noErr = and $ (/= Just DsError) . _severity <$> diags
         nfp = uriToNormalizedFilePath $ toNormalizedUri uri
-    (join -> pm) <- runAction "HaddockComments.GetParsedModule" ideState $ use GetParsedModule `traverse` nfp
-    let locDecls = hsmodDecls . unLoc . pm_parsed_source <$> pm
-        anns = relativiseApiAnns <$> (pm_parsed_source <$> pm) <*> (pm_annotations <$> pm)
+    (join -> pm) <- runAction "HaddockComments.GetAnnotatedParsedSource" ideState $ use GetAnnotatedParsedSource `traverse` nfp
+    let locDecls = hsmodDecls . unLoc . astA <$> pm
+        anns = annsA <$> pm
         edits = [runGenComments gen locDecls anns range | noErr, gen <- genList]
     return $ Right $ List [CACodeAction $ toAction title uri edit | (Just (title, edit)) <- edits]
 
@@ -46,13 +45,16 @@ genList =
   ]
 
 -----------------------------------------------------------------------------
+
+-- | Defines how to generate haddock comments by tweaking annotations of AST
 data GenComments = forall a.
   GenComments
   { title :: T.Text,
     fromDecl :: HsDecl GhcPs -> Maybe a,
     collectKeys :: a -> [AnnKey],
     isFresh :: Annotation -> Bool,
-    updateAnn :: Annotation -> Annotation
+    updateAnn :: Annotation -> Annotation,
+    updateDeclAnn :: Annotation -> Annotation
   }
 
 runGenComments :: GenComments -> Maybe [LHsDecl GhcPs] -> Maybe Anns -> Range -> Maybe (T.Text, TextEdit)
@@ -63,7 +65,8 @@ runGenComments GenComments {..} mLocDecls mAnns range
     annKeys <- collectKeys x,
     not $ null annKeys,
     and $ maybe False isFresh . flip Map.lookup anns <$> annKeys,
-    anns' <- foldr (Map.adjust updateAnn) anns annKeys,
+    declKey <- mkAnnKey locDecl,
+    anns' <- Map.adjust updateDeclAnn declKey $ foldr (Map.adjust updateAnn) anns annKeys,
     Just range' <- toRange src,
     result <- T.strip . T.pack $ exactPrint locDecl anns' =
     Just (title, TextEdit range' result)
@@ -80,9 +83,9 @@ genForSig = GenComments {..}
     fromDecl _ = Nothing
 
     updateAnn x = x {annEntryDelta = DP (0, 1), annsDP = dp}
+    updateDeclAnn = cleanPriorComments
 
     isFresh Ann {annsDP} = null [() | (AnnComment _, _) <- annsDP]
-
     collectKeys = keyFromTyVar 0
 
     comment = mkComment "-- ^ " noSrcSpan
@@ -98,6 +101,7 @@ genForRecord = GenComments {..}
     fromDecl _ = Nothing
 
     updateAnn x = x {annEntryDelta = DP (1, 2), annPriorComments = [(comment, DP (1, 2))]}
+    updateDeclAnn = cleanPriorComments
 
     isFresh Ann {annPriorComments} = null annPriorComments
 
@@ -120,14 +124,18 @@ toAction title uri edit = CodeAction {..}
 
 toRange :: SrcSpan -> Maybe Range
 toRange src
-  | (RealSrcSpan span) <- src,
-    range' <- realSrcSpanToRange span =
+  | (RealSrcSpan s) <- src,
+    range' <- realSrcSpanToRange s =
     Just range'
   | otherwise = Nothing
 
 isIntersectWith :: Range -> SrcSpan -> Bool
 isIntersectWith Range {_start, _end} x = isInsideSrcSpan _start x || isInsideSrcSpan _end x
 
+-- clean prior comments, since src span we get from 'LHsDecl' does not include them
+cleanPriorComments :: Annotation -> Annotation
+cleanPriorComments x = x {annPriorComments = []}
+
 -----------------------------------------------------------------------------
 
 keyFromTyVar :: Int -> LHsType GhcPs -> [AnnKey]

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

@@ -5,10 +5,10 @@ synopsis:      Hlint integration plugin with Haskell Language Server
 description:   Please see Haskell Language Server Readme (https://github.com/haskell/haskell-language-server#readme)
 license:       Apache-2.0
 license-file:  LICENSE
-author:        https://github.com/haskell/haskell-language-server/contributors
-maintainer:    https://github.com/haskell/haskell-language-server/contributors
-copyright:     Alan Zimmerman
-category:      Web
+author:        The Haskell IDE Team
+maintainer:    alan.zimm@gmail.com
+copyright:     The Haskell IDE Team
+category:      Development
 build-type:    Simple
 
 flag pedantic

plugins/tactics/hls-tactics-plugin.cabal renamed to plugins/hls-tactics-plugin/hls-tactics-plugin.cabal

@@ -13,7 +13,7 @@ packages:
 - ./plugins/hls-hlint-plugin
 - ./plugins/hls-retrie-plugin
 - ./plugins/hls-splice-plugin
-- ./plugins/tactics
+- ./plugins/hls-tactics-plugin
 
 ghc-options:
   "$everything": -haddock

plugins/tactics/src/Ide/Plugin/Tactic.hs renamed to plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic.hs

@@ -13,7 +13,7 @@ packages:
   - ./plugins/hls-hlint-plugin
   - ./plugins/hls-retrie-plugin
   - ./plugins/hls-splice-plugin
-  - ./plugins/tactics
+  - ./plugins/hls-tactics-plugin
 
 ghc-options:
   "$everything": -haddock

plugins/tactics/src/Ide/Plugin/Tactic/Auto.hs renamed to plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Auto.hs

@@ -13,7 +13,7 @@ packages:
   - ./plugins/hls-hlint-plugin
   - ./plugins/hls-retrie-plugin
   - ./plugins/hls-splice-plugin
-  - ./plugins/tactics
+  - ./plugins/hls-tactics-plugin
 
 ghc-options:
   "$everything": -haddock

plugins/tactics/src/Ide/Plugin/Tactic/CodeGen.hs renamed to plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen.hs

@@ -14,7 +14,7 @@ packages:
   - ./plugins/hls-hlint-plugin
   - ./plugins/hls-retrie-plugin
   - ./plugins/hls-splice-plugin
-  - ./plugins/tactics
+  - ./plugins/hls-tactics-plugin
 
 ghc-options:
   "$everything": -haddock

plugins/tactics/src/Ide/Plugin/Tactic/Context.hs renamed to plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Context.hs

@@ -13,7 +13,7 @@ packages:
   - ./plugins/hls-hlint-plugin
   - ./plugins/hls-retrie-plugin
   - ./plugins/hls-splice-plugin
-  - ./plugins/tactics
+  - ./plugins/hls-tactics-plugin
 
 ghc-options:
   "$everything": -haddock

plugins/tactics/src/Ide/Plugin/Tactic/Debug.hs renamed to plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Debug.hs

@@ -13,7 +13,7 @@ packages:
   - ./plugins/hls-hlint-plugin
   - ./plugins/hls-retrie-plugin
   - ./plugins/hls-splice-plugin
-  - ./plugins/tactics
+  - ./plugins/hls-tactics-plugin
 
 ghc-options:
   "$everything": -haddock

plugins/tactics/src/Ide/Plugin/Tactic/GHC.hs renamed to plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/GHC.hs

@@ -13,7 +13,7 @@ packages:
   - ./plugins/hls-hlint-plugin
   - ./plugins/hls-retrie-plugin
   - ./plugins/hls-splice-plugin
-  - ./plugins/tactics
+  - ./plugins/hls-tactics-plugin
 
 ghc-options:
   "$everything": -haddock

plugins/tactics/src/Ide/Plugin/Tactic/Judgements.hs renamed to plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Judgements.hs

@@ -13,7 +13,7 @@ packages:
   - ./plugins/hls-hlint-plugin
   - ./plugins/hls-retrie-plugin
   - ./plugins/hls-splice-plugin
-  - ./plugins/tactics
+  - ./plugins/hls-tactics-plugin
 
 ghc-options:
   "$everything": -haddock

plugins/tactics/src/Ide/Plugin/Tactic/KnownStrategies.hs renamed to plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/KnownStrategies.hs

@@ -13,7 +13,7 @@ packages:
   - ./plugins/hls-hlint-plugin
   - ./plugins/hls-retrie-plugin
   - ./plugins/hls-splice-plugin
-  - ./plugins/tactics
+  - ./plugins/hls-tactics-plugin
 
 ghc-options:
   "$everything": -haddock

plugins/tactics/src/Ide/Plugin/Tactic/KnownStrategies/QuickCheck.hs renamed to plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/KnownStrategies/QuickCheck.hs

@@ -94,6 +94,34 @@ tests = testGroup "completions" [
              item ^. label @?= "OverloadedStrings"
              item ^. kind @?= Just CiKeyword
 
+     , testCase "completes the Strict language extension" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
+         doc <- openDoc "Completion.hs" "haskell"
+
+         _ <- waitForDiagnostics
+
+         let te = TextEdit (Range (Position 0 13) (Position 0 31)) "Str"
+         _ <- applyEdit doc te
+
+         compls <- getCompletions doc (Position 0 24)
+         let item = head $ filter ((== "Strict") . (^. label)) compls
+         liftIO $ do
+             item ^. label @?= "Strict"
+             item ^. kind @?= Just CiKeyword
+
+     , testCase "completes No- language extensions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
+         doc <- openDoc "Completion.hs" "haskell"
+
+         _ <- waitForDiagnostics
+
+         let te = TextEdit (Range (Position 0 13) (Position 0 31)) "NoOverload"
+         _ <- applyEdit doc te
+
+         compls <- getCompletions doc (Position 0 24)
+         let item = head $ filter ((== "NoOverloadedStrings") . (^. label)) compls
+         liftIO $ do
+             item ^. label @?= "NoOverloadedStrings"
+             item ^. kind @?= Just CiKeyword
+
      , testCase "completes pragmas" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
          doc <- openDoc "Completion.hs" "haskell"
 

plugins/tactics/src/Ide/Plugin/Tactic/Machinery.hs renamed to plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Machinery.hs

@@ -28,7 +28,7 @@ tests =
     "haddock comments"
     [ goldenTest "HigherRankFunction" Signature 4 6,
       goldenTest "KindSigFunction" Signature 9 10,
-      goldenTest "MultivariateFunction" Signature 2 8,
+      goldenTest "MultivariateFunction" Signature 4 8,
       goldenTest "QualFunction" Signature 2 10,
       goldenTest "Record" Record 7 2,
       expectedNothing "ConstFunction" Signature 2 2,
@@ -37,7 +37,7 @@ tests =
     ]
 
 goldenTest :: FilePath -> GenCommentsType -> Int -> Int -> TestTree
-goldenTest fp (toTitle -> expectedTitle) l c = goldenVsStringDiff fp goldenGitDiff goldenFilePath $
+goldenTest fp (toTitle -> expectedTitle) l c = goldenVsStringDiff (fp <> " (golden)") goldenGitDiff goldenFilePath $
   runSession hlsCommand fullCaps haddockCommentsPath $ do
     doc <- openDoc hsFilePath "haskell"
     _ <- waitForDiagnostics

plugins/tactics/src/Ide/Plugin/Tactic/Naming.hs renamed to plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Naming.hs

@@ -1,5 +1,7 @@
 module MultivariateFunction where
 
+-- | some
+-- docs
 f :: a -- ^ 
   -> b -- ^ 
   -> c -- ^ 

plugins/tactics/src/Ide/Plugin/Tactic/Range.hs renamed to plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Range.hs

@@ -1,4 +1,6 @@
 module MultivariateFunction where
 
+-- | some
+-- docs
 f :: a -> b -> c -> d -> e -> f -> g -> g
 f _ _ _ _ _ _ x = x

plugins/tactics/src/Ide/Plugin/Tactic/Tactics.hs renamed to plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Tactics.hs

@@ -1,5 +1,6 @@
 module Record where
 
+-- | A record
 data Record a b c d e f
   = RecordA
       {

plugins/tactics/src/Ide/Plugin/Tactic/TestTypes.hs renamed to plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/TestTypes.hs

@@ -1,5 +1,6 @@
 module Record where
 
+-- | A record
 data Record a b c d e f
   = RecordA
       { a :: a,