From 9038baee1737d106ca72feacd5336f340bf7aed4 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Thu, 11 Feb 2021 13:54:23 -0800
Subject: [PATCH 01/15] More tests of overlapping methods

---
 test/functional/Tactic.hs                      | 3 +++
 test/testdata/tactic/Fgmap.hs                  | 2 ++
 test/testdata/tactic/Fgmap.hs.expected         | 2 ++
 test/testdata/tactic/FmapJoin.hs               | 2 ++
 test/testdata/tactic/FmapJoin.hs.expected      | 2 ++
 test/testdata/tactic/FmapJoinInLet.hs          | 4 ++++
 test/testdata/tactic/FmapJoinInLet.hs.expected | 4 ++++
 7 files changed, 19 insertions(+)
 create mode 100644 test/testdata/tactic/Fgmap.hs
 create mode 100644 test/testdata/tactic/Fgmap.hs.expected
 create mode 100644 test/testdata/tactic/FmapJoin.hs
 create mode 100644 test/testdata/tactic/FmapJoin.hs.expected
 create mode 100644 test/testdata/tactic/FmapJoinInLet.hs
 create mode 100644 test/testdata/tactic/FmapJoinInLet.hs.expected

diff --git a/test/functional/Tactic.hs b/test/functional/Tactic.hs
index 6e33a96a90..d46dc8ff29 100644
--- a/test/functional/Tactic.hs
+++ b/test/functional/Tactic.hs
@@ -117,6 +117,9 @@ tests = testGroup
   , expectFail "GoldenFish.hs"              5 18 Auto ""
   , goldenTest "GoldenArbitrary.hs"         25 13 Auto ""
   , goldenTest "FmapBoth.hs"                2 12 Auto ""
+  , goldenTest "FmapJoin.hs"                2 14 Auto ""
+  , goldenTest "Fgmap.hs"                   2 9  Auto ""
+  , goldenTest "FmapJoinInLet.hs"           4 19 Auto ""
   ]
 
 
diff --git a/test/testdata/tactic/Fgmap.hs b/test/testdata/tactic/Fgmap.hs
new file mode 100644
index 0000000000..de1968474e
--- /dev/null
+++ b/test/testdata/tactic/Fgmap.hs
@@ -0,0 +1,2 @@
+fgmap :: (Functor f, Functor g) => (a -> b) -> (f (g a) -> f (g b))
+fgmap = _
diff --git a/test/testdata/tactic/Fgmap.hs.expected b/test/testdata/tactic/Fgmap.hs.expected
new file mode 100644
index 0000000000..98345b23c9
--- /dev/null
+++ b/test/testdata/tactic/Fgmap.hs.expected
@@ -0,0 +1,2 @@
+fgmap :: (Functor f, Functor g) => (a -> b) -> (f (g a) -> f (g b))
+fgmap = (\ fab fga -> fmap (\ a -> fmap fab a) fga)
diff --git a/test/testdata/tactic/FmapJoin.hs b/test/testdata/tactic/FmapJoin.hs
new file mode 100644
index 0000000000..98a40133ea
--- /dev/null
+++ b/test/testdata/tactic/FmapJoin.hs
@@ -0,0 +1,2 @@
+fJoin :: (Monad m, Monad f) => f (m (m a)) -> f (m a)
+fJoin = fmap _
diff --git a/test/testdata/tactic/FmapJoin.hs.expected b/test/testdata/tactic/FmapJoin.hs.expected
new file mode 100644
index 0000000000..733e090b72
--- /dev/null
+++ b/test/testdata/tactic/FmapJoin.hs.expected
@@ -0,0 +1,2 @@
+fJoin :: (Monad m, Monad f) => f (m (m a)) -> f (m a)
+fJoin = fmap (\ mma -> (>>=) mma (\ ma -> ma))
diff --git a/test/testdata/tactic/FmapJoinInLet.hs b/test/testdata/tactic/FmapJoinInLet.hs
new file mode 100644
index 0000000000..e6fe6cbd0d
--- /dev/null
+++ b/test/testdata/tactic/FmapJoinInLet.hs
@@ -0,0 +1,4 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+fJoin :: forall f m a. (Monad m, Monad f) => f (m (m a)) -> f (m a)
+fJoin =  let f = (_ :: m (m a) -> m a) in fmap f
diff --git a/test/testdata/tactic/FmapJoinInLet.hs.expected b/test/testdata/tactic/FmapJoinInLet.hs.expected
new file mode 100644
index 0000000000..b8bf0cdd07
--- /dev/null
+++ b/test/testdata/tactic/FmapJoinInLet.hs.expected
@@ -0,0 +1,4 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+fJoin :: forall f m a. (Monad m, Monad f) => f (m (m a)) -> f (m a)
+fJoin =  let f = ( (\ mma -> (>>=) mma (\ ma -> ma)) :: m (m a) -> m a) in fmap f

From b9b3aefc30befe1e3eae17d62da505279a907fa7 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Thu, 11 Feb 2021 15:57:17 -0800
Subject: [PATCH 02/15] Do a simplification pass of the extract

---
 .../hls-tactics-plugin.cabal                  |  1 +
 .../src/Ide/Plugin/Tactic.hs                  |  1 +
 .../src/Ide/Plugin/Tactic/Machinery.hs        |  3 +-
 .../src/Ide/Plugin/Tactic/Simplify.hs         | 82 +++++++++++++++++++
 .../src/Ide/Plugin/Tactic/Types.hs            |  3 +
 test/testdata/tactic/Fgmap.hs.expected        |  2 +-
 test/testdata/tactic/FmapJoin.hs.expected     |  2 +-
 .../testdata/tactic/FmapJoinInLet.hs.expected |  2 +-
 .../tactic/GoldenIdTypeFam.hs.expected        |  2 +-
 .../tactic/GoldenShowCompose.hs.expected      |  2 +-
 10 files changed, 94 insertions(+), 6 deletions(-)
 create mode 100644 plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs

