Merge remote-tracking branch 'upstream/master' into enhance/hls-class…

…-plugin/structured

.github/actions/setup-build/action.yml

@@ -31,7 +31,7 @@ runs:
         sudo chown -R $USER /usr/local/.ghcup
       shell: bash
 
-    - uses: haskell-actions/[email protected].6
+    - uses: haskell-actions/[email protected].7
       id: HaskEnvSetup
       with:
         ghc-version  : ${{ inputs.ghc   }}

.github/workflows/bench.yml

@@ -127,7 +127,7 @@ jobs:
         example: ['cabal', 'lsp-types']
 
     steps:
-    - uses: haskell-actions/[email protected].6
+    - uses: haskell-actions/[email protected].7
       with:
         ghc-version  : ${{ matrix.ghc   }}
         cabal-version: ${{ matrix.cabal }}

cabal.project

@@ -8,7 +8,7 @@ packages:
          ./hls-test-utils
 
 
-index-state:  2024-11-02T00:00:00Z
+index-state:  2024-12-02T00:00:00Z
 
 tests: True
 test-show-details: direct
@@ -46,3 +46,13 @@ constraints:
 if impl(ghc >= 9.9)
   -- https://github.com/haskell/haskell-language-server/issues/4324
   benchmarks: False
+
+if impl(ghc >= 9.8.4) && impl(ghc < 9.8.5)
+  -- By depending on ghc-lib-parser and ghc, we are encountering
+  -- a constraint conflict, ghc-9.8.4 comes with `filepath-1.4.301.0`,
+  -- and `ghc-lib-parser-9.8.4.20241130` specifies `filepath >=1.5 && < 1.6.
+  -- See https://github.com/digital-asset/ghc-lib/issues/572 for details.
+  allow-older:
+    ghc-lib-parser:filepath
+  constraints:
+    ghc-lib-parser==9.8.4.20241130

docs/requirements.txt

@@ -1,4 +1,4 @@
-Sphinx~=5.3.0
-sphinx-rtd-theme~=1.1.0
-myst-parser~=1.0.0
-docutils<0.19
+Sphinx~=8.1.3
+sphinx-rtd-theme~=3.0.2
+myst-parser~=4.0.0
+docutils~=0.21.2

ghcide/src/Development/IDE/GHC/Orphans.hs

@@ -7,7 +7,9 @@
 -- | Orphan instances for GHC.
 --   Note that the 'NFData' instances may not be law abiding.
 module Development.IDE.GHC.Orphans() where
-import           Development.IDE.GHC.Compat
+import           Development.IDE.GHC.Compat        hiding
+                                                   (DuplicateRecordFields,
+                                                    FieldSelectors)
 import           Development.IDE.GHC.Util
 
 import           Control.DeepSeq
@@ -23,9 +25,10 @@ import           GHC.Data.Bag
 import           GHC.Data.FastString
 import qualified GHC.Data.StringBuffer             as SB
 import           GHC.Parser.Annotation
-import           GHC.Types.SrcLoc
-
+import           GHC.Types.FieldLabel              (DuplicateRecordFields (DuplicateRecordFields, NoDuplicateRecordFields),
+                                                    FieldSelectors (FieldSelectors, NoFieldSelectors))
 import           GHC.Types.PkgQual
+import           GHC.Types.SrcLoc
 
 -- See Note [Guidelines For Using CPP In GHCIDE Import Statements]
 
@@ -237,3 +240,16 @@ instance NFData Extension where
 
 instance NFData (UniqFM Name [Name]) where
   rnf (ufmToIntMap -> m) = rnf m
+
+#if !MIN_VERSION_ghc(9,5,0)
+instance NFData DuplicateRecordFields where
+  rnf DuplicateRecordFields   = ()
+  rnf NoDuplicateRecordFields = ()
+
+instance NFData FieldSelectors where
+  rnf FieldSelectors   = ()
+  rnf NoFieldSelectors = ()
+
+instance NFData FieldLabel where
+  rnf (FieldLabel a b c d) = rnf a `seq` rnf b `seq` rnf c `seq` rnf d
+#endif

plugins/hls-explicit-record-fields-plugin/test/Main.hs

@@ -29,6 +29,7 @@ test = testGroup "explicit-fields"
     , mkTest "WithExplicitBind" "WithExplicitBind" 12 10 12 32
     , mkTest "Mixed" "Mixed" 14 10 14 37
     , mkTest "Construction" "Construction" 16 5 16 15
+    , mkTest "PositionalConstruction" "PositionalConstruction" 15 5 15 15
     , mkTest "HsExpanded1" "HsExpanded1" 17 10 17 20
     , mkTest "HsExpanded2" "HsExpanded2" 23 10 23 22
     , mkTestNoAction "ExplicitBinds" "ExplicitBinds" 11 10 11 52
@@ -37,8 +38,8 @@ test = testGroup "explicit-fields"
     , mkTestNoAction "Prefix" "Prefix" 10 11 10 28
     ]
   , testGroup "inlay hints"
-    [ mkInlayHintsTest "Construction" 16 $ \ih -> do
-        let mkLabelPart' = mkLabelPart "Construction"
+    [ mkInlayHintsTest "Construction" Nothing 16 $ \ih -> do
+        let mkLabelPart' = mkLabelPartOffsetLength "Construction"
         foo <- mkLabelPart' 13 6 "foo"
         bar <- mkLabelPart' 14 6 "bar"
         baz <- mkLabelPart' 15 6 "baz"
@@ -54,8 +55,33 @@ test = testGroup "explicit-fields"
                         , _tooltip = Just $ InL "Expand record wildcard (needs extension: NamedFieldPuns)"
                         , _paddingLeft = Just True
                         }]
-    , mkInlayHintsTest "HsExpanded1" 17 $ \ih -> do
-        let mkLabelPart' = mkLabelPart "HsExpanded1"
+    , mkInlayHintsTest "PositionalConstruction" Nothing 15 $ \ih -> do
+        let mkLabelPart' = mkLabelPartOffsetLengthSub1 "PositionalConstruction"
+        foo <- mkLabelPart' 5 4 "foo="
+        bar <- mkLabelPart' 6 4 "bar="
+        baz <- mkLabelPart' 7 4 "baz="
+        (@?=) ih
+          [ defInlayHint { _position = Position 15 11
+                         , _label = InR [ foo ]
+                         , _textEdits = Just [ mkLineTextEdit "MyRec { foo = a, bar = b, baz = c }" 15 5 16 ]
+                         , _tooltip = Just $ InL "Expand positional record"
+                         , _paddingLeft = Nothing
+                         }
+          , defInlayHint { _position = Position 15 13
+                         , _label = InR [ bar ]
+                         , _textEdits = Just [ mkLineTextEdit "MyRec { foo = a, bar = b, baz = c }" 15 5 16 ]
+                         , _tooltip = Just $ InL "Expand positional record"
+                         , _paddingLeft = Nothing
+                         }
+          , defInlayHint { _position = Position 15 15
+                         , _label = InR [ baz ]
+                         , _textEdits = Just [ mkLineTextEdit "MyRec { foo = a, bar = b, baz = c }" 15 5 16 ]
+                         , _tooltip = Just $ InL "Expand positional record"
+                         , _paddingLeft = Nothing
+                         }
+          ]
+    , mkInlayHintsTest "HsExpanded1" Nothing 17 $ \ih -> do
+        let mkLabelPart' = mkLabelPartOffsetLength "HsExpanded1"
         foo <- mkLabelPart' 11 4 "foo"
         (@?=) ih
           [defInlayHint { _position = Position 17 19
@@ -64,8 +90,18 @@ test = testGroup "explicit-fields"
                         , _tooltip = Just $ InL "Expand record wildcard"
                         , _paddingLeft = Just True
                         }]
-    , mkInlayHintsTest "HsExpanded2" 23 $ \ih -> do
-        let mkLabelPart' = mkLabelPart "HsExpanded2"
+    , mkInlayHintsTest "HsExpanded1" (Just " (positional)") 13 $ \ih -> do
+        let mkLabelPart' = mkLabelPartOffsetLengthSub1 "HsExpanded1"
+        foo <- mkLabelPart' 11 4 "foo="
+        (@?=) ih
+          [defInlayHint { _position = Position 13 21
+                        , _label = InR [ foo ]
+                        , _textEdits = Just [ mkLineTextEdit "MyRec { foo = 5 }" 13 15 22 ]
+                        , _tooltip = Just $ InL "Expand positional record"
+                        , _paddingLeft = Nothing
+                        }]
+    , mkInlayHintsTest "HsExpanded2" Nothing 23 $ \ih -> do
+        let mkLabelPart' = mkLabelPartOffsetLength "HsExpanded2"
         bar <- mkLabelPart' 14 4 "bar"
         (@?=) ih
           [defInlayHint { _position = Position 23 21
@@ -74,8 +110,18 @@ test = testGroup "explicit-fields"
                         , _tooltip = Just $ InL "Expand record wildcard"
                         , _paddingLeft = Just True
                         }]
-    , mkInlayHintsTest "Mixed" 14 $ \ih -> do
-        let mkLabelPart' = mkLabelPart "Mixed"
+    , mkInlayHintsTest "HsExpanded2" (Just " (positional)") 16 $ \ih -> do
+        let mkLabelPart' = mkLabelPartOffsetLengthSub1 "HsExpanded2"
+        foo <- mkLabelPart' 11 4 "foo="
+        (@?=) ih
+          [defInlayHint { _position = Position 16 21
+                        , _label = InR [ foo ]
+                        , _textEdits = Just [ mkLineTextEdit "MyRec { foo = 5 }" 16 15 22 ]
+                        , _tooltip = Just $ InL "Expand positional record"
+                        , _paddingLeft = Nothing
+                        }]
+    , mkInlayHintsTest "Mixed" Nothing 14 $ \ih -> do
+        let mkLabelPart' = mkLabelPartOffsetLength "Mixed"
         baz <- mkLabelPart' 9 4 "baz"
         quux <- mkLabelPart' 10 4 "quux"
         (@?=) ih
@@ -87,8 +133,8 @@ test = testGroup "explicit-fields"
                         , _tooltip = Just $ InL "Expand record wildcard"
                         , _paddingLeft = Just True
                         }]
-    , mkInlayHintsTest "Unused" 12 $ \ih -> do
-        let mkLabelPart' = mkLabelPart "Unused"
+    , mkInlayHintsTest "Unused" Nothing 12 $ \ih -> do
+        let mkLabelPart' = mkLabelPartOffsetLength "Unused"
         foo <- mkLabelPart' 6 4 "foo"
         bar <- mkLabelPart' 7 4 "bar"
         baz <- mkLabelPart' 8 4 "baz"
@@ -104,8 +150,8 @@ test = testGroup "explicit-fields"
                         , _tooltip = Just $ InL "Expand record wildcard (needs extension: NamedFieldPuns)"
                         , _paddingLeft = Just True
                         }]
-    , mkInlayHintsTest "Unused2" 12 $ \ih -> do
-        let mkLabelPart' = mkLabelPart "Unused2"
+    , mkInlayHintsTest "Unused2" Nothing 12 $ \ih -> do
+        let mkLabelPart' = mkLabelPartOffsetLength "Unused2"
         foo <- mkLabelPart' 6 4 "foo"
         bar <- mkLabelPart' 7 4 "bar"
         baz <- mkLabelPart' 8 4 "baz"
@@ -121,8 +167,8 @@ test = testGroup "explicit-fields"
                         , _tooltip = Just $ InL "Expand record wildcard (needs extension: NamedFieldPuns)"
                         , _paddingLeft = Just True
                         }]
-    , mkInlayHintsTest "WildcardOnly" 12 $ \ih -> do
-        let mkLabelPart' = mkLabelPart "WildcardOnly"
+    , mkInlayHintsTest "WildcardOnly" Nothing 12 $ \ih -> do
+        let mkLabelPart' = mkLabelPartOffsetLength "WildcardOnly"
         foo <- mkLabelPart' 6 4 "foo"
         bar <- mkLabelPart' 7 4 "bar"
         baz <- mkLabelPart' 8 4 "baz"
@@ -138,8 +184,8 @@ test = testGroup "explicit-fields"
                         , _tooltip = Just $ InL "Expand record wildcard (needs extension: NamedFieldPuns)"
                         , _paddingLeft = Just True
                         }]
-    , mkInlayHintsTest "WithExplicitBind" 12 $ \ih -> do
-        let mkLabelPart' = mkLabelPart "WithExplicitBind"
+    , mkInlayHintsTest "WithExplicitBind" Nothing 12 $ \ih -> do
+        let mkLabelPart' = mkLabelPartOffsetLength "WithExplicitBind"
         bar <- mkLabelPart' 7 4 "bar"
         baz <- mkLabelPart' 8 4 "baz"
         (@?=) ih
@@ -153,8 +199,8 @@ test = testGroup "explicit-fields"
                         , _tooltip = Just $ InL "Expand record wildcard (needs extension: NamedFieldPuns)"
                         , _paddingLeft = Just True
                         }]
-    , mkInlayHintsTest "WithPun" 13 $ \ih -> do
-        let mkLabelPart' = mkLabelPart "WithPun"
+    , mkInlayHintsTest "WithPun" Nothing 13 $ \ih -> do
+        let mkLabelPart' = mkLabelPartOffsetLength "WithPun"
         bar <- mkLabelPart' 8 4 "bar"
         baz <- mkLabelPart' 9 4 "baz"
         (@?=) ih
@@ -169,9 +215,9 @@ test = testGroup "explicit-fields"
     ]
   ]
 
-mkInlayHintsTest :: FilePath -> UInt -> ([InlayHint] -> Assertion) -> TestTree
-mkInlayHintsTest fp line assert =
-  testCase fp $
+mkInlayHintsTest :: FilePath -> Maybe TestName -> UInt -> ([InlayHint] -> Assertion) -> TestTree
+mkInlayHintsTest fp postfix line assert =
+  testCase (fp ++ concat postfix) $
     runSessionWithServer def plugin testDataDir $ do
       doc <- openDoc (fp ++ ".hs") "haskell"
       inlayHints <- getInlayHints doc (lineRange line)
@@ -226,8 +272,8 @@ defInlayHint =
   , _data_        = Nothing
   }
 
-mkLabelPart :: FilePath -> UInt -> UInt -> Text -> IO InlayHintLabelPart
-mkLabelPart fp line start value = do
+mkLabelPart :: (Text -> UInt) -> FilePath -> UInt -> UInt -> Text -> IO InlayHintLabelPart
+mkLabelPart offset fp line start value = do
   uri' <- uri
   pure $ InlayHintLabelPart { _location = Just (location uri' line start)
                             , _value    = value
@@ -237,7 +283,13 @@ mkLabelPart fp line start value = do
   where
     toUri = fromNormalizedUri . filePathToUri' . toNormalizedFilePath'
     uri = canonicalizeUri $ toUri (testDataDir </> (fp ++ ".hs"))
-    location uri line char = Location uri (Range (Position line char) (Position line (char + (fromIntegral $ T.length value))))
+    location uri line char = Location uri (Range (Position line char) (Position line (char + offset value)))
+
+mkLabelPartOffsetLength ::FilePath -> UInt -> UInt -> Text -> IO InlayHintLabelPart
+mkLabelPartOffsetLength = mkLabelPart (fromIntegral . T.length)
+
+mkLabelPartOffsetLengthSub1 ::FilePath -> UInt -> UInt -> Text -> IO InlayHintLabelPart
+mkLabelPartOffsetLengthSub1 = mkLabelPart (fromIntegral . subtract 1 . T.length)
 
 commaPart :: InlayHintLabelPart
 commaPart =

plugins/hls-explicit-record-fields-plugin/test/testdata/PositionalConstruction.expected.hs

@@ -0,0 +1,16 @@
+{-# LANGUAGE Haskell2010 #-}
+
+module PositionalConstruction where
+
+data MyRec = MyRec
+  { foo :: Int
+  , bar :: Int
+  , baz :: Char
+  }
+
+convertMe :: () -> MyRec
+convertMe _ =
+  let a = 3
+      b = 5
+      c = 'a'
+  in MyRec { foo = a, bar = b, baz = c }

plugins/hls-explicit-record-fields-plugin/test/testdata/PositionalConstruction.hs

@@ -0,0 +1,16 @@
+{-# LANGUAGE Haskell2010 #-}
+
+module PositionalConstruction where
+
+data MyRec = MyRec
+  { foo :: Int
+  , bar :: Int
+  , baz :: Char
+  }
+
+convertMe :: () -> MyRec
+convertMe _ =
+  let a = 3
+      b = 5
+      c = 'a'
+  in MyRec a b c