Hannes Siebenhandl pushed to branch wip/fendor/has-field-hie at Glasgow Haskell Compiler / GHC Commits: e01153ff by fendor at 2026-09-16T17:46:04+02:00 Record `FieldLabel` source span in AST node We attach evidence variables based on the source span of the concrete AST node in the HIE file. The evidence for the `HasField` constraint has the source span of the field selector, e.g. the AST node that gave rise to the `HasField` constraint. Since the AST node doesn't show up in the HIE file, the evidence for `HasField` was also not recorded for the span. Thus, `getEvidenceTree` wouldn't even list `HasField` as evidence, even in the perfectly normal case of: baz :: HasField "foo" f Int => f -> Int baz f = f.foo Requesting the evidence tree for `.foo` should point to the definition of `baz`, but since we omitted the source span for the field selector `.foo` from the AST node, the HIE file doesn't list it as evidence. By using the source spans of the individual field selectors, there are two consequences: * We can see the `HasField` evidence for record dot syntax at the field selector span * The reported type of `.foo` is `Foo -> Int` instead of just `Int` The latter is a change of behaviour that is unfortunate but the right behaviour, since there is now a source span for the whole expression `x.foo`, one for `x` and one for the selector `.foo`. If you query for the type at span `x.foo`, then the correct type `Int` is shown, but in downstream tooling (such as HLS), such requests are not possible in LSP. Thus, the behaviour changes. - - - - - 2dfa2ef6 by fendor at 2026-09-16T17:46:04+02:00 Allow any `Id` to be used for HIE evidence HIE evidence is used to show how a constraint has been solved and allows users to go directly to the definition or introduction of a particular evidence variable. So far, we only looked at evidence introduced by type class variables, but some evidence terms refer to other variables as well, such as record selectors. Such evidence terms add additional details and source locations. For generated evidence, such as `HasField` evidence to support `-XRecordDotSyntax`, the type class evidence is lacking and doesn't give us any usable source span pointing to the actual record selector. See this example evidence: $dHasField_aLw = GHC.Internal.Records.C:HasField @GHC.Internal.Types.Symbol @GHC.Internal.Types.LiftedRep @GHC.Internal.Types.LiftedRep @"foo" @Foo @Int (foo `cast` (<Foo -> Int>_R :: (Foo -> Int) ~R# (Foo -> Int))) The free variables of this term are `{C:HasField, foo}`. `foo` is the record selector from the type `Foo` and is crucial to guide users how this evidence is constructed, as the evidence `HasField` is not helpful. During HIE generation, we now take any `Id` into account to provide additional source spans to point to user to the definition site of the record selector. As a direct consequence, this allows HLS to implement a limited form of `Goto Definition` for expressions of the form `x.foo`, where `x :: Foo`. Capturing more `Id`s for evidence may have some side effects that are somewhat tricky to predict, since the tests are quite lacking. - - - - - 6f15256b by fendor at 2026-09-16T17:46:04+02:00 Add additional details to evidence bindings Evidence bindings can be all sorts of things, such as type class evidence, a record selector or other builtin constructs such as `Typeable`. - - - - - 84937391 by fendor at 2026-09-16T17:46:04+02:00 Typeable test - - - - - 13 changed files: - + changelog.d/record-dot-evidence - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Ext/Types.hs - compiler/GHC/Iface/Ext/Utils.hs - compiler/GHC/Rename/Expr.hs - + testsuite/tests/hiefile/should_run/HasFieldQueries.hs - + testsuite/tests/hiefile/should_run/HasFieldQueries.stdout - + testsuite/tests/hiefile/should_run/HieTypeable.hs - + testsuite/tests/hiefile/should_run/HieTypeable.stdout - testsuite/tests/hiefile/should_run/RecordDotTypes.hs - testsuite/tests/hiefile/should_run/RecordDotTypes.stdout - testsuite/tests/hiefile/should_run/T23492.stdout - testsuite/tests/hiefile/should_run/all.T Changes: ===================================== changelog.d/record-dot-evidence ===================================== @@ -0,0 +1,12 @@ +section: compiler +synopsis: Record selector functions as evidence for `HasField` constraints during .hie file generation. +description: { + We record the record selector `foo` of an expression such as `f.foo` as evidence for + solving the constraint `HasField "foo" record ty`. + + This allows us to point to the definition source location of the record selector `foo`, allowing + users to jump to definition using the evidence variables. +} + +issues: #25418 +mrs: !16694 ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -23,7 +23,6 @@ import GHC.Core.DataCon ( dataConWrapperType ) import GHC.Core.Type ( Type, ForAllTyFlag(..) ) import GHC.Core.TyCon ( TyCon, tyConClass_maybe ) import GHC.Core.InstEnv -import GHC.Core.Predicate ( isEvId ) import GHC.Hs import GHC.Hs.Syn.Type @@ -33,7 +32,7 @@ import GHC.Types.Basic import GHC.Types.UnresolvedImport ( isGeneratedImport ) import GHC.Types.FieldLabel import GHC.Types.Avail ( Avails ) -import GHC.Types.Id ( isDataConId_maybe ) +import GHC.Types.Id ( isDataConId_maybe, isId, idDetails ) import GHC.Types.Name ( Name, nameSrcSpan, nameUnique, wiredInNameTyThing_maybe, getName ) import GHC.Types.Name.Env ( NameEnv, emptyNameEnv, extendNameEnv, lookupNameEnv ) import GHC.Types.Name.Reader ( RecFieldInfo(..), WithUserRdr(..) ) @@ -81,6 +80,7 @@ import Control.Applicative ( (<|>) ) import GHC.Types.TypeEnv ( TypeEnv ) import Control.Arrow ( second ) import Data.Traversable ( mapAccumR ) +import GHC.Types.Id.Info (IdDetails(..), recSelParentName) {- Note [Updating HieAst for changes in the GHC AST] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -682,7 +682,7 @@ instance ToHie (Context (Located (WithUserRdr Name))) where hieEvIdsOfTerm :: EvTerm -> [EvId] -- Returns only EvIds satisfying relevantEvId -hieEvIdsOfTerm = runFVSelectiveList isEvId . evTermFVs +hieEvIdsOfTerm = runFVSelectiveList isId . evTermFVs instance ToHie (EvBindContext (LocatedA TcEvBinds)) where toHie (EvBindContext sc sp (L span (EvBinds bs))) @@ -690,7 +690,7 @@ instance ToHie (EvBindContext (LocatedA TcEvBinds)) where where go evbind = do let evDeps = hieEvIdsOfTerm $ eb_rhs evbind - depNames = EvBindDeps $ map varName evDeps + depNames = EvBindDeps $ map classifyEvBindDep evDeps concatM $ [ toHie (C (EvidenceVarBind (EvLetBind depNames) (combineScopes sc (mkScope span)) sp) (L span $ eb_lhs evbind)) @@ -698,6 +698,12 @@ instance ToHie (EvBindContext (LocatedA TcEvBinds)) where ] toHie _ = pure [] +classifyEvBindDep :: EvId -> EvBindDep +classifyEvBindDep evId = + case idDetails evId of + RecSelId{sel_tycon} -> RecordField (varName evId) (recSelParentName sel_tycon) + _ -> EvidenceVar (varName evId) + instance ToHie (LocatedA HsWrapper) where toHie (L osp wrap) = case wrap of ===================================== compiler/GHC/Iface/Ext/Types.hs ===================================== @@ -598,17 +598,61 @@ instance Outputable EvVarSource where ppr (EvInstBind True cls) = text "bound due to a superclass of " <+> ppr cls ppr (EvLetBind deps) = text "bound by a let, depending on:" <+> ppr deps +data EvBindDep + = EvidenceVar Name + | RecordField Name Name + | TypeableEvidence Name + deriving (Eq, Ord) + +instance Outputable EvBindDep where + ppr = \ case + EvidenceVar n -> ppr n + RecordField sel parent -> ppr sel <+> text "of Record" <+> ppr parent + TypeableEvidence n -> ppr n <+> text "bound by Typeable" + +evBindDepName :: EvBindDep -> Name +evBindDepName = \ case + EvidenceVar n -> n + RecordField selector _record -> selector + TypeableEvidence n -> n + +evBindDepHieName :: EvBindDep -> HieName +evBindDepHieName = toHieName . evBindDepName + +instance Binary EvBindDep where + put_ bh = \ case + EvidenceVar n -> do + putByte bh 0 + put_ bh n + RecordField n sel -> do + putByte bh 1 + put_ bh n + put_ bh sel + TypeableEvidence n -> do + putByte bh 2 + put_ bh n + + get bh = + getByte bh >>= \ case + 0 -> EvidenceVar <$> get bh + 1 -> RecordField <$> get bh <*> get bh + 2 -> TypeableEvidence <$> get bh + t -> fail $ "EvBindDep: Unknown tag: " ++ show t + -- | Eq/Ord instances compare on the converted HieName, -- as non-exported names may have different uniques after -- a roundtrip -newtype EvBindDeps = EvBindDeps { getEvBindDeps :: [Name] } +newtype EvBindDeps = EvBindDeps { getEvBindDeps :: [EvBindDep] } deriving Outputable +evBindDepsNames :: EvBindDeps -> [Name] +evBindDepsNames = map evBindDepName . getEvBindDeps + instance Eq EvBindDeps where - (==) = coerce ((==) `on` map toHieName) + (==) = coerce ((==) `on` map evBindDepHieName) instance Ord EvBindDeps where - compare = coerce (compare `on` map toHieName) + compare = coerce (compare `on` map evBindDepHieName) instance Binary EvBindDeps where put_ bh (EvBindDeps xs) = put_ bh xs ===================================== compiler/GHC/Iface/Ext/Utils.hs ===================================== @@ -82,15 +82,19 @@ resolveVisibility kind ty_args foldType :: (HieType a -> a) -> HieTypeFix -> a foldType f (Roll t) = f $ fmap (foldType f) t -selectPoint :: HieFile -> (Int,Int) -> Maybe (HieAST Int) -selectPoint hf (sl,sc) = getFirst $ +selectPoint :: HieFile -> (Int,Int) -> Maybe (HieAST TypeIndex) +selectPoint hf p = selectRange hf p p + +selectRange :: HieFile -> (Int,Int) -> (Int,Int) -> Maybe (HieAST TypeIndex) +selectRange hf (sl,sc) (el, ec) = getFirst $ flip foldMap (M.toList (getAsts $ hie_asts hf)) $ \(HiePath fs,ast) -> First $ case selectSmallestContaining (sp fs) ast of Nothing -> Nothing Just ast' -> Just ast' where sloc fs = mkRealSrcLoc fs sl sc - sp fs = mkRealSrcSpan (sloc fs) (sloc fs) + eloc fs = mkRealSrcLoc fs el ec + sp fs = mkRealSrcSpan (sloc fs) (eloc fs) findEvidenceUse :: NodeIdentifiers a -> [Name] findEvidenceUse ni = [n | (Right n, dets) <- xs, any isEvidenceUse (identInfo dets)] @@ -141,7 +145,7 @@ getEvidenceTree refmap var = go emptyNameSet var det <- S.toList $ identInfo dets case det of EvidenceVarBind src@(EvLetBind (getEvBindDeps -> xs)) scp spn -> - pure $ Just ((src,scp,spn),mapMaybe (go $ extendNameSet seen var) xs) + pure $ Just ((src,scp,spn),mapMaybe (go (extendNameSet seen var) . evBindDepName) xs) EvidenceVarBind src scp spn -> pure $ Just ((src,scp,spn),[]) _ -> pure Nothing pure $ Tree.Node (EvidenceInfo var sp typ (Just evdet)) children @@ -386,7 +390,7 @@ definedInAsts asts n = case nameSrcSpan n of getEvidenceBindDeps :: ContextInfo -> [Name] getEvidenceBindDeps (EvidenceVarBind (EvLetBind xs) _ _) = - getEvBindDeps xs + evBindDepsNames xs getEvidenceBindDeps _ = [] isEvidenceBind :: ContextInfo -> Bool ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -422,7 +422,7 @@ rnExpr (HsGetField _ e f) ; let f' = rnDotFieldOcc <$> f ; return ( mkExpandedExpr (HsGetField noExtField e f') - (mkGetField getField e (fmap (unLoc . dfoLabel) f')) + (mkGetField getField e (dfoLabel $ unLoc f')) , fv_e `plusFN` fv_getField ) } rnExpr (HsProjection _ fs) @@ -431,7 +431,7 @@ rnExpr (HsProjection _ fs) ; let fs' = NE.map rnDotFieldOcc fs ; return ( mkExpandedExpr (HsProjection noExtField fs') - (mkProjection getField circ $ NE.map (unLoc . dfoLabel) fs') + (mkProjection getField circ $ NE.map dfoLabel fs') , unitFN circ `plusFN` fv_getField) } ------------------------------------------ @@ -2882,8 +2882,9 @@ rnHsIf p b1 b2 -- mkGetField arg field calculates a get_field @field arg expression. -- e.g. z.x = mkGetField z x = get_field @x z -mkGetField :: Name -> LHsExpr GhcRn -> LocatedAn NoEpAnns FieldLabelString -> HsExpr GhcRn -mkGetField get_field arg field = unLoc (head $ mkGet get_field (arg :| []) field) +mkGetField :: Name -> LHsExpr GhcRn -> XRec GhcRn FieldLabelString -> HsExpr GhcRn +mkGetField get_field arg field = + HsApp noExtField (mkGetFieldExpr get_field field) arg -- mkSetField a field b calculates a set_field @field expression. -- e.g mkSetSetField a field b = set_field @"field" a b (read as "set field 'field' to a on b"). @@ -2902,14 +2903,16 @@ mkSet set_field acc (field, g) = wrapGenSpan (mkSetField set_field g field acc) -- mkProjection fields calculates a projection. -- e.g. .x = mkProjection [x] = getField @"x" -- .x.y = mkProjection [.x, .y] = (.y) . (.x) = getField @"y" . getField @"x" -mkProjection :: Name -> Name -> NonEmpty FieldLabelString -> HsExpr GhcRn -mkProjection getFieldName circName (field :| fields) = foldl' f (proj field) fields +mkProjection :: Name -> Name -> NonEmpty (XRec GhcRn FieldLabelString) -> HsExpr GhcRn +mkProjection getFieldName circName (field :| fields) = + unLoc $ foldl' f (mkGetFieldExpr getFieldName field) fields where - f :: HsExpr GhcRn -> FieldLabelString -> HsExpr GhcRn - f acc field = genHsApps circName $ map wrapGenSpan [proj field, acc] + f :: LHsExpr GhcRn -> XRec GhcRn FieldLabelString -> LHsExpr GhcRn + f acc field = wrapGenSpan $ genHsApps circName [mkGetFieldExpr getFieldName field, acc] - proj :: FieldLabelString -> HsExpr GhcRn - proj (FieldLabelString f) = genHsVar getFieldName `genAppType` genHsTyLit f +mkGetFieldExpr :: Name -> XRec GhcRn FieldLabelString -> LHsExpr GhcRn +mkGetFieldExpr getFieldName (L ann (FieldLabelString f)) = + wrapGenSpan' (getHasLoc ann) (genHsVar getFieldName `genAppType` genHsTyLit f) -- mkProjUpdateSetField calculates functions representing dot notation record updates. -- e.g. Suppose an update like foo.bar = 1. ===================================== testsuite/tests/hiefile/should_run/HasFieldQueries.hs ===================================== @@ -0,0 +1,52 @@ +{-# LANGUAGE OverloadedRecordDot #-} +module Main where + +import TestUtils +import GHC.Records +import GHC.TypeLits +import Data.Tree + +data Thing = Thing {field1 :: Char, field2 :: Bool} + deriving (Show, Eq) + +foo :: Thing -> String +foo t = show t.field1 +-- ^ this is the point + +testing2 (x :: Thing) = x.field1 +-- ^ this is the point +-- ^ this is the point + +data NestedThing = NestedThing { nested1 :: Thing } + +nestedSig :: NestedThing -> Char +nestedSig n = n.nested1.field1 +-- ^ this is the point +-- ^ this is the point + +nestedNoSig n = n.nested1.field2 :: Bool +-- ^ this is the point +-- ^ this is the point + + +withConstraint :: HasField "field1" x Char => x -> Char +withConstraint x = x.field1 +-- ^ this is the point + +points = + [ (13,17) + , (16,25) + , (16,27) + , (23,17) + , (23,25) + , (27,20) + , (27,28) + , (33,22) + ] + +main = do + (df, hf) <- readTestHie "HasFieldQueries.hie" + let refmap = generateReferencesMap $ getAsts $ hie_asts hf + + traverse (explainEv df hf refmap) points + return () ===================================== testsuite/tests/hiefile/should_run/HasFieldQueries.stdout ===================================== @@ -0,0 +1,156 @@ +========================== +At point (13,17), we found: +========================== +┌ +│ $dHasField at HasFieldQueries.hs:1:1, of type: HasField "field1" Thing Char +│ is an evidence variable bound by a let, depending on: [C:HasField, +│ field1 of Record Thing] +│ with scope: ModuleScope +│ +│ Defined at <no location info> +└ +| ++- ┌ +| │ C:HasField at HasFieldQueries.hs:1:1, of type: forall {k} (x :: k) r a. (r -> a) -> HasField x r a +| │ is a usage of an external evidence variable +| │ Defined in `GHC.Internal.Records' +| └ +| +`- ┌ + │ field1 at HasFieldQueries.hs:1:1, of type: Thing -> Char + │ is a usage of an external evidence variable + │ Defined at HasFieldQueries.hs:9:21 + └ + +========================== +At point (16,25), we found: +========================== +========================== +At point (16,27), we found: +========================== +┌ +│ $dHasField at HasFieldQueries.hs:16:1-32, of type: HasField "field1" Thing Char +│ is an evidence variable bound by a let, depending on: [C:HasField, +│ field1 of Record Thing] +│ with scope: LocalScope HasFieldQueries.hs:16:1-32 +│ bound at: HasFieldQueries.hs:16:1-32 +│ Defined at <no location info> +└ +| ++- ┌ +| │ C:HasField at HasFieldQueries.hs:1:1, of type: forall {k} (x :: k) r a. (r -> a) -> HasField x r a +| │ is a usage of an external evidence variable +| │ Defined in `GHC.Internal.Records' +| └ +| +`- ┌ + │ field1 at HasFieldQueries.hs:1:1, of type: Thing -> Char + │ is a usage of an external evidence variable + │ Defined at HasFieldQueries.hs:9:21 + └ + +========================== +At point (23,17), we found: +========================== +┌ +│ $dHasField at HasFieldQueries.hs:1:1, of type: HasField "nested1" NestedThing Thing +│ is an evidence variable bound by a let, depending on: [C:HasField, +│ nested1 of Record NestedThing] +│ with scope: ModuleScope +│ +│ Defined at <no location info> +└ +| ++- ┌ +| │ C:HasField at HasFieldQueries.hs:1:1, of type: forall {k} (x :: k) r a. (r -> a) -> HasField x r a +| │ is a usage of an external evidence variable +| │ Defined in `GHC.Internal.Records' +| └ +| +`- ┌ + │ nested1 at HasFieldQueries.hs:1:1, of type: NestedThing -> Thing + │ is a usage of an external evidence variable + │ Defined at HasFieldQueries.hs:20:34 + └ + +========================== +At point (23,25), we found: +========================== +┌ +│ $dHasField at HasFieldQueries.hs:1:1, of type: HasField "field1" Thing Char +│ is an evidence variable bound by a let, depending on: [C:HasField, +│ field1 of Record Thing] +│ with scope: ModuleScope +│ +│ Defined at <no location info> +└ +| ++- ┌ +| │ C:HasField at HasFieldQueries.hs:1:1, of type: forall {k} (x :: k) r a. (r -> a) -> HasField x r a +| │ is a usage of an external evidence variable +| │ Defined in `GHC.Internal.Records' +| └ +| +`- ┌ + │ field1 at HasFieldQueries.hs:1:1, of type: Thing -> Char + │ is a usage of an external evidence variable + │ Defined at HasFieldQueries.hs:9:21 + └ + +========================== +At point (27,20), we found: +========================== +┌ +│ $dHasField at HasFieldQueries.hs:27:1-40, of type: HasField "nested1" r r +│ is an evidence variable bound by a let, depending on: [$dHasField] +│ with scope: LocalScope HasFieldQueries.hs:27:1-40 +│ bound at: HasFieldQueries.hs:27:1-40 +│ Defined at <no location info> +└ +| +`- ┌ + │ $dHasField at HasFieldQueries.hs:27:1-40, of type: HasField "nested1" r r + │ is an evidence variable bound by a type signature + │ with scope: LocalScope HasFieldQueries.hs:27:1-40 + │ bound at: HasFieldQueries.hs:27:1-40 + │ Defined at <no location info> + └ + +========================== +At point (27,28), we found: +========================== +┌ +│ $dHasField at HasFieldQueries.hs:27:1-40, of type: HasField "field2" r Bool +│ is an evidence variable bound by a let, depending on: [$dHasField] +│ with scope: LocalScope HasFieldQueries.hs:27:1-40 +│ bound at: HasFieldQueries.hs:27:1-40 +│ Defined at <no location info> +└ +| +`- ┌ + │ $dHasField at HasFieldQueries.hs:27:1-40, of type: HasField "field2" r Bool + │ is an evidence variable bound by a type signature + │ with scope: LocalScope HasFieldQueries.hs:27:1-40 + │ bound at: HasFieldQueries.hs:27:1-40 + │ Defined at <no location info> + └ + +========================== +At point (33,22), we found: +========================== +┌ +│ $dHasField at HasFieldQueries.hs:33:1-27, of type: HasField "field1" x Char +│ is an evidence variable bound by a let, depending on: [$dHasField] +│ with scope: LocalScope HasFieldQueries.hs:33:1-27 +│ bound at: HasFieldQueries.hs:33:1-27 +│ Defined at <no location info> +└ +| +`- ┌ + │ $dHasField at HasFieldQueries.hs:33:1-27, of type: HasField "field1" x Char + │ is an evidence variable bound by a HsWrapper + │ with scope: LocalScope HasFieldQueries.hs:33:1-27 + │ bound at: HasFieldQueries.hs:33:1-27 + │ Defined at <no location info> + └ + ===================================== testsuite/tests/hiefile/should_run/HieTypeable.hs ===================================== @@ -0,0 +1,28 @@ +module Main where + +import Data.Dynamic +import Data.Typeable +import TestUtils + +data Thing = Thing {field1 :: Char, field2 :: Bool} + deriving (Show, Eq) + +castFromDynamic :: Dynamic -> Maybe Thing +castFromDynamic d = fromDynamic d + -- ^ this is the point + +rep :: Thing -> TypeRep +rep d = typeOf d + -- ^ this is the point + +points = + [ (11,21) + , (15,10) + ] + +main = do + (df, hf) <- readTestHie "HieTypeable.hie" + let refmap = generateReferencesMap $ getAsts $ hie_asts hf + + traverse (explainEv df hf refmap) points + return () ===================================== testsuite/tests/hiefile/should_run/HieTypeable.stdout ===================================== @@ -0,0 +1,30 @@ +========================== +At point (11,21), we found: +========================== +┌ +│ $dTypeable at HieTypeable.hs:1:1, of type: Typeable Thing +│ is an evidence variable bound by a let, depending on: [$dTypeable] +│ with scope: ModuleScope +│ +│ Defined at <no location info> +└ +| +`- ┌ + │ $dTypeable at HieTypeable.hs:1:1, of type: Typeable Thing + │ is an evidence variable bound by a let, depending on: [] + │ with scope: ModuleScope + │ + │ Defined at <no location info> + └ + +========================== +At point (15,10), we found: +========================== +┌ +│ $dTypeable at HieTypeable.hs:1:1, of type: Typeable Thing +│ is an evidence variable bound by a let, depending on: [] +│ with scope: ModuleScope +│ +│ Defined at <no location info> +└ + ===================================== testsuite/tests/hiefile/should_run/RecordDotTypes.hs ===================================== @@ -22,6 +22,11 @@ x = MyRecord { a = "Hello", b = 12, c = MyChild { z = "there" } } y = x.a ++ show x.b ++ x.c.z -- ^ ^ ^ ^^ -- 1 2 3 45 +-- ^-^ ^-^ ^-^ +-- 6 7 8 +-- ^---^ +-- 9 + p1,p2,p3,p4 :: (Int,Int) p1 = (22,6) @@ -30,10 +35,19 @@ p3 = (22,25) p4 = (22,28) p5 = (22,29) +r6 = (p1, (22, 8)) +r7 = ((22,17), p2) +r8 = (p3, (22, 27)) +r9 = (p3, p5) + selectPoint' :: HieFile -> (Int,Int) -> HieAST Int selectPoint' hf loc = maybe (error "point not found") id $ selectPoint hf loc +selectRange' :: HieFile -> ((Int,Int), (Int, Int)) -> HieAST Int +selectRange' hf (s, e) = + maybe (error "range not found") id $ selectRange hf s e + main = do (df, hf) <- readTestHie "RecordDotTypes.hie" forM_ [p1,p2,p3,p4,p5] $ \point -> do @@ -41,3 +55,11 @@ main = do let types = concatMap nodeType $ getSourcedNodeInfo $ sourcedNodeInfo $ selectPoint' hf point forM_ types $ \typ -> do putStrLn (renderHieType df $ recoverFullType typ (hie_types hf)) + + forM_ [r6, r7, r8, r9] $ \range -> do + putStr $ "At " ++ showRange range ++ ", got type: " + let types = concatMap nodeType $ getSourcedNodeInfo $ sourcedNodeInfo $ selectRange' hf range + forM_ types $ \typ -> do + putStrLn (renderHieType df $ recoverFullType typ (hie_types hf)) + where + showRange (p1, p2) = show p1 ++ " - " ++ show p2 ===================================== testsuite/tests/hiefile/should_run/RecordDotTypes.stdout ===================================== @@ -1,5 +1,9 @@ At (22,6), got type: MyRecord -At (22,20), got type: Integer +At (22,20), got type: MyRecord -> Integer At (22,25), got type: MyRecord -At (22,28), got type: String -At (22,29), got type: String \ No newline at end of file +At (22,28), got type: MyChild -> [Char] +At (22,29), got type: MyChild -> [Char] +At (22,6) - (22,8), got type: [Char] +At (22,17) - (22,20), got type: Integer +At (22,25) - (22,27), got type: MyChild +At (22,25) - (22,29), got type: [Char] ===================================== testsuite/tests/hiefile/should_run/T23492.stdout ===================================== @@ -4,4 +4,4 @@ PartialFieldSelector At (18,7), got type: PartialFieldSelector -> Bool At (23,7), got type: PartialFieldSelector At (23,8), got type: PartialFieldSelector -At (23,9), got type: Bool +At (23,9), got type: PartialFieldSelector -> Bool ===================================== testsuite/tests/hiefile/should_run/all.T ===================================== @@ -10,3 +10,5 @@ test('T23120', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUti test('T24544', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info']) test('HieGadtConSigs', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info']) test('T25709', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info']) +test('HasFieldQueries', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info']) +test('HieTypeable', [extra_run_opts('"' + config.libdir + '"'), extra_files(['TestUtils.hs'])], compile_and_run, ['-package ghc -fwrite-ide-info']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bb8f0d262689a9ae75cd31cfe9a03a5... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bb8f0d262689a9ae75cd31cfe9a03a5... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help