diff --git a/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal b/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal
index 393d1f8cd4..23b11e545f 100644
--- a/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal
+++ b/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal
@@ -34,6 +34,7 @@ library
     Ide.Plugin.Tactic.Machinery
     Ide.Plugin.Tactic.Naming
     Ide.Plugin.Tactic.Range
+    Ide.Plugin.Tactic.Simplify
     Ide.Plugin.Tactic.Tactics
     Ide.Plugin.Tactic.Types
     Ide.Plugin.Tactic.TestTypes
diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic.hs
index 5182161f25..a261080aab 100644
--- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic.hs
+++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic.hs
@@ -327,6 +327,7 @@ tacticCmd tac lf state (TacticParams uri range var_name)
                 $ ResponseError InvalidRequest (T.pack $ show err) Nothing
             Right rtr -> do
               traceMX "solns" $ rtr_other_solns rtr
+              traceMX "after simplification" $ rtr_extract rtr
               let g = graft (RealSrcSpan span) $ rtr_extract rtr
                   response = transform dflags (clientCapabilities lf) uri g pm
               pure $ case response of
diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Machinery.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Machinery.hs
index dd307da2ca..53be6d0e05 100644
--- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Machinery.hs
+++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Machinery.hs
@@ -41,6 +41,7 @@ import           Refinery.Tactic.Internal
 import           TcType
 import           Type
 import           Unify
+import Ide.Plugin.Tactic.Simplify (simplify)
 
 
 substCTy :: TCvSubst -> CType -> CType
@@ -97,7 +98,7 @@ runTactic ctx jdg t =
         case sorted of
           (((tr, ext), _) : _) ->
             Right
-              . RunTacticResults tr ext
+              . RunTacticResults tr (simplify ext)
               . reverse
               . fmap fst
               $ take 5 sorted
diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs
new file mode 100644
index 0000000000..92c32ab28e
--- /dev/null
+++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs
@@ -0,0 +1,82 @@
+{-# LANGUAGE LambdaCase          #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE PatternSynonyms     #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ViewPatterns        #-}
+
+module Ide.Plugin.Tactic.Simplify
+  ( simplify
+  ) where
+
+import Data.Data (Data)
+import Data.Generics (everywhere, somewhere, something, listify, extT, mkT, GenericT, mkQ)
+import Data.List.Extra (unsnoc)
+import Data.Maybe (isJust)
+import Development.IDE.GHC.Compat
+import GHC.Exts (fromString)
+import GHC.SourceGen (var, op)
+import GHC.SourceGen.Expr (lambda)
+
+
+pattern Lambda :: [Pat GhcPs] -> HsExpr GhcPs -> HsExpr GhcPs
+pattern Lambda pats body <-
+  HsLam _
+    (MG {mg_alts = L _ [L _
+      (Match { m_pats = pats
+             , m_grhss = GRHSs {grhssGRHSs = [L _ (
+                 GRHS _ [] (L _ body))]}
+             })]})
+  where
+    Lambda [] body   = body
+    Lambda pats body = lambda pats body
+
+
+simplify :: LHsExpr GhcPs -> LHsExpr GhcPs
+simplify = head . drop 3 . iterate (everywhere compose . everywhere etaReduce)
+
+
+contains :: Data a => RdrName -> a -> Bool
+contains name x = not $ null $ listify (
+  \case
+    ((HsVar _ (L _ a)) :: HsExpr GhcPs) | a == name -> True
+    _ -> False
+  ) x
+
+
+etaReduce :: GenericT
+etaReduce = mkT $ \case
+  Lambda
+      [VarPat _ (L _ pat)]
+      (HsVar _ (L _ a)) | pat == a ->
+    var "id"
+  Lambda
+      (unsnoc -> Just (pats, (VarPat _ (L _ pat))))
+      (HsApp _ (L _ f) (L _ (HsVar _ (L _ a))))
+      | pat == a
+      , not (contains pat f) ->
+    Lambda pats f
+  x -> x
+
+
+compose :: GenericT
+compose = mkT $ \case
+  Lambda
+      (unsnoc -> Just (pats, (VarPat _ (L _ pat))))
+      (unroll -> (fs@(_:_), (HsVar _ (L _ a))))
+      | pat == a
+      , not (contains pat fs) ->
+    Lambda pats (foldr1 (infixCall ".") fs)
+  x -> x
+
+
+infixCall :: String -> HsExpr GhcPs -> HsExpr GhcPs -> HsExpr GhcPs
+infixCall s = flip op (fromString s)
+
+
+unroll :: HsExpr GhcPs -> ([HsExpr GhcPs], HsExpr GhcPs)
+unroll (HsPar _ (L _ x)) = unroll x
+unroll (HsApp _ (L _ f) (L _ a)) =
+  let (fs, r) = unroll a
+   in (f : fs, r)
+unroll x = ([], x)
+
diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Types.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Types.hs
index ac0ab3dff1..a60049de48 100644
--- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Types.hs
+++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Types.hs
@@ -70,6 +70,9 @@ instance Show DataCon where
 instance Show Class where
   show  = unsafeRender
 
+instance Show (HsExpr GhcPs) where
+  show  = unsafeRender
+
 
 ------------------------------------------------------------------------------
 data TacticState = TacticState
diff --git a/test/testdata/tactic/Fgmap.hs.expected b/test/testdata/tactic/Fgmap.hs.expected
index 98345b23c9..8c0b9a2f4a 100644
--- a/test/testdata/tactic/Fgmap.hs.expected
+++ b/test/testdata/tactic/Fgmap.hs.expected
@@ -1,2 +1,2 @@
 fgmap :: (Functor f, Functor g) => (a -> b) -> (f (g a) -> f (g b))
-fgmap = (\ fab fga -> fmap (\ a -> fmap fab a) fga)
+fgmap = (fmap . fmap)
diff --git a/test/testdata/tactic/FmapJoin.hs.expected b/test/testdata/tactic/FmapJoin.hs.expected
index 733e090b72..d7734b82cb 100644
--- a/test/testdata/tactic/FmapJoin.hs.expected
+++ b/test/testdata/tactic/FmapJoin.hs.expected
@@ -1,2 +1,2 @@
 fJoin :: (Monad m, Monad f) => f (m (m a)) -> f (m a)
-fJoin = fmap (\ mma -> (>>=) mma (\ ma -> ma))
+fJoin = fmap (\ mma -> (>>=) mma (id))
diff --git a/test/testdata/tactic/FmapJoinInLet.hs.expected b/test/testdata/tactic/FmapJoinInLet.hs.expected
index b8bf0cdd07..e6175f9493 100644
--- a/test/testdata/tactic/FmapJoinInLet.hs.expected
+++ b/test/testdata/tactic/FmapJoinInLet.hs.expected
@@ -1,4 +1,4 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 
 fJoin :: forall f m a. (Monad m, Monad f) => f (m (m a)) -> f (m a)
-fJoin =  let f = ( (\ mma -> (>>=) mma (\ ma -> ma)) :: m (m a) -> m a) in fmap f
+fJoin =  let f = ( (\ mma -> (>>=) mma (id)) :: m (m a) -> m a) in fmap f
diff --git a/test/testdata/tactic/GoldenIdTypeFam.hs.expected b/test/testdata/tactic/GoldenIdTypeFam.hs.expected
index ad5697334e..7b3d1beda0 100644
--- a/test/testdata/tactic/GoldenIdTypeFam.hs.expected
+++ b/test/testdata/tactic/GoldenIdTypeFam.hs.expected
@@ -4,4 +4,4 @@ type family TyFam
 type instance TyFam = Int
 
 tyblah' :: TyFam -> Int
-tyblah' = (\ i -> i)
+tyblah' = id
diff --git a/test/testdata/tactic/GoldenShowCompose.hs.expected b/test/testdata/tactic/GoldenShowCompose.hs.expected
index 373ea6af91..e672cc6a02 100644
--- a/test/testdata/tactic/GoldenShowCompose.hs.expected
+++ b/test/testdata/tactic/GoldenShowCompose.hs.expected
@@ -1,2 +1,2 @@
 showCompose :: Show a => (b -> a) -> b -> String
-showCompose = (\ fba b -> show (fba b))
+showCompose = (\ fba -> show . fba)

From dbf7b46ebc52a460b568a49311b17d3319ce45e0 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Thu, 11 Feb 2021 16:00:04 -0800
Subject: [PATCH 03/15] Do less work when simplifiying

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

diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs
index 92c32ab28e..b4d7ad64e1 100644
--- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs
+++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs
@@ -32,7 +32,7 @@ pattern Lambda pats body <-
 
 
 simplify :: LHsExpr GhcPs -> LHsExpr GhcPs
-simplify = head . drop 3 . iterate (everywhere compose . everywhere etaReduce)
+simplify = head . drop 3 . iterate (everywhere $ compose . etaReduce)
 
 
 contains :: Data a => RdrName -> a -> Bool

From 2ef7975e68f454a93c8d1a5e900d5aba1c4c74c8 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Thu, 11 Feb 2021 16:02:23 -0800
Subject: [PATCH 04/15] Remove unnecessary parens simplification

---
 .../hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs  | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs
index b4d7ad64e1..d75da3a3eb 100644
--- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs
+++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs
@@ -32,7 +32,7 @@ pattern Lambda pats body <-
 
 
 simplify :: LHsExpr GhcPs -> LHsExpr GhcPs
-simplify = head . drop 3 . iterate (everywhere $ compose . etaReduce)
+simplify = head . drop 3 . iterate (everywhere $ removeParens . compose . etaReduce)
 
 
 contains :: Data a => RdrName -> a -> Bool
@@ -69,6 +69,12 @@ compose = mkT $ \case
   x -> x
 
 
+removeParens :: GenericT
+removeParens = mkT $ \case
+  HsPar _ (L _ x) | isAtomicHsExpr x -> x
+  (x :: HsExpr GhcPs) -> x
+
+
 infixCall :: String -> HsExpr GhcPs -> HsExpr GhcPs -> HsExpr GhcPs
 infixCall s = flip op (fromString s)
 

From a08773c7f6d5eab1359738c46dc5632813d0f66b Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Thu, 11 Feb 2021 16:06:29 -0800
Subject: [PATCH 05/15] Implement simplify as a fold over endos

---
 .../src/Ide/Plugin/Tactic/Simplify.hs                 | 11 ++++++++++-
 1 file changed, 10 insertions(+), 1 deletion(-)

diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs
index d75da3a3eb..31f68155b8 100644
--- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs
+++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs
@@ -12,6 +12,7 @@ import Data.Data (Data)
 import Data.Generics (everywhere, somewhere, something, listify, extT, mkT, GenericT, mkQ)
 import Data.List.Extra (unsnoc)
 import Data.Maybe (isJust)
+import Data.Monoid (Endo (..))
 import Development.IDE.GHC.Compat
 import GHC.Exts (fromString)
 import GHC.SourceGen (var, op)
@@ -32,7 +33,15 @@ pattern Lambda pats body <-
 
 
 simplify :: LHsExpr GhcPs -> LHsExpr GhcPs
-simplify = head . drop 3 . iterate (everywhere $ removeParens . compose . etaReduce)
+simplify = head . drop 3 . iterate (everywhere $ foldEndo
+  [ etaReduce
+  , removeParens
+  , compose
+  ])
+
+
+foldEndo :: Foldable t => t (a -> a) -> a -> a
+foldEndo = appEndo . foldMap Endo
 
 
 contains :: Data a => RdrName -> a -> Bool

From 25171bc4322d2e7cf172cc679b718ae4b1ea7fd8 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Thu, 11 Feb 2021 16:09:13 -0800
Subject: [PATCH 06/15] Fix tests

---
 test/testdata/tactic/FmapJoin.hs.expected      | 2 +-
 test/testdata/tactic/FmapJoinInLet.hs.expected | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/test/testdata/tactic/FmapJoin.hs.expected b/test/testdata/tactic/FmapJoin.hs.expected
index d7734b82cb..8064301c89 100644
--- a/test/testdata/tactic/FmapJoin.hs.expected
+++ b/test/testdata/tactic/FmapJoin.hs.expected
@@ -1,2 +1,2 @@
 fJoin :: (Monad m, Monad f) => f (m (m a)) -> f (m a)
-fJoin = fmap (\ mma -> (>>=) mma (id))
+fJoin = fmap (\ mma -> (>>=) mma id)
diff --git a/test/testdata/tactic/FmapJoinInLet.hs.expected b/test/testdata/tactic/FmapJoinInLet.hs.expected
index e6175f9493..a9a9f04f9e 100644
--- a/test/testdata/tactic/FmapJoinInLet.hs.expected
+++ b/test/testdata/tactic/FmapJoinInLet.hs.expected
@@ -1,4 +1,4 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 
 fJoin :: forall f m a. (Monad m, Monad f) => f (m (m a)) -> f (m a)
-fJoin =  let f = ( (\ mma -> (>>=) mma (id)) :: m (m a) -> m a) in fmap f
+fJoin =  let f = ( (\ mma -> (>>=) mma id) :: m (m a) -> m a) in fmap f

From b47acedfe9b120904a1a27232ee84198e688c59b Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Thu, 11 Feb 2021 16:24:22 -0800
Subject: [PATCH 07/15] Haddock for the new module

---
 .../src/Ide/Plugin/Tactic/Simplify.hs         | 59 +++++++++++++------
 1 file changed, 42 insertions(+), 17 deletions(-)

diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs
index 31f68155b8..b443e67778 100644
--- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs
+++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs
@@ -19,6 +19,8 @@ import GHC.SourceGen (var, op)
 import GHC.SourceGen.Expr (lambda)
 
 
+------------------------------------------------------------------------------
+-- | A pattern over the otherwise (extremely) messy AST for lambdas.
 pattern Lambda :: [Pat GhcPs] -> HsExpr GhcPs -> HsExpr GhcPs
 pattern Lambda pats body <-
   HsLam _
@@ -28,32 +30,47 @@ pattern Lambda pats body <-
                  GRHS _ [] (L _ body))]}
              })]})
   where
