From 972b0d4d06637f199d0fb2436fc35fb531155fc5 Mon Sep 17 00:00:00 2001 From: "Michal J. Gajda" Date: Sun, 19 Apr 2026 19:09:13 +0200 Subject: [PATCH] Fix: preserve type applications in record patterns (fixes #1679) When suggesting record patterns, check if the constructor has meaningful type applications (e.g. @Int, @Type). Type applications can be removed only if there are no type arguments, or all type arguments are wildcards (@_). This prevents HLint from suggesting invalid transformations that would remove necessary type information. Examples: Ast.AstScatterS @_ @shn1 @shp1 _ _ _ _ _ -> Suggests: Ast.AstScatterS {} (wildcards can be omitted) Ast.AstScatterS @A @shn1 @shp1 _ _ _ _ _ -> No suggestion (meaningful type apps must be preserved) Test cases: - foo (Bar _ _ _ _) = x -> suggests Bar{} - foo (Bar @_ _ _ _) = x -> suggests Bar{} (@_ is redundant) - foo (Bar @Int _ _ _) = x -> no suggestion (type app preserved) --- src/Hint/Pattern.hs | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/src/Hint/Pattern.hs b/src/Hint/Pattern.hs index 1b642547..9bf08014 100644 --- a/src/Hint/Pattern.hs +++ b/src/Hint/Pattern.hs @@ -198,9 +198,19 @@ asPattern (L loc x) = concatMap decl (universeBi x) -- First Bool is if 'Strict' is a language extension. Second Bool is -- if this pattern in this context is going to be evaluated strictly. +-- Check if a type argument is just a wildcard (can be omitted) +-- Returns True only if the type arg is @_ or similar wildcard notation +isWildcardTypeArg :: HsConPatTyArg GhcPs -> Bool +isWildcardTypeArg tyarg = + let s = unsafePrettyPrint tyarg + -- Normalize: remove whitespace and check if it becomes just "_" + normalized = filter (not . (`elem` " \t\n")) s + in normalized == "_" || normalized == "@_" + patHint :: Bool -> Bool -> LPat GhcPs -> [Idea] -patHint _ _ o@(L _ (ConPat _ name (PrefixCon _ args))) - | length args >= 3 && all isPWildcard args = +patHint _ _ o@(L _ (ConPat _ name (PrefixCon tyargs args))) + | all isWildcardTypeArg tyargs -- Only suggest if all type args are wildcards (or none) + , length args >= 3 && all isPWildcard args = let rec_fields = HsRecFields noExtField [] Nothing :: HsRecFields GhcPs (LPat GhcPs) new = noLocA $ ConPat noAnn name (RecCon rec_fields) :: LPat GhcPs in