Wingman: case split on punned record fields (#1739)

* Fix #1736

* Use PatCompat

Author: isovector

plugins/hls-tactics-plugin/src/Wingman/CaseSplit.hs

@@ -56,9 +56,17 @@ wildifyT (S.map occNameString -> used) = everywhere $ mkT $ \case
 ------------------------------------------------------------------------------
 -- | Replace a 'VarPat' with the given @'Pat' GhcPs@.
 rewriteVarPat :: Data a => RdrName -> Pat GhcPs -> a -> a
-rewriteVarPat name rep = everywhere $ mkT $ \case
-  VarPat _ (L _ var) | eqRdrName name var -> rep
-  (x :: Pat GhcPs)                        -> x
+rewriteVarPat name rep = everywhere $
+  mkT (\case
+    VarPat _ (L _ var) | eqRdrName name var -> rep
+    (x :: Pat GhcPs)                        -> x
+      )
+  `extT` \case
+    HsRecField lbl _ True
+      | eqRdrName name $ unLoc $ rdrNameFieldOcc $ unLoc lbl
+          -> HsRecField lbl (toPatCompat rep) False
+    (x :: HsRecField' (FieldOcc GhcPs) (PatCompat GhcPs)) -> x
+
 
 
 ------------------------------------------------------------------------------

plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs

@@ -20,6 +20,7 @@ spec = do
     destructTest "gadt" 7 17 "GoldenGADTDestruct.hs"
     destructTest "gadt" 8 17 "GoldenGADTDestructCoercion.hs"
     destructTest "a"    7 25 "SplitPattern.hs"
+    destructTest "a"    6 18 "DestructPun.hs"
 
   describe "layout" $ do
     destructTest "b"  4  3 "LayoutBind.hs"

plugins/hls-tactics-plugin/test/golden/DestructPun.hs

@@ -0,0 +1,7 @@
+{-# LANGUAGE NamedFieldPuns #-}
+
+
+data Foo = Foo { a :: Bool, b :: Bool }
+
+foo Foo {a, b} = _
+

plugins/hls-tactics-plugin/test/golden/DestructPun.hs.expected

@@ -0,0 +1,8 @@
+{-# LANGUAGE NamedFieldPuns #-}
+
+
+data Foo = Foo { a :: Bool, b :: Bool }
+
+foo Foo {a = False, b} = _
+foo Foo {a = True, b} = _
+