+    -- If there are no patterns to bind, just stick in the body
     Lambda [] body   = body
     Lambda pats body = lambda pats body
 
 
+------------------------------------------------------------------------------
+-- | Simlify an expression.
 simplify :: LHsExpr GhcPs -> LHsExpr GhcPs
-simplify = head . drop 3 . iterate (everywhere $ foldEndo
-  [ etaReduce
-  , removeParens
-  , compose
-  ])
-
-
+simplify
+  = head
+  . drop 3   -- Do three passes; this should be good enough for the limited
+             -- amount of gas we give to auto
+  . iterate (everywhere $ foldEndo
+    [ simplifyEtaReduce
+    , simplifyRemoveParens
+    , simplifyCompose
+    ])
+
+
+------------------------------------------------------------------------------
+-- | Like 'foldMap' but for endomorphisms.
 foldEndo :: Foldable t => t (a -> a) -> a -> a
 foldEndo = appEndo . foldMap Endo
 
 
-contains :: Data a => RdrName -> a -> Bool
-contains name x = not $ null $ listify (
+------------------------------------------------------------------------------
+-- | Does this thing contain any references to 'HsVar's with the given
+-- 'RdrName'?
+containsHsVar :: Data a => RdrName -> a -> Bool
+containsHsVar name x = not $ null $ listify (
   \case
     ((HsVar _ (L _ a)) :: HsExpr GhcPs) | a == name -> True
     _ -> False
   ) x
 
 
-etaReduce :: GenericT
-etaReduce = mkT $ \case
+------------------------------------------------------------------------------
+-- | Perform an eta reduction. For example, transforms @\x -> (f g) x@ into
+-- @f g@.
+simplifyEtaReduce :: GenericT
+simplifyEtaReduce = mkT $ \case
   Lambda
       [VarPat _ (L _ pat)]
       (HsVar _ (L _ a)) | pat == a ->
@@ -62,24 +79,29 @@ etaReduce = mkT $ \case
       (unsnoc -> Just (pats, (VarPat _ (L _ pat))))
       (HsApp _ (L _ f) (L _ (HsVar _ (L _ a))))
       | pat == a
-      , not (contains pat f) ->
+      , not (containsHsVar pat f) ->
     Lambda pats f
   x -> x
 
 
-compose :: GenericT
-compose = mkT $ \case
+------------------------------------------------------------------------------
+-- | Perform an eta-reducing function composition. For example, transforms
+-- @\x -> f (g (h x))@ into @f . g . h@.
+simplifyCompose :: GenericT
+simplifyCompose = mkT $ \case
   Lambda
       (unsnoc -> Just (pats, (VarPat _ (L _ pat))))
       (unroll -> (fs@(_:_), (HsVar _ (L _ a))))
       | pat == a
-      , not (contains pat fs) ->
+      , not (containsHsVar pat fs) ->
     Lambda pats (foldr1 (infixCall ".") fs)
   x -> x
 
 
-removeParens :: GenericT
-removeParens = mkT $ \case
+------------------------------------------------------------------------------
+-- | Removes unnecessary parentheses on any token that doesn't need them.
+simplifyRemoveParens :: GenericT
+simplifyRemoveParens = mkT $ \case
   HsPar _ (L _ x) | isAtomicHsExpr x -> x
   (x :: HsExpr GhcPs) -> x
 
@@ -88,6 +110,9 @@ infixCall :: String -> HsExpr GhcPs -> HsExpr GhcPs -> HsExpr GhcPs
 infixCall s = flip op (fromString s)
 
 
+------------------------------------------------------------------------------
+-- | Unrolls a right-associative function application of the form
+-- @HsApp f (HsApp g (HsApp h x))@ into @([f, g, h], x)@.
 unroll :: HsExpr GhcPs -> ([HsExpr GhcPs], HsExpr GhcPs)
 unroll (HsPar _ (L _ x)) = unroll x
 unroll (HsApp _ (L _ f) (L _ a)) =

From 8ba082b8e01cc1d7edabcb320bdedfba1722aba1 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Thu, 11 Feb 2021 16:26:49 -0800
Subject: [PATCH 08/15] Minor note on implementation

---
 plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs
index b443e67778..9513f17f36 100644
--- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs
+++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs
@@ -79,6 +79,7 @@ simplifyEtaReduce = mkT $ \case
       (unsnoc -> Just (pats, (VarPat _ (L _ pat))))
       (HsApp _ (L _ f) (L _ (HsVar _ (L _ a))))
       | pat == a
+        -- We can only perform this simplifiation if @pat@ is otherwise unused.
       , not (containsHsVar pat f) ->
     Lambda pats f
   x -> x
@@ -93,6 +94,7 @@ simplifyCompose = mkT $ \case
       (unsnoc -> Just (pats, (VarPat _ (L _ pat))))
       (unroll -> (fs@(_:_), (HsVar _ (L _ a))))
       | pat == a
+        -- We can only perform this simplifiation if @pat@ is otherwise unused.
       , not (containsHsVar pat fs) ->
     Lambda pats (foldr1 (infixCall ".") fs)
   x -> x

From 1302c6d9a7cc1598db2251e8df291201c87d0439 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Thu, 11 Feb 2021 16:30:27 -0800
Subject: [PATCH 09/15] Note a TODO

---
 plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs
index 9513f17f36..a6339da7c7 100644
--- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs
+++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs
@@ -108,6 +108,7 @@ simplifyRemoveParens = mkT $ \case
   (x :: HsExpr GhcPs) -> x
 
 
+-- TODO(sandy): Copypasted from CodeGen. Fix before merging
 infixCall :: String -> HsExpr GhcPs -> HsExpr GhcPs -> HsExpr GhcPs
 infixCall s = flip op (fromString s)
 

From 4a1650f9ab6b4d6b37d8ffa65333cd7c8eef69f2 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Thu, 11 Feb 2021 17:14:52 -0800
Subject: [PATCH 10/15] Use PatCompat to unpack patterns

---
 plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/GHC.hs    | 2 +-
 .../hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs   | 7 ++++---
 2 files changed, 5 insertions(+), 4 deletions(-)

diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/GHC.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/GHC.hs
index 5cba1d20b6..c0942aa2a8 100644
--- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/GHC.hs
+++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/GHC.hs
@@ -112,7 +112,7 @@ lambdaCaseable (splitFunTy_maybe -> Just (arg, res))
   = Just $ isJust $ algebraicTyCon res
 lambdaCaseable _ = Nothing
 
-fromPatCompat :: PatCompat GhcTc -> Pat GhcTc
+fromPatCompat :: PatCompat ps -> Pat ps
 #if __GLASGOW_HASKELL__ == 808
 type PatCompat pass = Pat pass
 fromPatCompat = id
diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs
index a6339da7c7..30c1df5b6f 100644
--- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs
+++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs
@@ -17,6 +17,7 @@ import Development.IDE.GHC.Compat
 import GHC.Exts (fromString)
 import GHC.SourceGen (var, op)
 import GHC.SourceGen.Expr (lambda)
+import Ide.Plugin.Tactic.GHC (fromPatCompat)
 
 
 ------------------------------------------------------------------------------
@@ -72,11 +73,11 @@ containsHsVar name x = not $ null $ listify (
 simplifyEtaReduce :: GenericT
 simplifyEtaReduce = mkT $ \case
   Lambda
-      [VarPat _ (L _ pat)]
+      [fromPatCompat -> VarPat _ (L _ pat)]
       (HsVar _ (L _ a)) | pat == a ->
     var "id"
   Lambda
-      (unsnoc -> Just (pats, (VarPat _ (L _ pat))))
+      (fmap fromPatCompat -> unsnoc -> Just (pats, (VarPat _ (L _ pat))))
       (HsApp _ (L _ f) (L _ (HsVar _ (L _ a))))
       | pat == a
         -- We can only perform this simplifiation if @pat@ is otherwise unused.
@@ -91,7 +92,7 @@ simplifyEtaReduce = mkT $ \case
 simplifyCompose :: GenericT
 simplifyCompose = mkT $ \case
   Lambda
-      (unsnoc -> Just (pats, (VarPat _ (L _ pat))))
+      (fmap fromPatCompat -> unsnoc -> Just (pats, (VarPat _ (L _ pat))))
       (unroll -> (fs@(_:_), (HsVar _ (L _ a))))
       | pat == a
         -- We can only perform this simplifiation if @pat@ is otherwise unused.

From 7ba73ac7441e49ebef4e294cd84a118ce153cbcd Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Thu, 11 Feb 2021 17:25:14 -0800
Subject: [PATCH 11/15] Pull out codegen utilities to break a cyclic dependency

---
 .../hls-tactics-plugin.cabal                  |  1 +
 .../src/Ide/Plugin/Tactic/CodeGen.hs          | 61 +----------------
 .../src/Ide/Plugin/Tactic/CodeGen/Utils.hs    | 67 +++++++++++++++++++
 .../src/Ide/Plugin/Tactic/Simplify.hs         |  6 +-
 4 files changed, 72 insertions(+), 63 deletions(-)
 create mode 100644 plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen/Utils.hs

diff --git a/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal b/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal
index 23b11e545f..f6e6b8fd4e 100644
--- a/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal
+++ b/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal
@@ -25,6 +25,7 @@ library
     Ide.Plugin.Tactic
     Ide.Plugin.Tactic.Auto
     Ide.Plugin.Tactic.CodeGen
+    Ide.Plugin.Tactic.CodeGen.Utils
     Ide.Plugin.Tactic.Context
     Ide.Plugin.Tactic.Debug
     Ide.Plugin.Tactic.GHC
diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen.hs
index 1cab232a7a..785dea0018 100644
--- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen.hs
+++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen.hs
@@ -1,7 +1,7 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE DataKinds        #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE TupleSections    #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE ViewPatterns     #-}
 
 module Ide.Plugin.Tactic.CodeGen where
@@ -18,7 +18,6 @@ import           Data.Traversable
 import           DataCon
 import           Development.IDE.GHC.Compat
 import           GHC.Exts
-import           GHC.SourceGen (RdrNameStr)
 import           GHC.SourceGen.Binds
 import           GHC.SourceGen.Expr
 import           GHC.SourceGen.Overloaded
@@ -28,7 +27,7 @@ import           Ide.Plugin.Tactic.Judgements
 import           Ide.Plugin.Tactic.Machinery
 import           Ide.Plugin.Tactic.Naming
 import           Ide.Plugin.Tactic.Types
-import           Name
+import           Ide.Plugin.Tactic.CodeGen.Utils
 import           Type hiding (Var)
 
 
@@ -202,57 +201,3 @@ buildDataCon jdg dc apps = do
     . (rose (show dc) $ pure tr,)
     $ mkCon dc sgs
 
-
-mkCon :: DataCon -> [LHsExpr GhcPs] -> LHsExpr GhcPs
-mkCon dcon (fmap unLoc -> args)
-  | isTupleDataCon dcon =
-      noLoc $ tuple args
-  | dataConIsInfix dcon
-  , (lhs : rhs : args') <- args =
-      noLoc $ foldl' (@@) (op lhs (coerceName dcon_name) rhs) args'
-  | otherwise =
-      noLoc $ foldl' (@@) (bvar' $ occName dcon_name) args
-  where
-    dcon_name = dataConName dcon
-
-
-
-coerceName :: HasOccName a => a -> RdrNameStr
-coerceName = fromString . occNameString . occName
-
-
-
-------------------------------------------------------------------------------
--- | Like 'var', but works over standard GHC 'OccName's.
-var' :: Var a => OccName -> a
-var' = var . fromString . occNameString
-
-
-------------------------------------------------------------------------------
--- | Like 'bvar', but works over standard GHC 'OccName's.
-bvar' :: BVar a => OccName -> a
-bvar' = bvar . fromString . occNameString
-
-
-------------------------------------------------------------------------------
--- | Get an HsExpr corresponding to a function name.
-mkFunc :: String -> HsExpr GhcPs
-mkFunc = var' . mkVarOcc
-
-
-------------------------------------------------------------------------------
--- | Get an HsExpr corresponding to a value name.
-mkVal :: String -> HsExpr GhcPs
-mkVal = var' . mkVarOcc
-
-
-------------------------------------------------------------------------------
--- | Like 'op', but easier to call.
-infixCall :: String -> HsExpr GhcPs -> HsExpr GhcPs -> HsExpr GhcPs
-infixCall s = flip op (fromString s)
-
-
-------------------------------------------------------------------------------
--- | Like '(@@)', but uses a dollar instead of parentheses.
-appDollar :: HsExpr GhcPs -> HsExpr GhcPs -> HsExpr GhcPs
-appDollar = infixCall "$"
diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen/Utils.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen/Utils.hs
new file mode 100644
index 0000000000..e3551cc660
--- /dev/null
+++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen/Utils.hs
@@ -0,0 +1,67 @@
+{-# LANGUAGE ViewPatterns #-}
+
+module Ide.Plugin.Tactic.CodeGen.Utils where
+
+import           Data.List
+import           DataCon
+import           Development.IDE.GHC.Compat
+import           GHC.Exts
+import           GHC.SourceGen (RdrNameStr)
+import           GHC.SourceGen.Overloaded
+import           Name
+
+
+------------------------------------------------------------------------------
+-- | Make a data constructor with the given arguments.
+mkCon :: DataCon -> [LHsExpr GhcPs] -> LHsExpr GhcPs
+mkCon dcon (fmap unLoc -> args)
+  | isTupleDataCon dcon =
+      noLoc $ tuple args
+  | dataConIsInfix dcon
+  , (lhs : rhs : args') <- args =
+      noLoc $ foldl' (@@) (op lhs (coerceName dcon_name) rhs) args'
+  | otherwise =
+      noLoc $ foldl' (@@) (bvar' $ occName dcon_name) args
+  where
+    dcon_name = dataConName dcon
+
+
+coerceName :: HasOccName a => a -> RdrNameStr
+coerceName = fromString . occNameString . occName
+
+
+------------------------------------------------------------------------------
+-- | Like 'var', but works over standard GHC 'OccName's.
+var' :: Var a => OccName -> a
+var' = var . fromString . occNameString
+
+
+------------------------------------------------------------------------------
+-- | Like 'bvar', but works over standard GHC 'OccName's.
+bvar' :: BVar a => OccName -> a
+bvar' = bvar . fromString . occNameString
+
+
+------------------------------------------------------------------------------
+-- | Get an HsExpr corresponding to a function name.
+mkFunc :: String -> HsExpr GhcPs
+mkFunc = var' . mkVarOcc
+
+
+------------------------------------------------------------------------------
+-- | Get an HsExpr corresponding to a value name.
+mkVal :: String -> HsExpr GhcPs
+mkVal = var' . mkVarOcc
+
+
+------------------------------------------------------------------------------
+-- | Like 'op', but easier to call.
+infixCall :: String -> HsExpr GhcPs -> HsExpr GhcPs -> HsExpr GhcPs
+infixCall s = flip op (fromString s)
+
+
+------------------------------------------------------------------------------
+-- | Like '(@@)', but uses a dollar instead of parentheses.
+appDollar :: HsExpr GhcPs -> HsExpr GhcPs -> HsExpr GhcPs
+appDollar = infixCall "$"
+
diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs
index 30c1df5b6f..f48d096e7b 100644
--- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs
+++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs
@@ -17,6 +17,7 @@ import Development.IDE.GHC.Compat
 import GHC.Exts (fromString)
 import GHC.SourceGen (var, op)
 import GHC.SourceGen.Expr (lambda)
+import Ide.Plugin.Tactic.CodeGen.Utils
 import Ide.Plugin.Tactic.GHC (fromPatCompat)
 
 
@@ -109,11 +110,6 @@ simplifyRemoveParens = mkT $ \case
   (x :: HsExpr GhcPs) -> x
 
 
--- TODO(sandy): Copypasted from CodeGen. Fix before merging
-infixCall :: String -> HsExpr GhcPs -> HsExpr GhcPs -> HsExpr GhcPs
-infixCall s = flip op (fromString s)
-
-
 ------------------------------------------------------------------------------
 -- | Unrolls a right-associative function application of the form
 -- @HsApp f (HsApp g (HsApp h x))@ into @([f, g, h], x)@.

From 0b2cc537cf3ffca16fd7ab3eea29f177702f63ae Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Thu, 11 Feb 2021 17:28:17 -0800
Subject: [PATCH 12/15] Re-export utils

---
 plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen.hs  | 5 ++++-
 .../hls-tactics-plugin/src/Ide/Plugin/Tactic/Machinery.hs    | 2 +-
 2 files changed, 5 insertions(+), 2 deletions(-)

diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen.hs
index 785dea0018..029eb971d3 100644
--- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen.hs
+++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/CodeGen.hs
@@ -4,7 +4,10 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE ViewPatterns     #-}
 
-module Ide.Plugin.Tactic.CodeGen where
+module Ide.Plugin.Tactic.CodeGen
+  ( module Ide.Plugin.Tactic.CodeGen
+  , module Ide.Plugin.Tactic.CodeGen.Utils
+  ) where
 
 import           Control.Lens ((+~), (%~), (<>~))
 import           Control.Monad.Except
diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Machinery.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Machinery.hs
index 53be6d0e05..787fb6bb7d 100644
--- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Machinery.hs
+++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Machinery.hs
@@ -33,6 +33,7 @@ import           Data.Set (Set)
 import qualified Data.Set as S
 import           Development.IDE.GHC.Compat
 import           Ide.Plugin.Tactic.Judgements
+import           Ide.Plugin.Tactic.Simplify (simplify)
 import           Ide.Plugin.Tactic.Types
 import           OccName (HasOccName(occName))
 import           Refinery.ProofState
@@ -41,7 +42,6 @@ import           Refinery.Tactic.Internal
 import           TcType
 import           Type
 import           Unify
-import Ide.Plugin.Tactic.Simplify (simplify)
 
 
 substCTy :: TCvSubst -> CType -> CType

From 1802bd621e5d7e7a9aadc39852bc93b9e3d616bd Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Thu, 11 Feb 2021 18:01:33 -0800
Subject: [PATCH 13/15] Try a different strategy for generalizing PatCompat

---
 .../hls-tactics-plugin/src/Ide/Plugin/Tactic/GHC.hs  | 12 ++++++++----
 .../src/Ide/Plugin/Tactic/Simplify.hs                |  8 ++++----
 2 files changed, 12 insertions(+), 8 deletions(-)

diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/GHC.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/GHC.hs
index c0942aa2a8..d3ef13c8c0 100644
--- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/GHC.hs
+++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/GHC.hs
@@ -112,13 +112,17 @@ lambdaCaseable (splitFunTy_maybe -> Just (arg, res))
   = Just $ isJust $ algebraicTyCon res
 lambdaCaseable _ = Nothing
 
-fromPatCompat :: PatCompat ps -> Pat ps
+-- It's hard to generalize over these since weird type families are involved.
+fromPatCompatTc :: PatCompat GhcTc -> Pat GhcTc
+fromPatCompatPs :: PatCompat GhcPs -> Pat GhcPs
 #if __GLASGOW_HASKELL__ == 808
 type PatCompat pass = Pat pass
-fromPatCompat = id
+fromPatCompatTc = id
+fromPatCompatPs = id
 #else
 type PatCompat pass = LPat pass
-fromPatCompat = unLoc
+fromPatCompatTc = unLoc
+fromPatCompatPs = id
 #endif
 
 ------------------------------------------------------------------------------
@@ -132,7 +136,7 @@ pattern TopLevelRHS name ps body <-
       [L _ (GRHS _ [] body)] _)
 
 getPatName :: PatCompat GhcTc -> Maybe OccName
-getPatName (fromPatCompat -> p0) =
+getPatName (fromPatCompatTc -> p0) =
   case p0 of
     VarPat  _ x   -> Just $ occName $ unLoc x
     LazyPat _ p   -> getPatName p
diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs
index f48d096e7b..f54e8d96ef 100644
--- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs
+++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs
@@ -18,7 +18,7 @@ import GHC.Exts (fromString)
 import GHC.SourceGen (var, op)
 import GHC.SourceGen.Expr (lambda)
 import Ide.Plugin.Tactic.CodeGen.Utils
-import Ide.Plugin.Tactic.GHC (fromPatCompat)
+import Ide.Plugin.Tactic.GHC (fromPatCompatPs)
 
 
 ------------------------------------------------------------------------------
@@ -74,11 +74,11 @@ containsHsVar name x = not $ null $ listify (
 simplifyEtaReduce :: GenericT
 simplifyEtaReduce = mkT $ \case
   Lambda
-      [fromPatCompat -> VarPat _ (L _ pat)]
+      [fromPatCompatPs -> VarPat _ (L _ pat)]
       (HsVar _ (L _ a)) | pat == a ->
     var "id"
   Lambda
-      (fmap fromPatCompat -> unsnoc -> Just (pats, (VarPat _ (L _ pat))))
+      (fmap fromPatCompatPs -> unsnoc -> Just (pats, (VarPat _ (L _ pat))))
       (HsApp _ (L _ f) (L _ (HsVar _ (L _ a))))
       | pat == a
         -- We can only perform this simplifiation if @pat@ is otherwise unused.
@@ -93,7 +93,7 @@ simplifyEtaReduce = mkT $ \case
 simplifyCompose :: GenericT
 simplifyCompose = mkT $ \case
   Lambda
-      (fmap fromPatCompat -> unsnoc -> Just (pats, (VarPat _ (L _ pat))))
+      (fmap fromPatCompatPs -> unsnoc -> Just (pats, (VarPat _ (L _ pat))))
       (unroll -> (fs@(_:_), (HsVar _ (L _ a))))
       | pat == a
         -- We can only perform this simplifiation if @pat@ is otherwise unused.

From d8d524866e57ecd2ff27e73777451db148f20fb2 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Thu, 11 Feb 2021 18:42:57 -0800
Subject: [PATCH 14/15] Try, try again to compat

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

diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/GHC.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/GHC.hs
index d3ef13c8c0..efe715d12c 100644
--- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/GHC.hs
+++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/GHC.hs
@@ -122,7 +122,7 @@ fromPatCompatPs = id
 #else
 type PatCompat pass = LPat pass
 fromPatCompatTc = unLoc
-fromPatCompatPs = id
+fromPatCompatPs = unLoc
 #endif
 
 ------------------------------------------------------------------------------

From e4cb82e96523ea0f83835676b0cb07bc0c497a11 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Thu, 11 Feb 2021 19:57:13 -0800
Subject: [PATCH 15/15] Could this be the answer we've all been waiting for?

---
 .../hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs  | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs
index f54e8d96ef..c125d50876 100644
--- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs
+++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/Simplify.hs
@@ -27,7 +27,7 @@ pattern Lambda :: [Pat GhcPs] -> HsExpr GhcPs -> HsExpr GhcPs
 pattern Lambda pats body <-
   HsLam _
     (MG {mg_alts = L _ [L _
-      (Match { m_pats = pats
+      (Match { m_pats = fmap fromPatCompatPs -> pats
              , m_grhss = GRHSs {grhssGRHSs = [L _ (
                  GRHS _ [] (L _ body))]}
              })]})
@@ -74,11 +74,11 @@ containsHsVar name x = not $ null $ listify (
 simplifyEtaReduce :: GenericT
 simplifyEtaReduce = mkT $ \case
   Lambda
-      [fromPatCompatPs -> VarPat _ (L _ pat)]
+      [VarPat _ (L _ pat)]
       (HsVar _ (L _ a)) | pat == a ->
     var "id"
   Lambda
-      (fmap fromPatCompatPs -> unsnoc -> Just (pats, (VarPat _ (L _ pat))))
+      (unsnoc -> Just (pats, (VarPat _ (L _ pat))))
       (HsApp _ (L _ f) (L _ (HsVar _ (L _ a))))
       | pat == a
         -- We can only perform this simplifiation if @pat@ is otherwise unused.
@@ -93,7 +93,7 @@ simplifyEtaReduce = mkT $ \case
 simplifyCompose :: GenericT
 simplifyCompose = mkT $ \case
   Lambda
-      (fmap fromPatCompatPs -> unsnoc -> Just (pats, (VarPat _ (L _ pat))))
+      (unsnoc -> Just (pats, (VarPat _ (L _ pat))))
       (unroll -> (fs@(_:_), (HsVar _ (L _ a))))
       | pat == a
         -- We can only perform this simplifiation if @pat@ is otherwise unused.