From 93248820ecf27a75fcd559957aa0ef212fdca338 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Mon, 21 Jun 2021 10:01:15 -0700
Subject: [PATCH 1/2] Support empty lambdacase

---
 ghcide/src/Development/IDE/GHC/ExactPrint.hs  |  2 +-
 .../src/Wingman/EmptyCase.hs                  | 23 ++++++++++++++++---
 plugins/hls-tactics-plugin/src/Wingman/GHC.hs |  7 ++++++
 3 files changed, 28 insertions(+), 4 deletions(-)

diff --git a/ghcide/src/Development/IDE/GHC/ExactPrint.hs b/ghcide/src/Development/IDE/GHC/ExactPrint.hs
index b231044bc5..fa1c576205 100644
--- a/ghcide/src/Development/IDE/GHC/ExactPrint.hs
+++ b/ghcide/src/Development/IDE/GHC/ExactPrint.hs
@@ -188,7 +188,7 @@ needsParensSpace ::
     -- | (Needs parens, needs space)
     (All, All)
 needsParensSpace HsLam{}         = (All False, All False)
-needsParensSpace HsLamCase{}     = (All False, All False)
+needsParensSpace HsLamCase{}     = (All False, All True)
 needsParensSpace HsApp{}         = mempty
 needsParensSpace HsAppType{}     = mempty
 needsParensSpace OpApp{}         = mempty
diff --git a/plugins/hls-tactics-plugin/src/Wingman/EmptyCase.hs b/plugins/hls-tactics-plugin/src/Wingman/EmptyCase.hs
index bcaac35207..7087709607 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/EmptyCase.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/EmptyCase.hs
@@ -93,6 +93,13 @@ codeLensProvider state plId (CodeLensParams _ _ (TextDocumentIdentifier uri))
 codeLensProvider _ _ _ = pure $ Right $ List []
 
 
+scrutinzedType :: EmptyCaseSort Type -> Maybe Type
+scrutinzedType (EmptyCase ty) = pure  ty
+scrutinzedType (EmptyLamCase ty) =
+  case tacticsSplitFunTy ty of
+    (_, _, tys, _) -> listToMaybe  tys
+
+
 ------------------------------------------------------------------------------
 -- | The description for the empty case lens.
 mkEmptyCaseLensDesc :: Type -> T.Text
@@ -119,6 +126,8 @@ graftMatchGroup ss l =
   hoistGraft (runExcept . runExceptString) $ graftExprWithM ss $ \case
     L span (HsCase ext scrut mg@_) -> do
       pure $ Just $ L span $ HsCase ext scrut $ mg { mg_alts = l }
+    L span (HsLamCase ext mg@_) -> do
+      pure $ Just $ L span $ HsLamCase ext $ mg { mg_alts = l }
     (_ :: LHsExpr GhcPs) -> pure Nothing
 
 
@@ -142,18 +151,26 @@ emptyCaseScrutinees state nfp = do
 
     let scrutinees = traverse (emptyCaseQ . tcg_binds) tcg
     for scrutinees $ \aged@(unTrack -> (ss, scrutinee)) -> do
