Skip to content

Commit 366f1f0

Browse files
committed
Merge remote-tracking branch 'origin/master' into 4416-show-package-versions
2 parents 75bdf46 + 4c7e56a commit 366f1f0

File tree

32 files changed

+743
-146
lines changed

32 files changed

+743
-146
lines changed

cabal.project

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,7 @@ packages:
88
./hls-test-utils
99

1010

11-
index-state: 2025-05-12T13:26:29Z
11+
index-state: 2025-06-07T14:57:40Z
1212

1313
tests: True
1414
test-show-details: direct

docs/support/plugin-support.md

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -55,7 +55,7 @@ For example, a plugin to provide a formatter which has itself been abandoned has
5555
| `hls-explicit-record-fields-plugin` | 2 | |
5656
| `hls-fourmolu-plugin` | 2 | |
5757
| `hls-gadt-plugin` | 2 | |
58-
| `hls-hlint-plugin` | 2 | 9.10.1 |
58+
| `hls-hlint-plugin` | 2 | |
5959
| `hls-module-name-plugin` | 2 | |
6060
| `hls-notes-plugin` | 2 | |
6161
| `hls-qualify-imported-names-plugin` | 2 | |

flake.lock

Lines changed: 4 additions & 4 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

flake.nix

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,9 @@
22
description = "haskell-language-server development flake";
33

