Fix #3574 and support resolve in explicit records

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

@@ -39,8 +39,8 @@ import           Data.Hashable
 import           Data.String                (IsString (fromString))
 import           Data.Text                  (unpack)
 #if MIN_VERSION_ghc(9,0,0)
+import           GHC                        (ModuleGraph)
 import           GHC.ByteCode.Types
-import GHC (ModuleGraph)
 #else
 import           ByteCodeTypes
 #endif
@@ -244,5 +244,11 @@ instance NFData HomeModLinkable where
 instance NFData (HsExpr (GhcPass 'Renamed)) where
     rnf = rwhnf
 
+instance NFData (Pat (GhcPass 'Renamed)) where
+    rnf = rwhnf
+
 instance NFData Extension where
   rnf = rwhnf
+
+instance NFData (UniqFM Name [Name]) where
+  rnf (ufmToIntMap -> m) = rnf m

plugins/hls-explicit-record-fields-plugin/hls-explicit-record-fields-plugin.cabal

@@ -19,6 +19,11 @@ source-repository head
   type:     git
   location: https://github.com/haskell/haskell-language-server
 
+flag pedantic
+  description: Enable -Werror
+  default:     False
+  manual:      True
+
 common warnings
     ghc-options: -Wall
 
@@ -40,9 +45,13 @@ library
       , ghc-boot-th
       , unordered-containers
       , containers
+      , aeson
     hs-source-dirs:   src
     default-language: Haskell2010
 
+  if flag(pedantic)
+    ghc-options: -Werror
+
 test-suite tests
     import:           warnings
     default-language: Haskell2010

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

@@ -27,6 +27,8 @@ 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 "HsExpanded1" "HsExpanded1" 16 5 16 15
+  , mkTest "HsExpanded2" "HsExpanded2" 32 7 32 18
   , mkTestNoAction "ExplicitBinds" "ExplicitBinds" 11 10 11 52
   , mkTestNoAction "Puns" "Puns" 12 10 12 31
   , mkTestNoAction "Infix" "Infix" 11 11 11 31
@@ -41,18 +43,22 @@ mkTestNoAction title fp x1 y1 x2 y2 =
       actions <- getExplicitFieldsActions doc x1 y1 x2 y2
       liftIO $ actions @?= []
 
-mkTest :: TestName -> FilePath -> UInt -> UInt -> UInt -> UInt -> TestTree
-mkTest title fp x1 y1 x2 y2 =
-  goldenWithHaskellDoc plugin title testDataDir fp "expected" "hs" $ \doc -> do
-    (act:_) <- getExplicitFieldsActions doc x1 y1 x2 y2
+mkTestWithCount :: Int -> TestName -> FilePath -> UInt -> UInt -> UInt -> UInt -> TestTree
+mkTestWithCount cnt title fp x1 y1 x2 y2 =
+  goldenWithHaskellAndCaps codeActionResolveCaps plugin title testDataDir fp "expected" "hs" $ \doc -> do
+    acts@(act:_) <- getExplicitFieldsActions doc x1 y1 x2 y2
+    liftIO $ length acts @?= cnt
     executeCodeAction act
 
+mkTest :: TestName -> FilePath -> UInt -> UInt -> UInt -> UInt -> TestTree
+mkTest = mkTestWithCount 1
+
 getExplicitFieldsActions
   :: TextDocumentIdentifier
   -> UInt -> UInt -> UInt -> UInt
   -> Session [CodeAction]
 getExplicitFieldsActions doc x1 y1 x2 y2 =
-  findExplicitFieldsAction <$> getCodeActions doc range
+  findExplicitFieldsAction <$> getAndResolveCodeActions doc range
   where
     range = Range (Position x1 y1) (Position x2 y2)
 

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

@@ -0,0 +1,18 @@
+{-# LANGUAGE Haskell2010 #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# Language OverloadedRecordDot #-}
+{-# LANGUAGE NamedFieldPuns #-}
+module HsExpanded1 where
+
+data MyRec = MyRec
+  { foo :: Int
+  , bar :: Int
+  , baz :: Char
+  }
+
+convertMe :: () -> Int
+convertMe _ =
+  let foo = 3
+      bar = 5
+      baz = 'a'
+  in MyRec {foo, bar, baz}.foo

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

@@ -0,0 +1,17 @@
+{-# LANGUAGE Haskell2010 #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# Language OverloadedRecordDot #-}
+module HsExpanded1 where
+
+data MyRec = MyRec
+  { foo :: Int
+  , bar :: Int
+  , baz :: Char
+  }
+
+convertMe :: () -> Int
+convertMe _ =
+  let foo = 3
+      bar = 5
+      baz = 'a'
+  in MyRec {..}.foo

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

@@ -0,0 +1,35 @@
+{-# LANGUAGE Haskell2010 #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE NamedFieldPuns #-}
+module HsExpanded2 where
+
+data MyRec = MyRec
+  { foo :: Int
+  , bar :: Int
+  , baz :: Char
+  }
+
+data YourRec = YourRec
+  { foo2 :: MyRec
+  , bar2 :: Int
+  , baz2 :: Char
+  }
+
+myRecExample = MyRec {..}
+  where
+    foo = 5
+    bar = 6
+    baz = 'a'
+
+yourRecExample = YourRec {..}
+    where
+        foo2 = myRecExample
+        bar2 = 5
+        baz2 = 'a'
+
+convertMe :: () -> Int
+convertMe _ =
+  (let MyRec{..} = myRecExample
+       YourRec {foo2, bar2, baz2} = yourRecExample
+    in foo2).foo

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

@@ -0,0 +1,34 @@
+{-# LANGUAGE Haskell2010 #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+module HsExpanded2 where
+
+data MyRec = MyRec
+  { foo :: Int
+  , bar :: Int
+  , baz :: Char
+  }
+
+data YourRec = YourRec
+  { foo2 :: MyRec
+  , bar2 :: Int
+  , baz2 :: Char
+  }
+
+myRecExample = MyRec {..}
+  where
+    foo = 5
+    bar = 6
+    baz = 'a'
+
+yourRecExample = YourRec {..}
+    where
+        foo2 = myRecExample
+        bar2 = 5
+        baz2 = 'a'
+
+convertMe :: () -> Int
+convertMe _ =
+  (let MyRec{..} = myRecExample
+       YourRec{..} = yourRecExample
+    in foo2).foo