Record Dot Hover Types (#3016)

* patch hieast

* add comments

* add hlint ignore

* update readme

* add tests

ghcide/test/data/hover/RecordDotSyntax.hs

@@ -0,0 +1,21 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 902
+{-# LANGUAGE OverloadedRecordDot, DuplicateRecordFields, NoFieldSelectors #-}
+
+module RecordDotSyntax ( module RecordDotSyntax) where
+
+import qualified Data.Maybe as M
+
+data MyRecord = MyRecord
+  { a :: String
+  , b :: Integer
+  , c :: MyChild
+  } deriving (Eq, Show)
+
+newtype MyChild = MyChild
+  { z :: String
+  } deriving (Eq, Show)
+
+x = MyRecord { a = "Hello", b = 12, c = MyChild { z = "there" } }
+y = x.a ++ show x.b ++ x.c.z
+#endif

ghcide/test/data/hover/hie.yaml

@@ -1 +1 @@
-cradle: {direct: {arguments: ["Foo", "Bar", "GotoHover"]}}
+cradle: {direct: {arguments: ["Foo", "Bar", "GotoHover", "RecordDotSyntax"]}}

ghcide/test/exe/Main.hs

@@ -4283,8 +4283,8 @@ canonicalizeLocation (Location uri range) = Location <$> canonicalizeUri uri <*>
 findDefinitionAndHoverTests :: TestTree
 findDefinitionAndHoverTests = let
 
-  tst :: (TextDocumentIdentifier -> Position -> Session a, a -> Session [Expect] -> Session ()) -> Position -> Session [Expect] -> String -> TestTree
-  tst (get, check) pos targetRange title = testSessionWithExtraFiles "hover" title $ \dir -> do
+  tst :: (TextDocumentIdentifier -> Position -> Session a, a -> Session [Expect] -> Session ()) -> Position -> String -> Session [Expect] -> String -> TestTree
+  tst (get, check) pos sfp targetRange title = testSessionWithExtraFiles "hover" title $ \dir -> do
 
     -- Dirty the cache to check that definitions work even in the presence of iface files
     liftIO $ runInDir dir $ do
@@ -4294,7 +4294,7 @@ findDefinitionAndHoverTests = let
       _ <- getHover fooDoc $ Position 4 3
       closeDoc fooDoc
 
-    doc <- openTestDataDoc (dir </> sourceFilePath)
+    doc <- openTestDataDoc (dir </> sfp)
     waitForProgressDone
     found <- get doc pos
     check found targetRange
@@ -4352,16 +4352,25 @@ findDefinitionAndHoverTests = let
           [ ( "GotoHover.hs", [(DsError, (62, 7), "Found hole: _")])
           , ( "GotoHover.hs", [(DsError, (65, 8), "Found hole: _")])
           ]
-    , testGroup "type-definition" typeDefinitionTests ]
+    , testGroup "type-definition" typeDefinitionTests
+    , testGroup "hover-record-dot-syntax" recordDotSyntaxTests ]
 
-  typeDefinitionTests = [ tst (getTypeDefinitions, checkDefs) aaaL14 (pure tcData) "Saturated data con"
-                        , tst (getTypeDefinitions, checkDefs) aL20 (pure [ExpectNoDefinitions]) "Polymorphic variable"]
+  typeDefinitionTests = [ tst (getTypeDefinitions, checkDefs) aaaL14 sourceFilePath (pure tcData) "Saturated data con"
+                        , tst (getTypeDefinitions, checkDefs) aL20 sourceFilePath (pure [ExpectNoDefinitions]) "Polymorphic variable"]
+  
+  recordDotSyntaxTests 
+    | ghcVersion == GHC92 =
+        [ tst (getHover, checkHover) (Position 19 24) (T.unpack "RecordDotSyntax.hs") (pure [ExpectHoverText ["x :: MyRecord"]]) "hover over parent" 
+        , tst (getHover, checkHover) (Position 19 25) (T.unpack "RecordDotSyntax.hs") (pure [ExpectHoverText ["_ :: MyChild"]]) "hover over dot shows child" 
+        , tst (getHover, checkHover) (Position 19 26) (T.unpack "RecordDotSyntax.hs") (pure [ExpectHoverText ["_ :: MyChild"]]) "hover over child" 
+        ]
+    | otherwise = []
 
   test runDef runHover look expect = testM runDef runHover look (return expect)
 
   testM runDef runHover look expect title =
-    ( runDef   $ tst def   look expect title
-    , runHover $ tst hover look expect title ) where
+    ( runDef   $ tst def   look sourceFilePath expect title
+    , runHover $ tst hover look sourceFilePath expect title ) where
       def   = (getDefinitions, checkDefs)
       hover = (getHover      , checkHover)
 

hie-compat/README.md

@@ -4,6 +4,8 @@ Mainly a backport of [HIE
 Files](https://gitlab.haskell.org/ghc/ghc/-/wikis/hie-files) for ghc 8.6, along
 with a few other backports of fixes useful for `ghcide`
 
+Also includes backport of record-dot-syntax support to 9.2.x
+
 Fully compatible with `.hie` files natively produced by versions of GHC that support
 them.
 
@@ -11,6 +13,8 @@ them.
 
 Backports included:
 
+https://gitlab.haskell.org/ghc/ghc/-/merge_requests/8589
+
 https://gitlab.haskell.org/ghc/ghc/-/merge_requests/4037
 
 https://gitlab.haskell.org/ghc/ghc/-/merge_requests/4068

hie-compat/hie-compat.cabal

@@ -47,6 +47,6 @@ library
   if (impl(ghc > 8.9) && impl(ghc < 8.11))
     hs-source-dirs: src-ghc810 src-reexport
   if (impl(ghc >= 9.0) && impl(ghc < 9.1) || flag(ghc-lib))
-    hs-source-dirs: src-reexport-ghc9
+    hs-source-dirs: src-ghc90 src-reexport-ghc9
   if (impl(ghc >= 9.2) && impl(ghc < 9.3))
-    hs-source-dirs: src-reexport-ghc9
+    hs-source-dirs: src-ghc92 src-reexport-ghc9