44
inputs = {
5-
nixpkgs.url = "github:NixOS/nixpkgs/nixpkgs-unstable";
5+
# Don't use nixpkgs-unstable as aarch64-darwin is currently broken there.
6+
# Check again, when https://github.com/NixOS/nixpkgs/pull/414242 is resolved.
7+
nixpkgs.url = "github:NixOS/nixpkgs/c742ae7908a82c9bf23ce27bfca92a00e9bcd541";
68
flake-utils.url = "github:numtide/flake-utils";
79
# For default.nix
810
flake-compat = {
@@ -66,6 +68,7 @@
6668
buildInputs = [
6769
# Compiler toolchain
6870
hpkgs.ghc
71+
hpkgs.haskell-language-server
6972
pkgs.haskellPackages.cabal-install
7073
# Dependencies needed to build some parts of Hackage
7174
gmp zlib ncurses

ghcide-test/exe/CompletionTests.hs

Lines changed: 33 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -33,7 +33,6 @@ import Test.Hls.Util
3333
import Test.Tasty
3434
import Test.Tasty.HUnit
3535

36-
3736
tests :: TestTree
3837
tests
3938
= testGroup "completion"
@@ -61,6 +60,7 @@ completionTest :: HasCallStack => String -> [T.Text] -> Position -> [(T.Text, Co
6160
completionTest name src pos expected = testSessionSingleFile name "A.hs" (T.unlines src) $ do
6261
docId <- openDoc "A.hs" "haskell"
6362
_ <- waitForDiagnostics
63+
6464
compls <- getAndResolveCompletions docId pos
6565
let compls' = [ (_label, _kind, _insertText, _additionalTextEdits) | CompletionItem{..} <- compls]
6666
let emptyToMaybe x = if T.null x then Nothing else Just x
@@ -211,7 +211,38 @@ localCompletionTests = [
211211

212212
compls <- getCompletions doc (Position 0 15)
213213
liftIO $ filter ("AAA" `T.isPrefixOf`) (mapMaybe _insertText compls) @?= ["AAAAA"]
214-
pure ()
214+
pure (),
215+
completionTest
216+
"polymorphic record dot completion"
217+
[ "{-# LANGUAGE OverloadedRecordDot #-}"
218+
, "module A () where"
219+
, "data Record = Record"
220+
, " { field1 :: Int"
221+
, " , field2 :: Int"
222+
, " }"
223+
, -- Without the following, this file doesn't trigger any diagnostics, so completionTest waits forever
224+
"triggerDiag :: UnknownType"
225+
, "foo record = record.f"
226+
]
227+
(Position 7 21)
228+
[("field1", CompletionItemKind_Function, "field1", True, False, Nothing)
229+
,("field2", CompletionItemKind_Function, "field2", True, False, Nothing)
230+
],
231+
completionTest
232+
"qualified polymorphic record dot completion"
233+
[ "{-# LANGUAGE OverloadedRecordDot #-}"
234+
, "module A () where"
235+
, "data Record = Record"
236+
, " { field1 :: Int"
237+
, " , field2 :: Int"
238+
, " }"
239+
, "someValue = undefined"
240+
, "foo = A.someValue.f"
241+
]
242+
(Position 7 19)
243+
[("field1", CompletionItemKind_Function, "field1", True, False, Nothing)
244+
,("field2", CompletionItemKind_Function, "field2", True, False, Nothing)
245+
]
215246
]
216247

217248
nonLocalCompletionTests :: [TestTree]

ghcide-test/exe/Main.hs

Lines changed: 1 addition & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -33,7 +33,6 @@ module Main (main) where
3333
import qualified HieDbRetry
3434
import Test.Tasty
3535
import Test.Tasty.Ingredients.Rerun
36-
import Test.Tasty.Runners
3736

3837
import AsyncTests
3938
import BootTests
@@ -71,7 +70,7 @@ import WatchedFileTests
7170
main :: IO ()
7271
main = do
7372
-- We mess with env vars so run single-threaded.
74-
defaultMainWithRerun $ PlusTestOptions mkSequential $ testGroup "ghcide"
73+
defaultMainWithRerun $ testGroup "ghcide"
7574
[ OpenCloseTest.tests
7675
, InitializeResponseTests.tests
7776
, CompletionTests.tests
@@ -105,6 +104,3 @@ main = do
105104
, HieDbRetry.tests
106105
, ExceptionTests.tests
107106
]
108-
where
109-
PlusTestOptions mkSequential _ =sequentialTestGroup "foo" AllFinish []
110-

ghcide/src/Development/IDE/GHC/Compat/Error.hs

Lines changed: 18 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -19,9 +19,11 @@ module Development.IDE.GHC.Compat.Error (
1919
Diagnostic(..),
2020
-- * Prisms for error selection
2121
_TcRnMessage,
22+
_TcRnMessageWithCtx,
2223
_GhcPsMessage,
2324
_GhcDsMessage,
2425
_GhcDriverMessage,
26+
_TcRnMissingSignature,
2527
) where
2628

2729
import Control.Lens
@@ -30,8 +32,20 @@ import GHC.HsToCore.Errors.Types
3032
import GHC.Tc.Errors.Types
3133
import GHC.Types.Error
3234

33-
_TcRnMessage :: Prism' GhcMessage TcRnMessage
34-
_TcRnMessage = prism' GhcTcRnMessage (\case
35+
-- | Some 'TcRnMessage's are nested in other constructors for additional context.
36+
-- For example, 'TcRnWithHsDocContext' and 'TcRnMessageWithInfo'.
37+
-- However, in most occasions you don't need the additional context and you just want
38+
-- the error message. @'_TcRnMessage'@ recursively unwraps these constructors,
39+
-- until there are no more constructors with additional context.
40+
--
41+
-- Use @'_TcRnMessageWithCtx'@ if you need the additional context. You can always
42+
-- strip it later using @'stripTcRnMessageContext'@.
43+
--
44+
_TcRnMessage :: Fold GhcMessage TcRnMessage
45+
_TcRnMessage = _TcRnMessageWithCtx . to stripTcRnMessageContext
46+
47+
_TcRnMessageWithCtx :: Prism' GhcMessage TcRnMessage
48+
_TcRnMessageWithCtx = prism' GhcTcRnMessage (\case
3549
GhcTcRnMessage tcRnMsg -> Just tcRnMsg
3650
_ -> Nothing)
3751

@@ -66,3 +80,5 @@ stripTcRnMessageContext = \case
6680

6781
msgEnvelopeErrorL :: Lens' (MsgEnvelope e) e
6882
msgEnvelopeErrorL = lens errMsgDiagnostic (\envelope e -> envelope { errMsgDiagnostic = e } )
83+
84+
makePrisms ''TcRnMessage

ghcide/src/Development/IDE/Plugin/Completions/Logic.hs

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -878,7 +878,9 @@ getCompletionPrefixFromRope pos@(Position l c) ropetext =
878878
[] -> Nothing
879879
(x:xs) -> do
880880
let modParts = reverse $ filter (not .T.null) xs
881-
modName = T.intercalate "." modParts
881+
-- Must check the prefix is a valid module name, else record dot accesses treat
882+
-- the record name as a qualName for search and generated imports
883+
modName = if all (isUpper . T.head) modParts then T.intercalate "." modParts else ""
882884
return $ PosPrefixInfo { fullLine = curLine, prefixScope = modName, prefixText = x, cursorPos = pos }
883885

884886
completionPrefixPos :: PosPrefixInfo -> Position

ghcide/src/Development/IDE/Plugin/TypeLenses.hs

Lines changed: 23 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -16,7 +16,7 @@ module Development.IDE.Plugin.TypeLenses (
1616

1717
import Control.Concurrent.STM.Stats (atomically)
1818
import Control.DeepSeq (rwhnf)
19-
import Control.Lens ((?~))
19+
import Control.Lens (to, (?~), (^?))
2020
import Control.Monad (mzero)
2121
import Control.Monad.Extra (whenMaybe)
2222
import Control.Monad.IO.Class (MonadIO (liftIO))
@@ -25,13 +25,17 @@ import Data.Aeson.Types (toJSON)
2525
import qualified Data.Aeson.Types as A
2626
import Data.List (find)
2727
import qualified Data.Map as Map
28-
import Data.Maybe (catMaybes, maybeToList)
28+
import Data.Maybe (catMaybes, isJust,
29+
maybeToList)
2930
import qualified Data.Text as T
3031
import Development.IDE (FileDiagnostic (..),
3132
GhcSession (..),
3233
HscEnvEq (hscEnv),
3334
RuleResult, Rules, Uri,
34-
define, srcSpanToRange,
35+
_SomeStructuredMessage,
36+
define,
37+
fdStructuredMessageL,
38+
srcSpanToRange,
3539
usePropertyAction)
3640
import Development.IDE.Core.Compile (TcModuleResult (..))
3741
import Development.IDE.Core.PluginUtils
@@ -45,6 +49,10 @@ import Development.IDE.Core.Shake (getHiddenDiagnostics,
4549
use)
4650
import qualified Development.IDE.Core.Shake as Shake
4751
import Development.IDE.GHC.Compat
52+
import Development.IDE.GHC.Compat.Error (_TcRnMessage,
53+
_TcRnMissingSignature,
54+
msgEnvelopeErrorL,
55+
stripTcRnMessageContext)
4856
import Development.IDE.GHC.Util (printName)
4957
import Development.IDE.Graph.Classes
5058
import Development.IDE.Types.Location (Position (Position, _line),
@@ -129,9 +137,9 @@ codeLensProvider ideState pId CodeLensParams{_textDocument = TextDocumentIdentif
129137
-- dummy type to make sure HLS resolves our lens
130138
[ CodeLens _range Nothing (Just $ toJSON TypeLensesResolve)
131139
| diag <- diags
132-
, let lspDiag@Diagnostic {_range} = fdLspDiagnostic diag
140+
, let Diagnostic {_range} = fdLspDiagnostic diag
133141
, fdFilePath diag == nfp
134-
, isGlobalDiagnostic lspDiag]
142+
, isGlobalDiagnostic diag]
135143
-- The second option is to generate lenses from the GlobalBindingTypeSig
136144
-- rule. This is the only type that needs to have the range adjusted
137145
-- with PositionMapping.
@@ -200,22 +208,27 @@ commandHandler _ideState _ wedit = do
200208
pure $ InR Null
201209

202210
--------------------------------------------------------------------------------
203-
suggestSignature :: Bool -> Maybe GlobalBindingTypeSigsResult -> Diagnostic -> [(T.Text, TextEdit)]
211+
suggestSignature :: Bool -> Maybe GlobalBindingTypeSigsResult -> FileDiagnostic -> [(T.Text, TextEdit)]
204212
suggestSignature isQuickFix mGblSigs diag =
205213
maybeToList (suggestGlobalSignature isQuickFix mGblSigs diag)
206214

207215
-- The suggestGlobalSignature is separated into two functions. The main function
208216
-- works with a diagnostic, which then calls the secondary function with
209217
-- whatever pieces of the diagnostic it needs. This allows the resolve function,
210218
-- which no longer has the Diagnostic, to still call the secondary functions.
211-
suggestGlobalSignature :: Bool -> Maybe GlobalBindingTypeSigsResult -> Diagnostic -> Maybe (T.Text, TextEdit)
212-
suggestGlobalSignature isQuickFix mGblSigs diag@Diagnostic{_range}
219+
suggestGlobalSignature :: Bool -> Maybe GlobalBindingTypeSigsResult -> FileDiagnostic -> Maybe (T.Text, TextEdit)
220+
suggestGlobalSignature isQuickFix mGblSigs diag@FileDiagnostic {fdLspDiagnostic = Diagnostic {_range}}
213221
| isGlobalDiagnostic diag =
214222
suggestGlobalSignature' isQuickFix mGblSigs Nothing _range
215223
| otherwise = Nothing
216224

217-
isGlobalDiagnostic :: Diagnostic -> Bool
218-
isGlobalDiagnostic Diagnostic{_message} = _message =~ ("(Top-level binding|Pattern synonym) with no type signature" :: T.Text)
225+
isGlobalDiagnostic :: FileDiagnostic -> Bool
226+
isGlobalDiagnostic diag = diag ^? fdStructuredMessageL
227+
. _SomeStructuredMessage
228+
. msgEnvelopeErrorL
229+
. _TcRnMessage
230+
. _TcRnMissingSignature
231+
& isJust
219232

220233
-- If a PositionMapping is supplied, this function will call
221234
-- gblBindingTypeSigToEdit with it to create a TextEdit in the right location.

ghcide/src/Development/IDE/Types/Diagnostics.hs

Lines changed: 9 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -102,20 +102,19 @@ ideErrorFromLspDiag lspDiag fdFilePath mbOrigMsg =
102102
fdLspDiagnostic =
103103
lspDiag
104104
& attachReason (fmap (diagnosticReason . errMsgDiagnostic) mbOrigMsg)
105-
& setGhcCode mbOrigMsg
105+
& attachDiagnosticCode ((diagnosticCode . errMsgDiagnostic) =<< mbOrigMsg)
106106
in
107107
FileDiagnostic {..}
108108

109-
-- | Set the code of the 'LSP.Diagnostic' to the GHC diagnostic code which is linked
109+
-- | Set the code of the 'LSP.Diagnostic' to the GHC diagnostic code, and include the link
110110
-- to https://errors.haskell.org/.
111-
setGhcCode :: Maybe (MsgEnvelope GhcMessage) -> LSP.Diagnostic -> LSP.Diagnostic
112-
setGhcCode mbOrigMsg diag =
113-
let mbGhcCode = do
114-
origMsg <- mbOrigMsg
115-
code <- diagnosticCode (errMsgDiagnostic origMsg)
116-
pure (InR (showGhcCode code))
117-
in
118-
diag { _code = mbGhcCode <|> _code diag }
111+
attachDiagnosticCode :: Maybe DiagnosticCode -> LSP.Diagnostic -> LSP.Diagnostic
112+
attachDiagnosticCode Nothing diag = diag
113+
attachDiagnosticCode (Just code) diag =
114+
let
115+
textualCode = showGhcCode code
116+
codeDesc = LSP.CodeDescription{ _href = Uri $ "https://errors.haskell.org/messages/" <> textualCode }
117+
in diag { _code = Just (InR textualCode), _codeDescription = Just codeDesc}
119118

120119
#if MIN_VERSION_ghc(9,9,0)
121120
-- DiagnosticCode only got a show instance in 9.10.1

0 commit comments

Comments
 (0)