-      ty <- MaybeT $ typeCheck (hscEnv $ untrackedStaleValue hscenv) tcg' scrutinee
+      ty <- MaybeT
+          . fmap (scrutinzedType <=< sequence)
+          . traverse (typeCheck (hscEnv $ untrackedStaleValue hscenv) tcg')
+          $ scrutinee
       case ss of
         RealSrcSpan r   -> do
           rss' <- liftMaybe $ mapAgeTo tcg_map $ unsafeCopyAge aged r
           pure (rss', ty)
         UnhelpfulSpan _ -> empty
 
+data EmptyCaseSort a
+  = EmptyCase a
+  | EmptyLamCase a
+  deriving (Eq, Ord, Show, Functor, Foldable, Traversable)
 
 ------------------------------------------------------------------------------
 -- | Get the 'SrcSpan' and scrutinee of every empty case.
-emptyCaseQ :: GenericQ [(SrcSpan, HsExpr GhcTc)]
+emptyCaseQ :: GenericQ [(SrcSpan, EmptyCaseSort (HsExpr GhcTc))]
 emptyCaseQ = everything (<>) $ mkQ mempty $ \case
-  L new_span (Case scrutinee []) -> pure (new_span, scrutinee)
+  L new_span (Case scrutinee []) -> pure (new_span, EmptyCase scrutinee)
+  L new_span (expr@(LamCase [])) -> pure (new_span, EmptyLamCase expr)
   (_ :: LHsExpr GhcTc) -> mempty
 
diff --git a/plugins/hls-tactics-plugin/src/Wingman/GHC.hs b/plugins/hls-tactics-plugin/src/Wingman/GHC.hs
index da4a5e6642..c79711fdb4 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/GHC.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/GHC.hs
@@ -252,6 +252,13 @@ pattern Case scrutinee matches <-
   HsCase _ (L _ scrutinee)
     (MG {mg_alts = L _ (fmap unLoc -> unpackMatches -> Just matches)})
 
+------------------------------------------------------------------------------
+-- | Like 'Case', but for lambda cases.
+pattern LamCase :: PatCompattable p => [(Pat p, LHsExpr p)] -> HsExpr p
+pattern LamCase matches <-
+  HsLamCase _
+    (MG {mg_alts = L _ (fmap unLoc -> unpackMatches -> Just matches)})
+
 
 ------------------------------------------------------------------------------
 -- | Can ths type be lambda-cased?

From b62b43cdaf7b096e4c043e3c18ac133d063b8198 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Mon, 21 Jun 2021 10:03:51 -0700
Subject: [PATCH 2/2] Add test

---
 plugins/hls-tactics-plugin/test/CodeLens/EmptyCaseSpec.hs   | 1 +
 .../test/golden/EmptyCaseLamCase.expected.hs                | 6 ++++++
 plugins/hls-tactics-plugin/test/golden/EmptyCaseLamCase.hs  | 4 ++++
 3 files changed, 11 insertions(+)
 create mode 100644 plugins/hls-tactics-plugin/test/golden/EmptyCaseLamCase.expected.hs
 create mode 100644 plugins/hls-tactics-plugin/test/golden/EmptyCaseLamCase.hs

diff --git a/plugins/hls-tactics-plugin/test/CodeLens/EmptyCaseSpec.hs b/plugins/hls-tactics-plugin/test/CodeLens/EmptyCaseSpec.hs
index cda80ab5d7..ce7a6b60df 100644
--- a/plugins/hls-tactics-plugin/test/CodeLens/EmptyCaseSpec.hs
+++ b/plugins/hls-tactics-plugin/test/CodeLens/EmptyCaseSpec.hs
@@ -17,4 +17,5 @@ spec = do
     test "EmptyCaseNested"
     test "EmptyCaseApply"
     test "EmptyCaseGADT"
+    test "EmptyCaseLamCase"
 
diff --git a/plugins/hls-tactics-plugin/test/golden/EmptyCaseLamCase.expected.hs b/plugins/hls-tactics-plugin/test/golden/EmptyCaseLamCase.expected.hs
new file mode 100644
index 0000000000..048f437368
--- /dev/null
+++ b/plugins/hls-tactics-plugin/test/golden/EmptyCaseLamCase.expected.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE LambdaCase #-}
+
+test :: Bool -> Bool
+test = \case
+  False -> _
+  True -> _
diff --git a/plugins/hls-tactics-plugin/test/golden/EmptyCaseLamCase.hs b/plugins/hls-tactics-plugin/test/golden/EmptyCaseLamCase.hs
new file mode 100644
index 0000000000..ef490eb751
--- /dev/null
+++ b/plugins/hls-tactics-plugin/test/golden/EmptyCaseLamCase.hs
@@ -0,0 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
+
+test :: Bool -> Bool
+test = \case