From e4ba22c5306f48a4e88d9ffb8687a948570e0088 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Tue, 9 Mar 2021 14:28:19 -0800
Subject: [PATCH 01/15] Be much more intelligent about splitting matches

---
 ghcide/src/Development/IDE/GHC/ExactPrint.hs  | 175 ++++++++++++------
 plugins/hls-tactics-plugin/src/Wingman/GHC.hs |  13 +-
 .../hls-tactics-plugin/src/Wingman/Plugin.hs  | 121 +++---------
 .../hls-tactics-plugin/src/Wingman/Types.hs   |   3 +
 .../test/golden/AutoThetaFix.hs.expected      |   8 +-
 5 files changed, 158 insertions(+), 162 deletions(-)

diff --git a/ghcide/src/Development/IDE/GHC/ExactPrint.hs b/ghcide/src/Development/IDE/GHC/ExactPrint.hs
index 3688f80a82..ed58554b8c 100644
--- a/ghcide/src/Development/IDE/GHC/ExactPrint.hs
+++ b/ghcide/src/Development/IDE/GHC/ExactPrint.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP                #-}
 {-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE DerivingVia        #-}
 {-# LANGUAGE GADTs              #-}
 {-# LANGUAGE OverloadedStrings  #-}
 {-# LANGUAGE RankNTypes         #-}
@@ -10,10 +11,11 @@ module Development.IDE.GHC.ExactPrint
       graftDecls,
       graftDeclsWithM,
       annotate,
+      annotateDecl,
       hoistGraft,
       graftWithM,
-      graftWithSmallestM,
-      graftSmallestDecls,
+      genericGraftWithSmallestM,
+      genericGraftWithLargestM,
       graftSmallestDeclsWithM,
       transform,
       transformM,
@@ -27,6 +29,7 @@ module Development.IDE.GHC.ExactPrint
       TransformT,
       Anns,
       Annotate,
+      mkBindListT,
     )
 where
 
@@ -63,9 +66,11 @@ import Parser (parseIdentifier)
 import Data.Traversable (for)
 import Data.Foldable (Foldable(fold))
 import Data.Bool (bool)
-import Data.Monoid (All(All))
+import Data.Monoid (All(All), Any(Any))
+import Data.Functor.Compose (Compose(Compose))
 #if __GLASGOW_HASKELL__ == 808
 import Control.Arrow
+import Debug.Trace (traceM)
 #endif
 
 
@@ -104,6 +109,7 @@ newtype Graft m a = Graft
     { runGraft :: DynFlags -> a -> TransformT m a
     }
 
+
 hoistGraft :: (forall x. m x -> n x) -> Graft m a -> Graft n a
 hoistGraft h (Graft f) = Graft (fmap (hoistTransform h) . f)
 
@@ -286,30 +292,44 @@ graftWithM dst trans = Graft $ \dflags a -> do
         )
         a
 
-graftWithSmallestM ::
-    forall ast m a.
-    (Fail.MonadFail m, Data a, ASTElement ast) =>
+genericIsSubspan :: forall ast. Typeable ast => Proxy (Located ast) -> SrcSpan -> GenericQ (Maybe Bool)
+genericIsSubspan _ dst = mkQ Nothing $ \case
+  (L span _ :: Located ast) -> Just $ dst `isSubspanOf` span
+
+-- | Run the given transformation only on the smallest node in the tree that
+-- contains the 'SrcSpan'.
+genericGraftWithSmallestM ::
+    forall m a ast.
+    (Monad m, Data a, Typeable ast) =>
+    Proxy (Located ast) ->
     SrcSpan ->
-    (Located ast -> TransformT m (Maybe (Located ast))) ->
+    (DynFlags -> GenericM (TransformT m)) ->
     Graft m a
-graftWithSmallestM dst trans = Graft $ \dflags a -> do
-    everywhereM'
-        ( mkM $
-            \case
-                val@(L src _ :: Located ast)
-                    | dst `isSubspanOf` src -> do
-                        mval <- trans val
-                        case mval of
-                            Just val' -> do
-                                (anns, val'') <-
-                                    hoistTransform (either Fail.fail pure) $
-                                        annotate dflags True $ maybeParensAST val'
-                                modifyAnnsT $ mappend anns
-                                pure val''
-                            Nothing -> pure val
-                l -> pure l
-        )
-        a
+genericGraftWithSmallestM proxy dst trans = Graft $ \dflags ->
+    smallestM (genericIsSubspan proxy dst) (trans dflags)
+
+-- | Run the given transformation only on the largest node in the tree that
+-- contains the 'SrcSpan'.
+genericGraftWithLargestM ::
+    forall m a ast.
+    (Monad m, Data a, Typeable ast) =>
+    Proxy (Located ast) ->
+    SrcSpan ->
+    (DynFlags -> GenericM (TransformT m)) ->
+    Graft m a
+genericGraftWithLargestM proxy dst trans = Graft $ \dflags ->
+    largestM (genericIsSubspan proxy dst) (trans dflags)
+
+
+-- | Lift a function that replaces a value with several values into a generic
+-- function. The result doesn't perform any searching, so should be driven via
+-- 'everywhereM' or friends.
+mkBindListT :: forall b m. (Typeable b, Data b, Monad m) => (b -> m [b]) -> GenericM m
+mkBindListT f = mkM $ \case
+  (xs :: [b]) -> do
+    traceM $ "found something! " <> gshow xs
+    fmap join $ traverse f xs
+
 
 graftDecls ::
     forall a.
@@ -319,32 +339,13 @@ graftDecls ::
     Graft (Either String) a
 graftDecls dst decs0 = Graft $ \dflags a -> do
     decs <- forM decs0 $ \decl -> do
-        (anns, decl') <- annotateDecl dflags decl
-        modifyAnnsT $ mappend anns
-        pure decl'
+        annotateDecl dflags decl
     let go [] = DL.empty
         go (L src e : rest)
             | src == dst = DL.fromList decs <> DL.fromList rest
             | otherwise = DL.singleton (L src e) <> go rest
     modifyDeclsT (pure . DL.toList . go) a
 
-graftSmallestDecls ::
-    forall a.
-    (HasDecls a) =>
-    SrcSpan ->
-    [LHsDecl GhcPs] ->
-    Graft (Either String) a
-graftSmallestDecls dst decs0 = Graft $ \dflags a -> do
-    decs <- forM decs0 $ \decl -> do
-        (anns, decl') <- annotateDecl dflags decl
-        modifyAnnsT $ mappend anns
-        pure decl'
-    let go [] = DL.empty
-        go (L src e : rest)
-            | dst `isSubspanOf` src = DL.fromList decs <> DL.fromList rest
-            | otherwise = DL.singleton (L src e) <> go rest
-    modifyDeclsT (pure . DL.toList . go) a
-
 graftSmallestDeclsWithM ::
     forall a.
     (HasDecls a) =>
@@ -356,11 +357,8 @@ graftSmallestDeclsWithM dst toDecls = Graft $ \dflags a -> do
         go (e@(L src _) : rest)
             | dst `isSubspanOf` src = toDecls e >>= \case
                 Just decs0 -> do
-                    decs <- forM decs0 $ \decl -> do
-                        (anns, decl') <-
-                            annotateDecl dflags decl
-                        modifyAnnsT $ mappend anns
-                        pure decl'
+                    decs <- forM decs0 $ \decl ->
+                        annotateDecl dflags decl
                     pure $ DL.fromList decs <> DL.fromList rest
                 Nothing -> (DL.singleton e <>) <$> go rest
             | otherwise = (DL.singleton e <>) <$> go rest
@@ -377,12 +375,9 @@ graftDeclsWithM dst toDecls = Graft $ \dflags a -> do
         go (e@(L src _) : rest)
             | src == dst = toDecls e >>= \case
                 Just decs0 -> do
-                    decs <- forM decs0 $ \decl -> do
-                        (anns, decl') <-
-                            hoistTransform (either Fail.fail pure) $
-                            annotateDecl dflags decl
-                        modifyAnnsT $ mappend anns
-                        pure decl'
+                    decs <- forM decs0 $ \decl ->
+                        hoistTransform (either Fail.fail pure) $
+                          annotateDecl dflags decl
                     pure $ DL.fromList decs <> DL.fromList rest
                 Nothing -> (DL.singleton e <>) <$> go rest
             | otherwise = (DL.singleton e <>) <$> go rest
@@ -461,7 +456,7 @@ annotate dflags needs_space ast = do
     pure (anns', expr')
 
 -- | Given an 'LHsDecl', compute its exactprint annotations.
-annotateDecl :: DynFlags -> LHsDecl GhcPs -> TransformT (Either String) (Anns, LHsDecl GhcPs)
+annotateDecl :: DynFlags -> LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs)
 -- The 'parseDecl' function fails to parse 'FunBind' 'ValD's which contain
 -- multiple matches. To work around this, we split the single
 -- 'FunBind'-of-multiple-'Match'es into multiple 'FunBind's-of-one-'Match',
@@ -485,13 +480,15 @@ annotateDecl dflags
     let expr' = L src $ set_matches alts'
         anns'' = setPrecedingLines expr' 1 0 $ fold anns'
 
-    pure (anns'', expr')
+    modifyAnnsT $ mappend anns''
+    pure expr'
 annotateDecl dflags ast = do
     uniq <- show <$> uniqueSrcSpanT
     let rendered = render dflags ast
     (anns, expr') <- lift $ mapLeft show $ parseDecl dflags uniq rendered
     let anns' = setPrecedingLines expr' 1 0 anns
-    pure (anns', expr')
+    modifyAnnsT $ mappend anns'
+    pure expr'
 
 ------------------------------------------------------------------------------
 
@@ -504,3 +501,63 @@ render dflags = showSDoc dflags . ppr
 -- | Put parentheses around an expression if required.
 parenthesize :: LHsExpr GhcPs -> LHsExpr GhcPs
 parenthesize = parenthesizeHsExpr appPrec
+
+
+------------------------------------------------------------------------------
+-- Custom SYB machinery
+------------------------------------------------------------------------------
+
+-- | Generic monadic transformations that return side-channel data.
+type GenericMQ r m = forall a. Data a => a -> m (r, a)
+
+------------------------------------------------------------------------------
+-- | Apply the given 'GenericM' at all every node whose children fail the
+-- 'GenericQ', but which passes the query itself.
+smallestM :: forall m. Monad m => GenericQ (Maybe Bool) -> GenericM m -> GenericM m
+smallestM q f = fmap snd . go
+  where
+    go :: GenericMQ Any m
+    go x = do
+      case q x of
+        Nothing -> gmapMQ go x
+        Just True -> do
+          it@(r, x') <- gmapMQ go x
+          case r of
+            Any True -> pure it
+            Any False -> fmap (Any True,) $ f x'
+        Just False -> pure (mempty, x)
+
+------------------------------------------------------------------------------
+-- | Apply the given 'GenericM' at every node that passes the 'GenericQ', but
+-- don't descend into children if the query matches.
+largestM :: forall m. Monad m => GenericQ (Maybe Bool) -> GenericM m -> GenericM m
+largestM q f = go
+  where
+    go :: GenericM m
+    go x = do
+      case q x of
+        Just True -> f x
+        Just False -> pure x
+        Nothing -> gmapM go x
+
+newtype MonadicQuery r m a = MonadicQuery
+  { runMonadicQuery :: m (r, a)
+  }
+  deriving stock (Functor)
+  deriving Applicative via Compose m ((,) r)
+
+
+------------------------------------------------------------------------------
+-- | Like 'gmapM', but also returns side-channel data.
+gmapMQ ::
+    forall f r a. (Monoid r, Data a, Applicative f) =>
+    (forall d. Data d => d -> f (r, d)) ->
+    a ->
+    f (r, a)
+gmapMQ f = runMonadicQuery . gfoldl k pure
+  where
+    k :: Data d => MonadicQuery r f (d -> b) -> d -> MonadicQuery r f b
+    k c x = c <*> MonadicQuery (f x)
+
+
+
diff --git a/plugins/hls-tactics-plugin/src/Wingman/GHC.hs b/plugins/hls-tactics-plugin/src/Wingman/GHC.hs
index ccb68d1e5f..d4105f3555 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/GHC.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/GHC.hs
@@ -176,6 +176,14 @@ allOccNames = everything (<>) $ mkQ mempty $ \case
     a -> S.singleton a
 
 
+------------------------------------------------------------------------------
+-- | Unpack the relevant parts of a 'Match'
+pattern AMatch :: HsMatchContext (NameOrRdrName (IdP GhcPs)) -> [Pat GhcPs] -> HsExpr GhcPs -> Match GhcPs (LHsExpr GhcPs)
+pattern AMatch ctx pats body <-
+  Match { m_ctxt = ctx
+        , m_pats = fmap fromPatCompatPs -> pats
+        , m_grhss = UnguardedRHSs body
+        }
 
 
 ------------------------------------------------------------------------------
@@ -183,10 +191,7 @@ allOccNames = everything (<>) $ mkQ mempty $ \case
 pattern Lambda :: [Pat GhcPs] -> HsExpr GhcPs -> HsExpr GhcPs
 pattern Lambda pats body <-
   HsLam _
-    (MG {mg_alts = L _ [L _
-      (Match { m_pats = fmap fromPatCompatPs -> pats
-             , m_grhss = UnguardedRHSs body
-             })]})
+    (MG {mg_alts = L _ [L _ (AMatch _ pats body) ]})
   where
     -- If there are no patterns to bind, just stick in the body
     Lambda [] body   = body
diff --git a/plugins/hls-tactics-plugin/src/Wingman/Plugin.hs b/plugins/hls-tactics-plugin/src/Wingman/Plugin.hs
index d2c2df7e2b..9a1279a086 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/Plugin.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/Plugin.hs
@@ -7,21 +7,17 @@ module Wingman.Plugin
   , TacticCommand (..)
   ) where
 
-import           Bag (bagToList, listToBag)
 import           Control.Exception (evaluate)
 import           Control.Monad
 import           Control.Monad.Trans
 import           Control.Monad.Trans.Maybe
 import           Data.Aeson
 import           Data.Bifunctor (first)
-import           Data.Data (Data)
 import           Data.Foldable (for_)
-import           Data.Generics.Aliases (mkQ)
-import           Data.Generics.Schemes (everything)
+import           Data.Generics.Schemes (everywhereM)
 import           Data.Maybe
-import           Data.Monoid
+import           Data.Proxy (Proxy(..))
 import qualified Data.Text as T
-import           Data.Traversable
 import           Development.IDE.Core.Shake (IdeState (..))
 import           Development.IDE.GHC.Compat
 import           Development.IDE.GHC.ExactPrint
@@ -158,110 +154,39 @@ graftHole
     -> Graft (Either String) ParsedSource
 graftHole span rtr
   | _jIsTopHole (rtr_jdg rtr)
-      = graftSmallestDeclsWithM span
-      $ graftDecl span $ \pats ->
-        splitToDecl (fst $ last $ ctxDefiningFuncs $ rtr_ctx rtr)
-      $ iterateSplit
-      $ mkFirstAgda (fmap unXPat pats)
-      $ unLoc
-      $ rtr_extract rtr
+      = genericGraftWithSmallestM (Proxy @(Located [LMatch GhcPs (LHsExpr GhcPs)])) span $ \dflags ->
+        everywhereM
+          $ mkBindListT $ graftDecl dflags span $ \pats ->
+            splitToDecl (fst $ last $ ctxDefiningFuncs $ rtr_ctx rtr)
+          $ iterateSplit
+          $ mkFirstAgda (fmap unXPat pats)
+          $ unLoc
+          $ rtr_extract rtr
 graftHole span rtr
   = graft span
   $ rtr_extract rtr
 
 
-------------------------------------------------------------------------------
--- | Merge in the 'Match'es of a 'FunBind' into a 'HsDecl'. Used to perform
--- agda-style case splitting in which we need to separate one 'Match' into
--- many, without affecting any matches which might exist but don't need to be
--- split.
-mergeFunBindMatches
-    :: ([Pat GhcPs] -> LHsDecl GhcPs)
-    -> SrcSpan
-    -> HsBind GhcPs
-    -> Either String (HsBind GhcPs)
-mergeFunBindMatches make_decl span
-    (fb@FunBind {fun_matches = mg@MG {mg_alts = L alts_src alts}}) =
-  pure $ fb
-    { fun_matches = mg
-      { mg_alts = L alts_src $ do
-          alt@(L alt_src match) <- alts
-          case span `isSubspanOf` alt_src of
-            True -> do
-              let pats = fmap fromPatCompatPs $ m_pats match
-                  L _ (ValD _ (FunBind {fun_matches = MG
-                        {mg_alts = L _ to_add}})) = make_decl pats
-              to_add
-            False -> pure alt
-      }
-    }
-mergeFunBindMatches _ _ _ =
-  Left "mergeFunBindMatches: called on something that isnt a funbind"
-
-
-throwError :: String -> TransformT (Either String) a
-throwError = lift . Left
-
-
 ------------------------------------------------------------------------------
 -- | Helper function to route 'mergeFunBindMatches' into the right place in an
 -- AST --- correctly dealing with inserting into instance declarations.
 graftDecl
-    :: SrcSpan
+    :: DynFlags
+    -> SrcSpan
     -> ([Pat GhcPs] -> LHsDecl GhcPs)
-    -> LHsDecl GhcPs
-    -> TransformT (Either String) (Maybe [LHsDecl GhcPs])
-graftDecl span
-    make_decl
-    (L src (ValD ext fb))
-  = either throwError (pure . Just . pure . L src . ValD ext) $
-      mergeFunBindMatches make_decl span fb
--- TODO(sandy): add another case for default methods in class definitions
-graftDecl span
-    make_decl
-    (L src (InstD ext
-      cid@ClsInstD{cid_inst =
-        cidi@ClsInstDecl{cid_sigs = _sigs, cid_binds = binds}}))
-  = do
-      binds' <-
-        for (bagToList binds) $ \b@(L bsrc bind) -> do
-          case bind of
-            fb@FunBind{} | span `isSubspanOf` bsrc ->
-              either throwError (pure . L bsrc) $
-                mergeFunBindMatches make_decl span fb
-            _ -> pure b
-
-      pure $ Just $ pure $ L src $ InstD ext $ cid
-        { cid_inst = cidi
-          { cid_binds = listToBag binds'
-          }
-        }
-graftDecl span _ x = do
-  traceMX "biggest" $
-    unsafeRender $
-      locateBiggest @(Match GhcPs (LHsExpr GhcPs)) span x
-  traceMX "first" $
-    unsafeRender $
-      locateFirst @(Match GhcPs (LHsExpr GhcPs)) x
-  throwError "graftDecl: don't know about this AST form"
+    -> LMatch GhcPs (LHsExpr GhcPs)
+    -> TransformT (Either String) [LMatch GhcPs (LHsExpr GhcPs)]
+graftDecl dflags dst make_decl (L src (AMatch _ pats _))
+  | dst `isSubspanOf` src = do
+      L _ dec <- annotateDecl dflags $ make_decl pats
+      case dec of
+        ValD _ (FunBind { fun_matches = MG { mg_alts = L _ alts@(_:_)}
+                  }) -> do
+          pure alts
+        _ -> undefined
+graftDecl _ _ _ x = pure $ pure x
 
 
 fromMaybeT :: Functor m => a -> MaybeT m a -> m a
 fromMaybeT def = fmap (fromMaybe def) . runMaybeT
 
-
-locateBiggest :: (Data r, Data a) => SrcSpan -> a -> Maybe r
-locateBiggest ss x = getFirst $ everything (<>)
-  ( mkQ mempty $ \case
-    L span r | ss `isSubspanOf` span -> pure r
-    _                                -> mempty
-  ) x
-
-
-locateFirst :: (Data r, Data a) => a -> Maybe r
-locateFirst x = getFirst $ everything (<>)
-  ( mkQ mempty $ \case
-    r -> pure r
-  ) x
-
-
diff --git a/plugins/hls-tactics-plugin/src/Wingman/Types.hs b/plugins/hls-tactics-plugin/src/Wingman/Types.hs
index bc6e0a8290..ab8234deb6 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/Types.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/Types.hs
@@ -135,6 +135,9 @@ instance Show Class where
 instance Show (HsExpr GhcPs) where
   show  = unsafeRender
 
+instance Show (HsDecl GhcPs) where
+  show  = unsafeRender
+
 instance Show (Pat GhcPs) where
   show  = unsafeRender
 
diff --git a/plugins/hls-tactics-plugin/test/golden/AutoThetaFix.hs.expected b/plugins/hls-tactics-plugin/test/golden/AutoThetaFix.hs.expected
index 21a5b69691..db63e2bc18 100644
--- a/plugins/hls-tactics-plugin/test/golden/AutoThetaFix.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/AutoThetaFix.hs.expected
@@ -2,6 +2,12 @@
 {-# LANGUAGE UndecidableInstances #-}
 
 data Fix f a = Fix (f (Fix f a))
-instance (Functor f, Functor (Fix f)) => Functor (Fix f) where
+
+instance ( Functor f
+           -- FIXME(sandy): Unfortunately, the recursion tactic fails to fire
+           -- on this case. By explicitly adding the @Functor (Fix f)@
+           -- dictionary, we can get Wingman to generate the right definition.
+         , Functor (Fix f)
+         ) => Functor (Fix f) where
   fmap fab (Fix fffa) = Fix (fmap (fmap fab) fffa)
 

From b6b74c7b49d3a2f26b7888b0861d994ae49754f1 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Tue, 9 Mar 2021 14:39:25 -0800
Subject: [PATCH 02/15] Add some tests

---
 .../test/CodeAction/DestructSpec.hs                | 10 ++++++----
 .../test/golden/LayoutSplitClass.hs                |  4 ++++
 .../test/golden/LayoutSplitClass.hs.expected       |  5 +++++
 .../test/golden/LayoutSplitWhere.hs                | 12 ++++++++++++
 .../test/golden/LayoutSplitWhere.hs.expected       | 14 ++++++++++++++
 5 files changed, 41 insertions(+), 4 deletions(-)
 create mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutSplitClass.hs
 create mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutSplitClass.hs.expected
 create mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutSplitWhere.hs
 create mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutSplitWhere.hs.expected

diff --git a/plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs b/plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs
index 2757f3b56a..ff071af662 100644
--- a/plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs
+++ b/plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs
@@ -22,8 +22,10 @@ spec = do
     destructTest "a"    7 25 "SplitPattern.hs"
 
   describe "layout" $ do
-    destructTest "b" 4  3 "LayoutBind.hs"
-    destructTest "b" 2 15 "LayoutDollarApp.hs"
-    destructTest "b" 2 18 "LayoutOpApp.hs"
-    destructTest "b" 2 14 "LayoutLam.hs"
+    destructTest "b"  4  3 "LayoutBind.hs"
+    destructTest "b"  2 15 "LayoutDollarApp.hs"
+    destructTest "b"  2 18 "LayoutOpApp.hs"
+    destructTest "b"  2 14 "LayoutLam.hs"
+    destructTest "x" 11 15 "LayoutSplitWhere.hs"
+    destructTest "x"  3 12 "LayoutSplitClass.hs"
 
diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutSplitClass.hs b/plugins/hls-tactics-plugin/test/golden/LayoutSplitClass.hs
new file mode 100644
index 0000000000..c082169c7b
--- /dev/null
+++ b/plugins/hls-tactics-plugin/test/golden/LayoutSplitClass.hs
@@ -0,0 +1,4 @@
+class Test a where
+  test :: Bool -> a
+  test x = _
+
diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutSplitClass.hs.expected b/plugins/hls-tactics-plugin/test/golden/LayoutSplitClass.hs.expected
new file mode 100644
index 0000000000..a1e34d3db6
--- /dev/null
+++ b/plugins/hls-tactics-plugin/test/golden/LayoutSplitClass.hs.expected
@@ -0,0 +1,5 @@
+class Test a where
+  test :: Bool -> a
+  test False = _
+  test True = _
+
diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutSplitWhere.hs b/plugins/hls-tactics-plugin/test/golden/LayoutSplitWhere.hs
new file mode 100644
index 0000000000..5035df1b0c
--- /dev/null
+++ b/plugins/hls-tactics-plugin/test/golden/LayoutSplitWhere.hs
@@ -0,0 +1,12 @@
+data A = A | B | C
+
+some :: A -> IO ()
+some a = do
+    foo
+    bar a
+  where
+      foo = putStrLn "Hi"
+
+      bar :: A -> IO ()
+      bar x = _
+
diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutSplitWhere.hs.expected b/plugins/hls-tactics-plugin/test/golden/LayoutSplitWhere.hs.expected
new file mode 100644
index 0000000000..43c45a4b2f
--- /dev/null
+++ b/plugins/hls-tactics-plugin/test/golden/LayoutSplitWhere.hs.expected
@@ -0,0 +1,14 @@
+data A = A | B | C
+
+some :: A -> IO ()
+some a = do
+    foo
+    bar a
+  where
+      foo = putStrLn "Hi"
+
+      bar :: A -> IO ()
+      some A = _
+      some B = _
+      some C = _
+

From e997648ffd5072217ae1e35d52ec416726194cd7 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Tue, 9 Mar 2021 14:43:09 -0800
Subject: [PATCH 03/15] Hlint makes my life worse

---
 ghcide/src/Development/IDE/GHC/ExactPrint.hs | 12 +++++-------
 1 file changed, 5 insertions(+), 7 deletions(-)

diff --git a/ghcide/src/Development/IDE/GHC/ExactPrint.hs b/ghcide/src/Development/IDE/GHC/ExactPrint.hs
index ed58554b8c..76f3bf87f4 100644
--- a/ghcide/src/Development/IDE/GHC/ExactPrint.hs
+++ b/ghcide/src/Development/IDE/GHC/ExactPrint.hs
@@ -1,10 +1,8 @@
-{-# LANGUAGE CPP                #-}
-{-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE DerivingVia        #-}
-{-# LANGUAGE GADTs              #-}
-{-# LANGUAGE OverloadedStrings  #-}
-{-# LANGUAGE RankNTypes         #-}
-{-# LANGUAGE TypeFamilies       #-}
+{-# LANGUAGE CPP          #-}
+{-# LANGUAGE DerivingVia  #-}
+{-# LANGUAGE GADTs        #-}
+{-# LANGUAGE RankNTypes   #-}
+{-# LANGUAGE TypeFamilies #-}
 
 module Development.IDE.GHC.ExactPrint
     ( Graft(..),

From ec455539dcd9958a43e33ddd6687cdb63babdfb4 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Tue, 9 Mar 2021 15:30:49 -0800
Subject: [PATCH 04/15] I fixed the build

---
 ghcide/src/Development/IDE/GHC/ExactPrint.hs | 7 +------
 1 file changed, 1 insertion(+), 6 deletions(-)

diff --git a/ghcide/src/Development/IDE/GHC/ExactPrint.hs b/ghcide/src/Development/IDE/GHC/ExactPrint.hs
index 76f3bf87f4..39e5d96201 100644
--- a/ghcide/src/Development/IDE/GHC/ExactPrint.hs
+++ b/ghcide/src/Development/IDE/GHC/ExactPrint.hs
@@ -68,7 +68,6 @@ import Data.Monoid (All(All), Any(Any))
 import Data.Functor.Compose (Compose(Compose))
 #if __GLASGOW_HASKELL__ == 808
 import Control.Arrow
-import Debug.Trace (traceM)
 #endif
 
 
@@ -107,7 +106,6 @@ newtype Graft m a = Graft
     { runGraft :: DynFlags -> a -> TransformT m a
     }
 
-
 hoistGraft :: (forall x. m x -> n x) -> Graft m a -> Graft n a
 hoistGraft h (Graft f) = Graft (fmap (hoistTransform h) . f)
 
@@ -323,10 +321,7 @@ genericGraftWithLargestM proxy dst trans = Graft $ \dflags ->
 -- function. The result doesn't perform any searching, so should be driven via
 -- 'everywhereM' or friends.
 mkBindListT :: forall b m. (Typeable b, Data b, Monad m) => (b -> m [b]) -> GenericM m
-mkBindListT f = mkM $ \case
-  (xs :: [b]) -> do
-    traceM $ "found something! " <> gshow xs
-    fmap join $ traverse f xs
+mkBindListT f = mkM $ fmap join . traverse f
 
 
 graftDecls ::

From ca46858fed221d3c3fa924565021d297c2ed0b30 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Tue, 9 Mar 2021 16:38:28 -0800
Subject: [PATCH 05/15] Correctly case split on let bindings

---
 ghcide/src/Development/IDE/GHC/ExactPrint.hs           |  2 --
 plugins/hls-tactics-plugin/src/Wingman/Plugin.hs       | 10 +++++-----
 .../hls-tactics-plugin/test/CodeAction/DestructSpec.hs |  2 ++
 .../hls-tactics-plugin/test/golden/LayoutSplitGuard.hs |  3 +++
 .../test/golden/LayoutSplitGuard.hs.expected           |  5 +++++
 .../hls-tactics-plugin/test/golden/LayoutSplitLet.hs   |  6 ++++++
 .../test/golden/LayoutSplitLet.hs.expected             |  7 +++++++
 7 files changed, 28 insertions(+), 7 deletions(-)
 create mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutSplitGuard.hs
 create mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutSplitGuard.hs.expected
 create mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutSplitLet.hs
 create mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutSplitLet.hs.expected

diff --git a/ghcide/src/Development/IDE/GHC/ExactPrint.hs b/ghcide/src/Development/IDE/GHC/ExactPrint.hs
index 39e5d96201..73ee9d1bdd 100644
--- a/ghcide/src/Development/IDE/GHC/ExactPrint.hs
+++ b/ghcide/src/Development/IDE/GHC/ExactPrint.hs
@@ -552,5 +552,3 @@ gmapMQ f = runMonadicQuery . gfoldl k pure
     k :: Data d => MonadicQuery r f (d -> b) -> d -> MonadicQuery r f b
     k c x = c <*> MonadicQuery (f x)
 
-
-
diff --git a/plugins/hls-tactics-plugin/src/Wingman/Plugin.hs b/plugins/hls-tactics-plugin/src/Wingman/Plugin.hs
index 9a1279a086..05e18e5734 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/Plugin.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/Plugin.hs
@@ -156,8 +156,8 @@ graftHole span rtr
   | _jIsTopHole (rtr_jdg rtr)
       = genericGraftWithSmallestM (Proxy @(Located [LMatch GhcPs (LHsExpr GhcPs)])) span $ \dflags ->
         everywhereM
-          $ mkBindListT $ graftDecl dflags span $ \pats ->
-            splitToDecl (fst $ last $ ctxDefiningFuncs $ rtr_ctx rtr)
+          $ mkBindListT $ graftDecl dflags span $ \name pats ->
+            splitToDecl (occName name)
           $ iterateSplit
           $ mkFirstAgda (fmap unXPat pats)
           $ unLoc
@@ -173,12 +173,12 @@ graftHole span rtr
 graftDecl
     :: DynFlags
     -> SrcSpan
-    -> ([Pat GhcPs] -> LHsDecl GhcPs)
+    -> (RdrName -> [Pat GhcPs] -> LHsDecl GhcPs)
     -> LMatch GhcPs (LHsExpr GhcPs)
     -> TransformT (Either String) [LMatch GhcPs (LHsExpr GhcPs)]
-graftDecl dflags dst make_decl (L src (AMatch _ pats _))
+graftDecl dflags dst make_decl (L src (AMatch (FunRhs (L _ name) _ _) pats _))
   | dst `isSubspanOf` src = do
-      L _ dec <- annotateDecl dflags $ make_decl pats
+      L _ dec <- annotateDecl dflags $ make_decl name pats
       case dec of
         ValD _ (FunBind { fun_matches = MG { mg_alts = L _ alts@(_:_)}
                   }) -> do
diff --git a/plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs b/plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs
index ff071af662..49ff186c95 100644
--- a/plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs
+++ b/plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs
@@ -28,4 +28,6 @@ spec = do
     destructTest "b"  2 14 "LayoutLam.hs"
     destructTest "x" 11 15 "LayoutSplitWhere.hs"
     destructTest "x"  3 12 "LayoutSplitClass.hs"
+    destructTest "b"  3  9 "LayoutSplitGuard.hs"
+    destructTest "b"  4 13 "LayoutSplitLet.hs"
 
diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutSplitGuard.hs b/plugins/hls-tactics-plugin/test/golden/LayoutSplitGuard.hs
new file mode 100644
index 0000000000..be2d0d30f5
--- /dev/null
+++ b/plugins/hls-tactics-plugin/test/golden/LayoutSplitGuard.hs
@@ -0,0 +1,3 @@
+test :: Bool -> Bool -> Bool
+test a b
+  | a = _
diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutSplitGuard.hs.expected b/plugins/hls-tactics-plugin/test/golden/LayoutSplitGuard.hs.expected
new file mode 100644
index 0000000000..3d68d8ac96
--- /dev/null
+++ b/plugins/hls-tactics-plugin/test/golden/LayoutSplitGuard.hs.expected
@@ -0,0 +1,5 @@
+test :: Bool -> Bool -> Bool
+test a b
+  | a = (case b of
+   False -> _
+   True -> _)
diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutSplitLet.hs b/plugins/hls-tactics-plugin/test/golden/LayoutSplitLet.hs
new file mode 100644
index 0000000000..71529d7dd3
--- /dev/null
+++ b/plugins/hls-tactics-plugin/test/golden/LayoutSplitLet.hs
@@ -0,0 +1,6 @@
+test :: a
+test =
+  let t :: Bool -> a
+      t b = _
+   in _
+
diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutSplitLet.hs.expected b/plugins/hls-tactics-plugin/test/golden/LayoutSplitLet.hs.expected
new file mode 100644
index 0000000000..a042cb3b13
--- /dev/null
+++ b/plugins/hls-tactics-plugin/test/golden/LayoutSplitLet.hs.expected
@@ -0,0 +1,7 @@
+test :: a
+test =
+  let t :: Bool -> a
+      t False = _
+      t True = _
+   in _
+

From e2a6b48b2c2ca3d4d6ec8265c9b911833fc10688 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Tue, 9 Mar 2021 16:46:14 -0800
Subject: [PATCH 06/15] Fix a missing space on grafting let..in

---
 ghcide/src/Development/IDE/GHC/ExactPrint.hs                 | 2 +-
 plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs   | 1 +
 plugins/hls-tactics-plugin/test/golden/LayoutSplitIn.hs      | 5 +++++
 .../hls-tactics-plugin/test/golden/LayoutSplitIn.hs.expected | 5 +++++
 4 files changed, 12 insertions(+), 1 deletion(-)
 create mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutSplitIn.hs
 create mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutSplitIn.hs.expected

diff --git a/ghcide/src/Development/IDE/GHC/ExactPrint.hs b/ghcide/src/Development/IDE/GHC/ExactPrint.hs
index 73ee9d1bdd..48e1e49937 100644
--- a/ghcide/src/Development/IDE/GHC/ExactPrint.hs
+++ b/ghcide/src/Development/IDE/GHC/ExactPrint.hs
@@ -197,7 +197,7 @@ needsParensSpace ExplicitSum{}   = (All False, All False)
 needsParensSpace HsCase{}        = (All False, All False)
 needsParensSpace HsIf{}          = (All False, All False)
 needsParensSpace HsMultiIf{}     = (All False, All False)
-needsParensSpace HsLet{}         = (All False, All False)
+needsParensSpace HsLet{}         = (All False, All True)
 needsParensSpace HsDo{}          = (All False, All False)
 needsParensSpace ExplicitList{}  = (All False, All False)
 needsParensSpace RecordCon{}     = (All False, All False)
diff --git a/plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs b/plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs
index 49ff186c95..7c86fcee90 100644
--- a/plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs
+++ b/plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs
@@ -30,4 +30,5 @@ spec = do
     destructTest "x"  3 12 "LayoutSplitClass.hs"
     destructTest "b"  3  9 "LayoutSplitGuard.hs"
     destructTest "b"  4 13 "LayoutSplitLet.hs"
+    destructTest "a"  4  7 "LayoutSplitIn.hs"
 
diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutSplitIn.hs b/plugins/hls-tactics-plugin/test/golden/LayoutSplitIn.hs
new file mode 100644
index 0000000000..ce6e0341c4
--- /dev/null
+++ b/plugins/hls-tactics-plugin/test/golden/LayoutSplitIn.hs
@@ -0,0 +1,5 @@
+test :: a
+test =
+  let a = (1,"bbb")
+   in _
+
diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutSplitIn.hs.expected b/plugins/hls-tactics-plugin/test/golden/LayoutSplitIn.hs.expected
new file mode 100644
index 0000000000..f6f3ffceab
--- /dev/null
+++ b/plugins/hls-tactics-plugin/test/golden/LayoutSplitIn.hs.expected
@@ -0,0 +1,5 @@
+test :: a
+test =
+  let a = (1,"bbb")
+   in case a of { (i, l_c) -> _ }
+

From a53f5db953c46342d2f19b947ecc2316d5c05384 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Tue, 9 Mar 2021 16:50:00 -0800
Subject: [PATCH 07/15] Add view pattern layout test

---
 plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs  | 1 +
 .../hls-tactics-plugin/test/golden/LayoutSplitViewPat.hs    | 5 +++++
 .../test/golden/LayoutSplitViewPat.hs.expected              | 6 ++++++
 3 files changed, 12 insertions(+)
 create mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutSplitViewPat.hs
 create mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutSplitViewPat.hs.expected

diff --git a/plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs b/plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs
index 7c86fcee90..d8b145dbda 100644
--- a/plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs
+++ b/plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs
@@ -31,4 +31,5 @@ spec = do
     destructTest "b"  3  9 "LayoutSplitGuard.hs"
     destructTest "b"  4 13 "LayoutSplitLet.hs"
     destructTest "a"  4  7 "LayoutSplitIn.hs"
+    destructTest "a"  4 31 "LayoutSplitViewPat.hs"
 
diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutSplitViewPat.hs b/plugins/hls-tactics-plugin/test/golden/LayoutSplitViewPat.hs
new file mode 100644
index 0000000000..6baed55abd
--- /dev/null
+++ b/plugins/hls-tactics-plugin/test/golden/LayoutSplitViewPat.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE ViewPatterns #-}
+
+splitLookup :: [(Int, String)] -> String
+splitLookup (lookup 5 -> a) = _
+
diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutSplitViewPat.hs.expected b/plugins/hls-tactics-plugin/test/golden/LayoutSplitViewPat.hs.expected
new file mode 100644
index 0000000000..81d49a4ff7
--- /dev/null
+++ b/plugins/hls-tactics-plugin/test/golden/LayoutSplitViewPat.hs.expected
@@ -0,0 +1,6 @@
+{-# LANGUAGE ViewPatterns #-}
+
+splitLookup :: [(Int, String)] -> String
+splitLookup (lookup 5 -> Nothing) = _
+splitLookup (lookup 5 -> (Just l_c)) = _
+

From f6e6735cc26e44b5ec7d68ce726f509635c3273a Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Tue, 9 Mar 2021 16:57:38 -0800
Subject: [PATCH 08/15] Add haddock to ExactPrint

---
 ghcide/src/Development/IDE/GHC/ExactPrint.hs | 25 +++++++++++++++++++-
 1 file changed, 24 insertions(+), 1 deletion(-)

diff --git a/ghcide/src/Development/IDE/GHC/ExactPrint.hs b/ghcide/src/Development/IDE/GHC/ExactPrint.hs
index 48e1e49937..abcd309f50 100644
--- a/ghcide/src/Development/IDE/GHC/ExactPrint.hs
+++ b/ghcide/src/Development/IDE/GHC/ExactPrint.hs
@@ -288,7 +288,18 @@ graftWithM dst trans = Graft $ \dflags a -> do
         )
         a
 
-genericIsSubspan :: forall ast. Typeable ast => Proxy (Located ast) -> SrcSpan -> GenericQ (Maybe Bool)
+-- | A generic query intended to be used for calling 'smallestM' and
+-- 'largestM'. If the current node is a 'Located', returns whether or not the
+-- given 'SrcSpan' is a subspan. For all other nodes, returns 'Nothing', which
+-- indicates uncertainty. The search strategy in 'smallestM' et al. will
+-- continue searching uncertain nodes.
+genericIsSubspan ::
+    forall ast.
+    Typeable ast =>
+    -- | The type of nodes we'd like to consider.
+    Proxy (Located ast) ->
+    SrcSpan ->
+    GenericQ (Maybe Bool)
 genericIsSubspan _ dst = mkQ Nothing $ \case
   (L span _ :: Located ast) -> Just $ dst `isSubspanOf` span
 
@@ -297,6 +308,7 @@ genericIsSubspan _ dst = mkQ Nothing $ \case
 genericGraftWithSmallestM ::
     forall m a ast.
     (Monad m, Data a, Typeable ast) =>
+    -- | The type of nodes we'd like to consider when finding the smallest.
     Proxy (Located ast) ->
     SrcSpan ->
     (DynFlags -> GenericM (TransformT m)) ->
@@ -309,6 +321,7 @@ genericGraftWithSmallestM proxy dst trans = Graft $ \dflags ->
 genericGraftWithLargestM ::
     forall m a ast.
     (Monad m, Data a, Typeable ast) =>
+    -- | The type of nodes we'd like to consider when finding the largest.
     Proxy (Located ast) ->
     SrcSpan ->
     (DynFlags -> GenericM (TransformT m)) ->
@@ -506,6 +519,11 @@ type GenericMQ r m = forall a. Data a => a -> m (r, a)
 ------------------------------------------------------------------------------
 -- | Apply the given 'GenericM' at all every node whose children fail the
 -- 'GenericQ', but which passes the query itself.
+--
+-- Why is the query a @Maybe Bool@? The GHC AST intersperses 'Located' nodes
+-- with data nodes, so for any given node we can only definitely return an
+-- answer if it's a 'Located'. See 'genericIsSubspan' for how this parameter is
+-- used.
 smallestM :: forall m. Monad m => GenericQ (Maybe Bool) -> GenericM m -> GenericM m
 smallestM q f = fmap snd . go
   where
@@ -523,6 +541,11 @@ smallestM q f = fmap snd . go
 ------------------------------------------------------------------------------
 -- | Apply the given 'GenericM' at every node that passes the 'GenericQ', but
 -- don't descend into children if the query matches.
+--
+-- Why is the query a @Maybe Bool@? The GHC AST intersperses 'Located' nodes
+-- with data nodes, so for any given node we can only definitely return an
+-- answer if it's a 'Located'. See 'genericIsSubspan' for how this parameter is
+-- used.
 largestM :: forall m. Monad m => GenericQ (Maybe Bool) -> GenericM m -> GenericM m
 largestM q f = go
   where

From a910592bfea17f68f5240f7a0293aea303f30fd7 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Tue, 9 Mar 2021 16:59:49 -0800
Subject: [PATCH 09/15] Remove a call to undefined

---
 plugins/hls-tactics-plugin/src/Wingman/Plugin.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/plugins/hls-tactics-plugin/src/Wingman/Plugin.hs b/plugins/hls-tactics-plugin/src/Wingman/Plugin.hs
index 05e18e5734..f11e5ac522 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/Plugin.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/Plugin.hs
@@ -183,7 +183,7 @@ graftDecl dflags dst make_decl (L src (AMatch (FunRhs (L _ name) _ _) pats _))
         ValD _ (FunBind { fun_matches = MG { mg_alts = L _ alts@(_:_)}
                   }) -> do
           pure alts
-        _ -> undefined
+        _ -> lift $ Left "annotateDecl didn't produce a funbind"
 graftDecl _ _ _ x = pure $ pure x
 
 

From d4761db532146641006f325d3540a3377b8c0569 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Tue, 9 Mar 2021 17:09:39 -0800
Subject: [PATCH 10/15] Add test for pattern synonym splits

---
 .../hls-tactics-plugin/test/CodeAction/DestructSpec.hs   | 1 +
 .../hls-tactics-plugin/test/golden/LayoutSplitPattern.hs | 8 ++++++++
 .../test/golden/LayoutSplitPattern.hs.expected           | 9 +++++++++
 3 files changed, 18 insertions(+)
 create mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutSplitPattern.hs
 create mode 100644 plugins/hls-tactics-plugin/test/golden/LayoutSplitPattern.hs.expected

diff --git a/plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs b/plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs
index d8b145dbda..e5c6636b3a 100644
--- a/plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs
+++ b/plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs
@@ -32,4 +32,5 @@ spec = do
     destructTest "b"  4 13 "LayoutSplitLet.hs"
     destructTest "a"  4  7 "LayoutSplitIn.hs"
     destructTest "a"  4 31 "LayoutSplitViewPat.hs"
+    destructTest "a"  7 17 "LayoutSplitPattern.hs"
 
diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutSplitPattern.hs b/plugins/hls-tactics-plugin/test/golden/LayoutSplitPattern.hs
new file mode 100644
index 0000000000..3cabb3c64b
--- /dev/null
+++ b/plugins/hls-tactics-plugin/test/golden/LayoutSplitPattern.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE PatternSynonyms #-}
+
+pattern Blah :: a -> Maybe a
+pattern Blah a = Just a
+
+test :: Maybe Bool -> a
+test (Blah a) = _
+
diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutSplitPattern.hs.expected b/plugins/hls-tactics-plugin/test/golden/LayoutSplitPattern.hs.expected
new file mode 100644
index 0000000000..e99d112e6f
--- /dev/null
+++ b/plugins/hls-tactics-plugin/test/golden/LayoutSplitPattern.hs.expected
@@ -0,0 +1,9 @@
+{-# LANGUAGE PatternSynonyms #-}
+
+pattern Blah :: a -> Maybe a
+pattern Blah a = Just a
+
+test :: Maybe Bool -> a
+test (Blah False) = _
+test (Blah True) = _
+

From 62dd6c2a64818ed53412ca7c846061402f44a940 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Tue, 9 Mar 2021 23:06:57 -0800
Subject: [PATCH 11/15] Fix subtly broken old tests

---
 .../test/golden/GoldenFmapTree.hs.expected               | 5 +++--
 .../test/golden/GoldenIdentityFunctor.hs.expected        | 2 +-
 .../test/golden/LayoutSplitWhere.hs.expected             | 6 +++---
 .../test/golden/SplitPattern.hs.expected                 | 9 ++++-----
 4 files changed, 11 insertions(+), 11 deletions(-)

diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenFmapTree.hs.expected b/plugins/hls-tactics-plugin/test/golden/GoldenFmapTree.hs.expected
index 64eef825fa..8f20041e20 100644
--- a/plugins/hls-tactics-plugin/test/golden/GoldenFmapTree.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/GoldenFmapTree.hs.expected
@@ -1,4 +1,5 @@
 data Tree a = Leaf a | Branch (Tree a) (Tree a)
+
 instance Functor Tree where
-  fmap fab (Leaf a) = Leaf (fab a)
-  fmap fab (Branch ta2 ta3) = Branch (fmap fab ta2) (fmap fab ta3)
+   fmap fab (Leaf a) = Leaf (fab a)
+   fmap fab (Branch ta2 ta3) = Branch (fmap fab ta2) (fmap fab ta3)
diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenIdentityFunctor.hs.expected b/plugins/hls-tactics-plugin/test/golden/GoldenIdentityFunctor.hs.expected
index 757bc8347a..5c509d6507 100644
--- a/plugins/hls-tactics-plugin/test/golden/GoldenIdentityFunctor.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/GoldenIdentityFunctor.hs.expected
@@ -1,3 +1,3 @@
 data Ident a = Ident a
 instance Functor Ident where
-  fmap fab (Ident a) = Ident (fab a)
+   fmap fab (Ident a) = Ident (fab a)
diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutSplitWhere.hs.expected b/plugins/hls-tactics-plugin/test/golden/LayoutSplitWhere.hs.expected
index 43c45a4b2f..a6150ce53e 100644
--- a/plugins/hls-tactics-plugin/test/golden/LayoutSplitWhere.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/LayoutSplitWhere.hs.expected
@@ -8,7 +8,7 @@ some a = do
       foo = putStrLn "Hi"
 
       bar :: A -> IO ()
-      some A = _
-      some B = _
-      some C = _
+      bar A = _
+      bar B = _
+      bar C = _
 
diff --git a/plugins/hls-tactics-plugin/test/golden/SplitPattern.hs.expected b/plugins/hls-tactics-plugin/test/golden/SplitPattern.hs.expected
index 8fe407a304..267f3a35ee 100644
--- a/plugins/hls-tactics-plugin/test/golden/SplitPattern.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/SplitPattern.hs.expected
@@ -1,12 +1,11 @@
 data ADT = One | Two Int | Three | Four Bool ADT | Five
 
 case_split :: ADT -> Int
-case_split One = _
-case_split (Two i) = _
-case_split Three = _
-case_split (Four b One) = _
+case_split One        = _
+case_split (Two i)    = _
+case_split Three      = _case_split (Four b One) = _
 case_split (Four b (Two i)) = _
 case_split (Four b Three) = _
 case_split (Four b (Four b3 a4)) = _
 case_split (Four b Five) = _
-case_split Five = _
+case_split Five       = _

From b23e6d67d0a199e12cfc94b572cc9d2b21b3a6c5 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Tue, 9 Mar 2021 23:18:24 -0800
Subject: [PATCH 12/15] Insert a line before the first match instead of the
 decl

---
 ghcide/src/Development/IDE/GHC/ExactPrint.hs          | 11 ++++-------
 .../test/golden/SplitPattern.hs.expected              |  3 ++-
 2 files changed, 6 insertions(+), 8 deletions(-)

diff --git a/ghcide/src/Development/IDE/GHC/ExactPrint.hs b/ghcide/src/Development/IDE/GHC/ExactPrint.hs
index abcd309f50..a5e9d9173b 100644
--- a/ghcide/src/Development/IDE/GHC/ExactPrint.hs
+++ b/ghcide/src/Development/IDE/GHC/ExactPrint.hs
@@ -475,19 +475,16 @@ annotateDecl dflags
     let set_matches matches =
           ValD ext fb { fun_matches = mg { mg_alts = L alt_src matches }}
 
-    (anns', alts') <- fmap unzip $ for (zip [0..] alts) $ \(ix :: Int, alt) -> do
+    (anns', alts') <- fmap unzip $ for alts $ \alt -> do
       uniq <- show <$> uniqueSrcSpanT
       let rendered = render dflags $ set_matches [alt]
       lift (mapLeft show $ parseDecl dflags uniq rendered) >>= \case
         (ann, L _ (ValD _ FunBind { fun_matches = MG { mg_alts = L _ [alt']}}))
-           -> pure (bool id (setPrecedingLines alt' 1 0) (ix /= 0) ann, alt')
+           -> pure (setPrecedingLines alt' 1 0 ann, alt')
         _ ->  lift $ Left "annotateDecl: didn't parse a single FunBind match"
 
-    let expr' = L src $ set_matches alts'
-        anns'' = setPrecedingLines expr' 1 0 $ fold anns'
-
-    modifyAnnsT $ mappend anns''
-    pure expr'
+    modifyAnnsT $ mappend $ fold anns'
+    pure $ L src $ set_matches alts'
 annotateDecl dflags ast = do
     uniq <- show <$> uniqueSrcSpanT
     let rendered = render dflags ast
diff --git a/plugins/hls-tactics-plugin/test/golden/SplitPattern.hs.expected b/plugins/hls-tactics-plugin/test/golden/SplitPattern.hs.expected
index 267f3a35ee..44d98f1fbd 100644
--- a/plugins/hls-tactics-plugin/test/golden/SplitPattern.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/SplitPattern.hs.expected
@@ -3,7 +3,8 @@ data ADT = One | Two Int | Three | Four Bool ADT | Five
 case_split :: ADT -> Int
 case_split One        = _
 case_split (Two i)    = _
-case_split Three      = _case_split (Four b One) = _
+case_split Three      = _
+case_split (Four b One) = _
 case_split (Four b (Two i)) = _
 case_split (Four b Three) = _
 case_split (Four b (Four b3 a4)) = _

From 70b1ac239290df977bd9cf46a1fc4e62d73c2f09 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Wed, 10 Mar 2021 00:02:49 -0800
Subject: [PATCH 13/15] Fix a bug in newline placement for middle matches

---
 ghcide/src/Development/IDE/GHC/ExactPrint.hs  |  8 +++++--
 .../hls-tactics-plugin/src/Wingman/Plugin.hs  | 21 +++++++++++++------
 2 files changed, 21 insertions(+), 8 deletions(-)

diff --git a/ghcide/src/Development/IDE/GHC/ExactPrint.hs b/ghcide/src/Development/IDE/GHC/ExactPrint.hs
index a5e9d9173b..59e3fcb43f 100644
--- a/ghcide/src/Development/IDE/GHC/ExactPrint.hs
+++ b/ghcide/src/Development/IDE/GHC/ExactPrint.hs
@@ -28,6 +28,8 @@ module Development.IDE.GHC.ExactPrint
       Anns,
       Annotate,
       mkBindListT,
+      setPrecedingLinesT,
+      everywhereM',
     )
 where
 
@@ -333,8 +335,10 @@ genericGraftWithLargestM proxy dst trans = Graft $ \dflags ->
 -- | Lift a function that replaces a value with several values into a generic
 -- function. The result doesn't perform any searching, so should be driven via
 -- 'everywhereM' or friends.
-mkBindListT :: forall b m. (Typeable b, Data b, Monad m) => (b -> m [b]) -> GenericM m
-mkBindListT f = mkM $ fmap join . traverse f
+--
+-- The 'Int' argument is the index in the list being bound.
+mkBindListT :: forall b m. (Typeable b, Data b, Monad m) => (Int -> b -> m [b]) -> GenericM m
+mkBindListT f = mkM $ fmap join . traverse (uncurry f) . zip [0..]
 
 
 graftDecls ::
diff --git a/plugins/hls-tactics-plugin/src/Wingman/Plugin.hs b/plugins/hls-tactics-plugin/src/Wingman/Plugin.hs
index f11e5ac522..80fdafe9a9 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/Plugin.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/Plugin.hs
@@ -14,7 +14,6 @@ import           Control.Monad.Trans.Maybe
 import           Data.Aeson
 import           Data.Bifunctor (first)
 import           Data.Foldable (for_)
-import           Data.Generics.Schemes (everywhereM)
 import           Data.Maybe
 import           Data.Proxy (Proxy(..))
 import qualified Data.Text as T
@@ -155,8 +154,9 @@ graftHole
 graftHole span rtr
   | _jIsTopHole (rtr_jdg rtr)
       = genericGraftWithSmallestM (Proxy @(Located [LMatch GhcPs (LHsExpr GhcPs)])) span $ \dflags ->
-        everywhereM
-          $ mkBindListT $ graftDecl dflags span $ \name pats ->
+        everywhereM'
+          $ mkBindListT $ \ix ->
+            graftDecl dflags span ix $ \name pats ->
             splitToDecl (occName name)
           $ iterateSplit
           $ mkFirstAgda (fmap unXPat pats)
@@ -173,18 +173,27 @@ graftHole span rtr
 graftDecl
     :: DynFlags
     -> SrcSpan
+    -> Int
     -> (RdrName -> [Pat GhcPs] -> LHsDecl GhcPs)
     -> LMatch GhcPs (LHsExpr GhcPs)
     -> TransformT (Either String) [LMatch GhcPs (LHsExpr GhcPs)]
-graftDecl dflags dst make_decl (L src (AMatch (FunRhs (L _ name) _ _) pats _))
+graftDecl dflags dst ix make_decl (L src (AMatch (FunRhs (L _ name) _ _) pats _))
   | dst `isSubspanOf` src = do
       L _ dec <- annotateDecl dflags $ make_decl name pats
       case dec of
-        ValD _ (FunBind { fun_matches = MG { mg_alts = L _ alts@(_:_)}
+        ValD _ (FunBind { fun_matches = MG { mg_alts = L _ alts@(first_match : _)}
                   }) -> do
+          -- For whatever reason, ExactPrint annotates newlines to the ends of
+          -- case matches and type signatures, but only allows us to insert
+          -- them at the beginning of those things. Thus, we need want to
+          -- insert a preceeding newline (done in 'annotateDecl') on all
+          -- matches, except for the first one --- since it gets its newline
+          -- from the line above.
+          when (ix == 0) $
+            setPrecedingLinesT first_match 0 0
           pure alts
         _ -> lift $ Left "annotateDecl didn't produce a funbind"
-graftDecl _ _ _ x = pure $ pure x
+graftDecl _ _ _ _ x = pure $ pure x
 
 
 fromMaybeT :: Functor m => a -> MaybeT m a -> m a

From 5190a2f96e525b20b1637a53459eb967fa8b461c Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Wed, 10 Mar 2021 00:03:08 -0800
Subject: [PATCH 14/15] Add note on monotonicity

---
 ghcide/src/Development/IDE/GHC/ExactPrint.hs | 8 ++++++++
 1 file changed, 8 insertions(+)

diff --git a/ghcide/src/Development/IDE/GHC/ExactPrint.hs b/ghcide/src/Development/IDE/GHC/ExactPrint.hs
index 59e3fcb43f..d9d41d4084 100644
--- a/ghcide/src/Development/IDE/GHC/ExactPrint.hs
+++ b/ghcide/src/Development/IDE/GHC/ExactPrint.hs
@@ -521,6 +521,10 @@ type GenericMQ r m = forall a. Data a => a -> m (r, a)
 -- | Apply the given 'GenericM' at all every node whose children fail the
 -- 'GenericQ', but which passes the query itself.
 --
+-- The query must be a monotonic function when it returns 'Just'. That is, if
+-- @s@ is a subtree of @t@, @q t@ should return @Just True@ if @q s@ does. It
+-- is the True-to-false edge of the query that triggers the transformation.
+--
 -- Why is the query a @Maybe Bool@? The GHC AST intersperses 'Located' nodes
 -- with data nodes, so for any given node we can only definitely return an
 -- answer if it's a 'Located'. See 'genericIsSubspan' for how this parameter is
@@ -543,6 +547,10 @@ smallestM q f = fmap snd . go
 -- | Apply the given 'GenericM' at every node that passes the 'GenericQ', but
 -- don't descend into children if the query matches.
 --
+-- The query must be a monotonic function when it returns 'Just'. That is, if
+-- @s@ is a subtree of @t@, @q t@ should return @Just True@ if @q s@ does. It
+-- is the True-to-false edge of the query that triggers the transformation.
+--
 -- Why is the query a @Maybe Bool@? The GHC AST intersperses 'Located' nodes
 -- with data nodes, so for any given node we can only definitely return an
 -- answer if it's a 'Located'. See 'genericIsSubspan' for how this parameter is

From c8beffba95476fe54200fcfd840657205c4b4810 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Wed, 10 Mar 2021 07:43:41 -0800
Subject: [PATCH 15/15] Slightly adjust the wording on largestM

---
 ghcide/src/Development/IDE/GHC/ExactPrint.hs | 8 +++-----
 1 file changed, 3 insertions(+), 5 deletions(-)

diff --git a/ghcide/src/Development/IDE/GHC/ExactPrint.hs b/ghcide/src/Development/IDE/GHC/ExactPrint.hs
index d9d41d4084..13ec409ab0 100644
--- a/ghcide/src/Development/IDE/GHC/ExactPrint.hs
+++ b/ghcide/src/Development/IDE/GHC/ExactPrint.hs
@@ -545,11 +545,9 @@ smallestM q f = fmap snd . go
 
 ------------------------------------------------------------------------------
 -- | Apply the given 'GenericM' at every node that passes the 'GenericQ', but
--- don't descend into children if the query matches.
---
--- The query must be a monotonic function when it returns 'Just'. That is, if
--- @s@ is a subtree of @t@, @q t@ should return @Just True@ if @q s@ does. It
--- is the True-to-false edge of the query that triggers the transformation.
+-- don't descend into children if the query matches. Because this traversal is
+-- root-first, this policy will find the largest subtrees for which the query
+-- holds true.
 --
 -- Why is the query a @Maybe Bool@? The GHC AST intersperses 'Located' nodes
 -- with data nodes, so for any given node we can only definitely return an