From 9b64da9e959bcb67483f3529e7babfce9d554f51 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Sun, 18 Apr 2021 23:32:02 -0700
Subject: [PATCH 1/9] Significantly improved naming system

---
 .../hls-tactics-plugin.cabal                  |   1 +
 .../hls-tactics-plugin/src/Wingman/Naming.hs  | 126 +++++++++++++++---
 .../hls-tactics-plugin/src/Wingman/Tactics.hs |   2 +-
 3 files changed, 108 insertions(+), 21 deletions(-)

diff --git a/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal b/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal
index 8af40ee91a..41a7371823 100644
--- a/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal
+++ b/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal
@@ -85,6 +85,7 @@ library
     , text
     , transformers
     , unordered-containers
+    , hyphenation
 
   default-language:   Haskell2010
   default-extensions:
diff --git a/plugins/hls-tactics-plugin/src/Wingman/Naming.hs b/plugins/hls-tactics-plugin/src/Wingman/Naming.hs
index f0d133d837..12a01dd9a9 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/Naming.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/Naming.hs
@@ -1,60 +1,138 @@
 module Wingman.Naming where
 
+import           ConLike
+import           Control.Applicative
 import           Control.Monad.State.Strict
 import           Data.Bool (bool)
 import           Data.Char
+import           Data.List (isPrefixOf)
+import           Data.List.Extra (split)
 import           Data.Map (Map)
 import qualified Data.Map as M
+import           Data.Maybe (listToMaybe, fromMaybe)
+import           Data.Monoid
 import           Data.Set (Set)
 import qualified Data.Set as S
 import           Data.Traversable
+import           FieldLabel
+import           GhcPlugins (unpackFS, charTy, maybeTyCon)
 import           Name
 import           TcType
+import           Text.Hyphenation (hyphenate, english_US)
 import           TyCon
 import           Type
 import           TysWiredIn (listTyCon, pairTyCon, unitTyCon)
 
 
+fieldNames :: ConLike -> [OccName]
+fieldNames cl =
+  case fmap (unpackFS . flLabel) $ conLikeFieldLabels cl of
+    [] -> []
+    [_] -> []
+    fields ->
+      let field_first_segs = fmap (listToMaybe . split (== '_')) fields
+      in case and $ zipWith (==) field_first_segs $ tail field_first_segs of
+            True ->
+              let common_prefix = maybe 0 ((+ 1) . length) $ head field_first_segs
+               in fmap (mkVarOcc . drop common_prefix) fields
+            False -> []
+
 ------------------------------------------------------------------------------
 -- | Use type information to create a reasonable name.
-mkTyName :: Type -> String
--- eg. mkTyName (a -> B) = "fab"
+mkTyName :: Type -> [String]
+-- eg. mkTyName (a -> b) = "fab"
 mkTyName (tcSplitFunTys -> ([a@(isFunTy -> False)], b))
-  = "f" ++ mkTyName a ++ mkTyName b
+  | isTyVarTy a && isTyVarTy b
+  = (\x y z -> x <> y <> z) <$> ["f", "g", "h"] <*> mkTyName a <*> mkTyName b
+-- eg. mkTyName (a -> Bool) = "p"
+mkTyName (tcSplitFunTys -> ([isFunTy -> False], isBoolTy -> True))
+  = pure $ "p"
+-- eg. mkTyName (A -> B) = "f"
+mkTyName (tcSplitFunTys -> ([isFunTy -> False], _))
+  = ["f", "g", "h"]
 -- eg. mkTyName (a -> b -> C) = "f_C"
 mkTyName (tcSplitFunTys -> (_:_, b))
-  = "f_" ++ mkTyName b
--- eg. mkTyName (Either A B) = "eab"
+  = fmap ("f_" <>) $ mkTyName b
+-- eg. mkTyName [Char] = "str"
+mkTyName (splitTyConApp_maybe -> Just (c, [arg]))
+  | c == listTyCon, eqType arg charTy
+  = pure $ "str"
+mkTyName (splitTyConApp_maybe -> Just (c, [arg]))
+  | c == listTyCon, eqType arg charTy
+  = pure $ "str"
+-- eg. mkTyName Int = "n"
+mkTyName (isIntTy -> True) = ["n", "i", "j"]
+-- eg. mkTyName Integer = "n"
+mkTyName (isIntegerTy -> True) = ["n", "i", "j"]
+-- eg. mkTyName (T A B) = "tab"
 mkTyName (splitTyConApp_maybe -> Just (c, args))
-  = mkTyConName c ++ foldMap mkTyName args
+  = fmap (mkTyConName c $) $ foldMap mkTyName args
 -- eg. mkTyName (f a) = "fa"
 mkTyName (tcSplitAppTys -> (t, args@(_:_)))
-  = mkTyName t ++ foldMap mkTyName args
+  = liftA2 (<>) (mkTyName t) $ foldMap mkTyName args
 -- eg. mkTyName a = "a"
 mkTyName (getTyVar_maybe -> Just tv)
-  = occNameString $ occName tv
+  = pure $ occNameString $ occName tv
 -- eg. mkTyName (forall x. y) = "y"
 mkTyName (tcSplitSigmaTy -> (_:_, _, t))
   = mkTyName t
-mkTyName _ = "x"
+mkTyName _ = pure $ "x"
 
 
 ------------------------------------------------------------------------------
 -- | Get a good name for a type constructor.
-mkTyConName :: TyCon -> String
+mkTyConName :: TyCon -> String -> String
 mkTyConName tc
-  | tc == listTyCon = "l_"
-  | tc == pairTyCon = "p_"
-  | tc == unitTyCon = "unit"
-  | otherwise
-      = take 1
+  | tc == listTyCon = flip mappend "s"
+  | tc == pairTyCon = mappend "p_"
+  | tc == unitTyCon = mappend "unit"
+  | tc == maybeTyCon = mappend "m_"
+  | isSymOcc (getOccName tc)
+      = mappend
+      . take 1
       . fmap toLower
       . filterReplace isSymbol      's'
       . filterReplace isPunctuation 'p'
       . occNameString
       $ getOccName tc
+  | otherwise
+      = const
+      $ stem
+      $ fmap toLower
+      $ occNameString
+      $ getOccName tc
+
+
+stem :: String -> String
+stem "char" = "c"
+stem "function" = "func"
+stem "bool" = "b"
+stem "either" = "e"
+stem "error" = "err"
+stem "text" = "t"
+stem s =
+  let syllables = hyphenate english_US s
+      (as, bs) = break (not . isLowerVowel . last) syllables
+   in join as <>
+     case bs of
+       [] -> ""
+       [b] -> b
+       (b : next : _) -> b <>
+         takeWhile (not . isLowerVowel) next
 
 
+isLowerVowel :: Char -> Bool
+isLowerVowel 'a' = True
+isLowerVowel 'e' = True
+isLowerVowel 'i' = True
+isLowerVowel 'o' = True
+isLowerVowel 'u' = True
+isLowerVowel _ = False
+
+
+takeUntil :: (a -> Bool) -> [a] -> [a]
+takeUntil p = foldr (\x ys -> x : if p x then [] else ys) []
+
 ------------------------------------------------------------------------------
 -- | Maybe replace an element in the list if the predicate matches
 filterReplace :: (a -> Bool) -> a -> [a] -> [a]
@@ -67,11 +145,19 @@ mkGoodName
     :: Set OccName  -- ^ Bindings in scope; used to ensure we don't shadow anything
     -> Type       -- ^ The type to produce a name for
     -> OccName
-mkGoodName in_scope t =
-  let tn = mkTyName t
-   in mkVarOcc $ case S.member (mkVarOcc tn) in_scope of
-        True  -> tn ++ show (length in_scope)
-        False -> tn
+mkGoodName in_scope (mkTyName -> tn)
+  = mkVarOcc
+  . fromMaybe (mkNumericSuffix in_scope $ head tn)
+  . getFirst
+  . foldMap (\n -> bool (pure n) mempty $ check n)
+  $ tn <> fmap (<> "'") tn
+  where
+    check n = S.member (mkVarOcc n) in_scope
+
+
+mkNumericSuffix :: Set OccName -> String -> String
+mkNumericSuffix s nm =
+  mappend nm . show . length . filter (isPrefixOf nm . occNameString) $ S.toList s
 
 
 ------------------------------------------------------------------------------
diff --git a/plugins/hls-tactics-plugin/src/Wingman/Tactics.hs b/plugins/hls-tactics-plugin/src/Wingman/Tactics.hs
index ded31b00a8..429931f631 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/Tactics.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/Tactics.hs
@@ -298,7 +298,7 @@ destructAll :: TacticsM ()
 destructAll = do
   jdg <- goal
   let args = fmap fst
-           $ sortOn (Down . snd)
+           $ sort
            $ mapMaybe (\(hi, prov) ->
               case prov of
                 TopLevelArgPrv _ idx _ -> pure (hi, idx)

From 9300b3eeda9fa44c8f04347c932b33e5f74dd2bb Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Mon, 19 Apr 2021 01:03:08 -0700
Subject: [PATCH 2/9] Use naming purposes

---
 .../hls-tactics-plugin/src/Wingman/Naming.hs  | 176 +++++++++++++-----
 1 file changed, 128 insertions(+), 48 deletions(-)

diff --git a/plugins/hls-tactics-plugin/src/Wingman/Naming.hs b/plugins/hls-tactics-plugin/src/Wingman/Naming.hs
index 12a01dd9a9..2382ae188d 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/Naming.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/Naming.hs
@@ -22,6 +22,7 @@ import           Text.Hyphenation (hyphenate, english_US)
 import           TyCon
 import           Type
 import           TysWiredIn (listTyCon, pairTyCon, unitTyCon)
+import Wingman.GHC (tcTyVar_maybe)
 
 
 fieldNames :: ConLike -> [OccName]
@@ -37,67 +38,146 @@ fieldNames cl =
                in fmap (mkVarOcc . drop common_prefix) fields
             False -> []
 
-------------------------------------------------------------------------------
--- | Use type information to create a reasonable name.
+data Purpose
+  = Function [Type] Type
+  | Predicate
+  | Continuation
+  | Integral
+  | Number
+  | String
+  | List Type
+  | Maybe Type
+  | TyConned TyCon [Type]
+  | TyVarred TyVar [Type]
+
+pattern IsPredicate :: Type
+pattern IsPredicate <- (tcSplitFunTys -> ([isFunTy -> False], isBoolTy -> True))
+
+pattern IsFunction :: [Type] -> Type -> Type
+pattern IsFunction args res <- (tcSplitFunTys -> (args@(_:_), res))
+
+pattern IsString :: Type
+pattern IsString <- (splitTyConApp_maybe -> Just ((== listTyCon) -> True, [eqType charTy -> True]))
+
+pattern IsMaybe :: Type -> Type
+pattern IsMaybe a <- (splitTyConApp_maybe -> Just ((== maybeTyCon) -> True, [a]))
+
+pattern IsList :: Type -> Type
+pattern IsList a <- (splitTyConApp_maybe -> Just ((== listTyCon) -> True, [a]))
+
+pattern IsTyConned :: TyCon -> [Type] -> Type
+pattern IsTyConned tc args <- (splitTyConApp_maybe -> Just (tc, args))
+
+pattern IsTyVarred :: TyVar -> [Type] -> Type
+pattern IsTyVarred v args <- (tcSplitAppTys -> (tcTyVar_maybe -> Just v, args))
+
+
+getPurposes :: Type -> [Purpose]
+getPurposes ty = mconcat
+  [ [ Predicate         | IsPredicate         <- [ty] ]
+  , [ Function args res | IsFunction args res <- [ty] ]
+  , with (isIntegerTy ty) [ Integral, Number          ]
+  , with (isIntTy ty)     [ Integral, Number          ]
+  , [ Number            | isFloatingTy ty             ]
+  , [ String            | isStringTy ty               ]
+  , [ Maybe a           | IsMaybe a           <- [ty] ]
+  , [ List a            | IsList a            <- [ty] ]
+  , [ TyVarred v args   | IsTyVarred v args   <- [ty] ]
+  , [ TyConned tc args  | IsTyConned tc args  <- [ty] ]
+  ]
+
+
+with :: Monoid a => Bool -> a -> a
+with False _ = mempty
+with True a = a
+
+
+functionNames :: [String]
+functionNames = ["f", "g", "h"]
+
+
+mkName :: Purpose -> [String]
+mkName (Function args res)
+  | Just tv_args <- traverse tcTyVar_maybe $ args <> pure res
+  = fmap (<> foldMap (occNameString . occName) tv_args) functionNames
+mkName (Function _ _) = functionNames
+mkName Predicate = pure "p"
+mkName Continuation = pure "k"
+mkName Integral = ["n", "i", "j"]
+mkName Number = ["x", "y", "z", "w"]
+mkName String = ["s", "str"]
+mkName (List t) = fmap (<> "s") $ mkName =<< getPurposes t
+mkName (Maybe t) = fmap ("m_" <>) $ mkName =<< getPurposes t
+mkName (TyVarred tv args)
+  | Just tv_args <- traverse tcTyVar_maybe args
+  = pure $ foldMap (occNameString . occName) $ tv : tv_args
+mkName (TyVarred tv _) = pure $ occNameString $ occName tv
+mkName (TyConned tc args)
+  | Just tv_args <- traverse tcTyVar_maybe args
+  = pure $ mappend (mkTyConName tc) $ foldMap (occNameString . occName) tv_args
+mkName (TyConned tc _)
+  = pure
+  $ mkTyConName tc
+
+
 mkTyName :: Type -> [String]
--- eg. mkTyName (a -> b) = "fab"
-mkTyName (tcSplitFunTys -> ([a@(isFunTy -> False)], b))
-  | isTyVarTy a && isTyVarTy b
-  = (\x y z -> x <> y <> z) <$> ["f", "g", "h"] <*> mkTyName a <*> mkTyName b
--- eg. mkTyName (a -> Bool) = "p"
-mkTyName (tcSplitFunTys -> ([isFunTy -> False], isBoolTy -> True))
-  = pure $ "p"
--- eg. mkTyName (A -> B) = "f"
-mkTyName (tcSplitFunTys -> ([isFunTy -> False], _))
-  = ["f", "g", "h"]
--- eg. mkTyName (a -> b -> C) = "f_C"
-mkTyName (tcSplitFunTys -> (_:_, b))
-  = fmap ("f_" <>) $ mkTyName b
--- eg. mkTyName [Char] = "str"
-mkTyName (splitTyConApp_maybe -> Just (c, [arg]))
-  | c == listTyCon, eqType arg charTy
-  = pure $ "str"
-mkTyName (splitTyConApp_maybe -> Just (c, [arg]))
-  | c == listTyCon, eqType arg charTy
-  = pure $ "str"
--- eg. mkTyName Int = "n"
-mkTyName (isIntTy -> True) = ["n", "i", "j"]
--- eg. mkTyName Integer = "n"
-mkTyName (isIntegerTy -> True) = ["n", "i", "j"]
--- eg. mkTyName (T A B) = "tab"
-mkTyName (splitTyConApp_maybe -> Just (c, args))
-  = fmap (mkTyConName c $) $ foldMap mkTyName args
--- eg. mkTyName (f a) = "fa"
-mkTyName (tcSplitAppTys -> (t, args@(_:_)))
-  = liftA2 (<>) (mkTyName t) $ foldMap mkTyName args
--- eg. mkTyName a = "a"
-mkTyName (getTyVar_maybe -> Just tv)
-  = pure $ occNameString $ occName tv
--- eg. mkTyName (forall x. y) = "y"
-mkTyName (tcSplitSigmaTy -> (_:_, _, t))
-  = mkTyName t
-mkTyName _ = pure $ "x"
+mkTyName = mkName <=< getPurposes
+
+
+
+--------------------------------------------------------------------------------
+---- | Use type information to create a reasonable name.
+--mkTyName :: Type -> [String]
+---- eg. mkTyName (a -> b) = "fab"
+--mkTyName (tcSplitFunTys -> ([a@(isFunTy -> False)], b))
+--  | isTyVarTy a && isTyVarTy b
+--  = (\x y z -> x <> y <> z) <$> ["f", "g", "h"] <*> mkTyName a <*> mkTyName b
+---- eg. mkTyName (a -> Bool) = "p"
+---- mkTyName (tcSplitFunTys -> ([isFunTy -> False], isBoolTy -> True))
+----   = pure $ "p"
+---- eg. mkTyName (A -> B) = "f"
+---- mkTyName (tcSplitFunTys -> ([isFunTy -> False], _))
+----   = ["f", "g", "h"]
+---- eg. mkTyName (a -> b -> C) = "f_C"
+--mkTyName (tcSplitFunTys -> (_:_, b))
+--  = fmap ("f_" <>) $ mkTyName b
+---- eg. mkTyName [Char] = "str"
+---- mkTyName (splitTyConApp_maybe -> Just (c, [arg]))
+----   | c == listTyCon, eqType arg charTy
+----   = pure $ "str"
+---- eg. mkTyName Int = "n"
+---- mkTyName (isIntTy -> True) = ["n", "i", "j"]
+---- eg. mkTyName Integer = "n"
+---- mkTyName (isIntegerTy -> True) = ["n", "i", "j"]
+---- eg. mkTyName (T A B) = "tab"
+--mkTyName (splitTyConApp_maybe -> Just (c, args))
+--  = fmap (mkTyConName c $) $ foldMap mkTyName args
+---- eg. mkTyName (f a) = "fa"
+--mkTyName (tcSplitAppTys -> (t, args@(_:_)))
+--  = liftA2 (<>) (mkTyName t) $ foldMap mkTyName args
+---- eg. mkTyName a = "a"
+--mkTyName (getTyVar_maybe -> Just tv)
+--  = pure $ occNameString $ occName tv
+---- eg. mkTyName (forall x. y) = "y"
+--mkTyName (tcSplitSigmaTy -> (_:_, _, t))
+--  = mkTyName t
+--mkTyName _ = pure $ "x"
 
 
 ------------------------------------------------------------------------------
 -- | Get a good name for a type constructor.
-mkTyConName :: TyCon -> String -> String
+mkTyConName :: TyCon -> String
 mkTyConName tc
-  | tc == listTyCon = flip mappend "s"
-  | tc == pairTyCon = mappend "p_"
-  | tc == unitTyCon = mappend "unit"
-  | tc == maybeTyCon = mappend "m_"
+  | tc == unitTyCon = "unit"
   | isSymOcc (getOccName tc)
-      = mappend
-      . take 1
+      = take 1
       . fmap toLower
       . filterReplace isSymbol      's'
       . filterReplace isPunctuation 'p'
       . occNameString
       $ getOccName tc
   | otherwise
-      = const
-      $ stem
+      = stem
       $ fmap toLower
       $ occNameString
       $ getOccName tc

From 9ab9c324d851e139d8d11619165720d85ef7acce Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Mon, 19 Apr 2021 10:24:54 -0700
Subject: [PATCH 3/9] Use camel case information for shortening long ids

---
 .../hls-tactics-plugin/src/Wingman/Naming.hs  | 120 +++++++-----------
 1 file changed, 46 insertions(+), 74 deletions(-)

diff --git a/plugins/hls-tactics-plugin/src/Wingman/Naming.hs b/plugins/hls-tactics-plugin/src/Wingman/Naming.hs
index 2382ae188d..a56a87837f 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/Naming.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/Naming.hs
@@ -1,7 +1,6 @@
 module Wingman.Naming where
 
-import           ConLike
-import           Control.Applicative
+import           Control.Arrow
 import           Control.Monad.State.Strict
 import           Data.Bool (bool)
 import           Data.Char
@@ -14,29 +13,15 @@ import           Data.Monoid
 import           Data.Set (Set)
 import qualified Data.Set as S
 import           Data.Traversable
-import           FieldLabel
-import           GhcPlugins (unpackFS, charTy, maybeTyCon)
+import           GhcPlugins (charTy, maybeTyCon)
 import           Name
 import           TcType
 import           Text.Hyphenation (hyphenate, english_US)
 import           TyCon
 import           Type
-import           TysWiredIn (listTyCon, pairTyCon, unitTyCon)
-import Wingman.GHC (tcTyVar_maybe)
-
-
-fieldNames :: ConLike -> [OccName]
-fieldNames cl =
-  case fmap (unpackFS . flLabel) $ conLikeFieldLabels cl of
-    [] -> []
-    [_] -> []
-    fields ->
-      let field_first_segs = fmap (listToMaybe . split (== '_')) fields
-      in case and $ zipWith (==) field_first_segs $ tail field_first_segs of
-            True ->
-              let common_prefix = maybe 0 ((+ 1) . length) $ head field_first_segs
-               in fmap (mkVarOcc . drop common_prefix) fields
-            False -> []
+import           TysWiredIn (listTyCon, unitTyCon)
+import           Wingman.GHC (tcTyVar_maybe)
+
 
 data Purpose
   = Function [Type] Type
@@ -66,7 +51,7 @@ pattern IsList :: Type -> Type
 pattern IsList a <- (splitTyConApp_maybe -> Just ((== listTyCon) -> True, [a]))
 
 pattern IsTyConned :: TyCon -> [Type] -> Type
-pattern IsTyConned tc args <- (splitTyConApp_maybe -> Just (tc, args))
+pattern IsTyConned tc args <- (splitTyConApp_maybe -> Just (id &&& isSymOcc . getOccName -> (tc, False), args))
 
 pattern IsTyVarred :: TyVar -> [Type] -> Type
 pattern IsTyVarred v args <- (tcSplitAppTys -> (tcTyVar_maybe -> Just v, args))
@@ -83,7 +68,9 @@ getPurposes ty = mconcat
   , [ Maybe a           | IsMaybe a           <- [ty] ]
   , [ List a            | IsList a            <- [ty] ]
   , [ TyVarred v args   | IsTyVarred v args   <- [ty] ]
-  , [ TyConned tc args  | IsTyConned tc args  <- [ty] ]
+  , [ TyConned tc args  | IsTyConned tc args  <- [ty]
+                        , not (isTupleTyCon tc)
+                        , tc /= listTyCon             ]
   ]
 
 
@@ -112,9 +99,13 @@ mkName (TyVarred tv args)
   | Just tv_args <- traverse tcTyVar_maybe args
   = pure $ foldMap (occNameString . occName) $ tv : tv_args
 mkName (TyVarred tv _) = pure $ occNameString $ occName tv
-mkName (TyConned tc args)
+mkName (TyConned tc args@(_:_))
   | Just tv_args <- traverse tcTyVar_maybe args
-  = pure $ mappend (mkTyConName tc) $ foldMap (occNameString . occName) tv_args
+  = pure $ mconcat
+      [ mkTyConName tc
+      , bool mempty "_" $ length (mkTyConName tc) > 1
+      , foldMap (occNameString . occName) tv_args
+      ]
 mkName (TyConned tc _)
   = pure
   $ mkTyConName tc
@@ -124,72 +115,53 @@ mkTyName :: Type -> [String]
 mkTyName = mkName <=< getPurposes
 
 
-
---------------------------------------------------------------------------------
----- | Use type information to create a reasonable name.
---mkTyName :: Type -> [String]
----- eg. mkTyName (a -> b) = "fab"
---mkTyName (tcSplitFunTys -> ([a@(isFunTy -> False)], b))
---  | isTyVarTy a && isTyVarTy b
---  = (\x y z -> x <> y <> z) <$> ["f", "g", "h"] <*> mkTyName a <*> mkTyName b
----- eg. mkTyName (a -> Bool) = "p"
----- mkTyName (tcSplitFunTys -> ([isFunTy -> False], isBoolTy -> True))
-----   = pure $ "p"
----- eg. mkTyName (A -> B) = "f"
----- mkTyName (tcSplitFunTys -> ([isFunTy -> False], _))
-----   = ["f", "g", "h"]
----- eg. mkTyName (a -> b -> C) = "f_C"
---mkTyName (tcSplitFunTys -> (_:_, b))
---  = fmap ("f_" <>) $ mkTyName b
----- eg. mkTyName [Char] = "str"
----- mkTyName (splitTyConApp_maybe -> Just (c, [arg]))
-----   | c == listTyCon, eqType arg charTy
-----   = pure $ "str"
----- eg. mkTyName Int = "n"
----- mkTyName (isIntTy -> True) = ["n", "i", "j"]
----- eg. mkTyName Integer = "n"
----- mkTyName (isIntegerTy -> True) = ["n", "i", "j"]
----- eg. mkTyName (T A B) = "tab"
---mkTyName (splitTyConApp_maybe -> Just (c, args))
---  = fmap (mkTyConName c $) $ foldMap mkTyName args
----- eg. mkTyName (f a) = "fa"
---mkTyName (tcSplitAppTys -> (t, args@(_:_)))
---  = liftA2 (<>) (mkTyName t) $ foldMap mkTyName args
----- eg. mkTyName a = "a"
---mkTyName (getTyVar_maybe -> Just tv)
---  = pure $ occNameString $ occName tv
----- eg. mkTyName (forall x. y) = "y"
---mkTyName (tcSplitSigmaTy -> (_:_, _, t))
---  = mkTyName t
---mkTyName _ = pure $ "x"
-
-
 ------------------------------------------------------------------------------
 -- | Get a good name for a type constructor.
 mkTyConName :: TyCon -> String
 mkTyConName tc
-  | tc == unitTyCon = "unit"
-  | isSymOcc (getOccName tc)
+  | tc == unitTyCon = "u"
+  | isSymOcc occ
       = take 1
       . fmap toLower
       . filterReplace isSymbol      's'
       . filterReplace isPunctuation 'p'
-      . occNameString
-      $ getOccName tc
+      $ name
+  | camels@(_:_:_) <- camelTerms name
+      = foldMap (fmap toLower . take 1) camels
   | otherwise
-      = stem
+      = getStem
       $ fmap toLower
-      $ occNameString
-      $ getOccName tc
+      $ name
+  where
+    occ = getOccName tc
+    name = occNameString occ
+
 
+camelTerms :: String -> [String]
+camelTerms = split (== '@') . go2 . go1
+  where
+    go1 "" = ""
+    go1 (x:u:l:xs) | isUpper u && isLower l = x : '@' : u : l : go1 xs
+    go1 (x:xs) = x : go1 xs
+    go2 "" = ""
+    go2 (l:u:xs) | isLower l && isUpper u = l : '@' : u : go2 xs
+    go2 (x:xs) = x : go2 xs
+
+
+getStem :: String -> String
+getStem str =
+  let s = stem str
+   in case (s == str, length str) of
+        (False, _)             -> s
+        (True, (<= 3) -> True) -> str
+        _                      -> take 2 str
 
 stem :: String -> String
 stem "char" = "c"
 stem "function" = "func"
 stem "bool" = "b"
 stem "either" = "e"
-stem "error" = "err"
-stem "text" = "t"
+stem "text" = "txt"
 stem s =
   let syllables = hyphenate english_US s
       (as, bs) = break (not . isLowerVowel . last) syllables
@@ -227,7 +199,7 @@ mkGoodName
     -> OccName
 mkGoodName in_scope (mkTyName -> tn)
   = mkVarOcc
-  . fromMaybe (mkNumericSuffix in_scope $ head tn)
+  . fromMaybe (mkNumericSuffix in_scope $ fromMaybe "x" $ listToMaybe tn)
   . getFirst
   . foldMap (\n -> bool (pure n) mempty $ check n)
   $ tn <> fmap (<> "'") tn

From f7ea1c7afb94387b79698b13eb68517bfb261381 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Mon, 19 Apr 2021 10:44:46 -0700
Subject: [PATCH 4/9] Update tests

---
 .../test/CodeAction/AutoSpec.hs               |  4 +--
 .../test/golden/AutoThetaFix.hs.expected      |  2 +-
 .../test/golden/AutoZip.hs.expected           |  4 +--
 .../test/golden/DestructAllAnd.hs.expected    |  2 +-
 .../test/golden/DestructAllMany.hs.expected   | 36 +++++++++----------
 .../DestructAllNonVarTopMatch.hs.expected     |  2 +-
 .../test/golden/EmptyCaseADT.hs.expected      |  2 +-
 .../test/golden/EmptyCaseApply.hs.expected    |  2 +-
 .../test/golden/EmptyCaseNested.hs.expected   |  2 +-
 .../test/golden/EmptyCaseShadow.hs.expected   |  4 +--
 .../test/golden/FmapJoin.hs.expected          |  2 +-
 .../test/golden/FmapJoinInLet.hs.expected     |  2 +-
 .../test/golden/GoldenFmapTree.hs.expected    |  3 +-
 .../test/golden/GoldenFoldr.hs.expected       |  2 +-
 .../test/golden/GoldenFromMaybe.hs.expected   |  2 +-
 .../test/golden/GoldenIntros.hs.expected      |  2 +-
 .../test/golden/GoldenJoinCont.hs.expected    |  2 +-
 .../test/golden/GoldenListFmap.hs.expected    |  2 +-
 .../test/golden/GoldenShowMapChar.hs.expected |  2 +-
 .../test/golden/KnownBigSemigroup.hs.expected |  4 +--
 .../KnownCounterfactualSemigroup.hs.expected  |  3 +-
 .../golden/KnownMissingSemigroup.hs.expected  |  2 +-
 .../KnownModuleInstanceSemigroup.hs.expected  |  3 +-
 .../golden/KnownThetaSemigroup.hs.expected    |  2 +-
 .../test/golden/LayoutSplitIn.hs.expected     |  2 +-
 .../golden/LayoutSplitViewPat.hs.expected     |  2 +-
 .../test/golden/PunShadowing.hs.expected      |  2 +-
 .../test/golden/RecordCon.hs.expected         |  2 +-
 .../test/golden/SplitPattern.hs.expected      |  4 +--
 29 files changed, 52 insertions(+), 53 deletions(-)

diff --git a/plugins/hls-tactics-plugin/test/CodeAction/AutoSpec.hs b/plugins/hls-tactics-plugin/test/CodeAction/AutoSpec.hs
index 0c81255756..2a04166fa9 100644
--- a/plugins/hls-tactics-plugin/test/CodeAction/AutoSpec.hs
+++ b/plugins/hls-tactics-plugin/test/CodeAction/AutoSpec.hs
@@ -16,7 +16,6 @@ import Wingman.FeatureSet (allFeatures)
 spec :: Spec
 spec = do
   let autoTest = goldenTest Auto ""
-      autoTestNoWhitespace = goldenTestNoWhitespace Auto ""
 
   describe "golden" $ do
     autoTest 11  8 "AutoSplitGADT.hs"
@@ -73,8 +72,7 @@ spec = do
 
   describe "known" $ do
     autoTest 25 13 "GoldenArbitrary.hs"
-    autoTestNoWhitespace
-              6 10 "KnownBigSemigroup.hs"
+    autoTest  6 10 "KnownBigSemigroup.hs"
     autoTest  4 10 "KnownThetaSemigroup.hs"
     autoTest  6 10 "KnownCounterfactualSemigroup.hs"
     autoTest 10 10 "KnownModuleInstanceSemigroup.hs"
diff --git a/plugins/hls-tactics-plugin/test/golden/AutoThetaFix.hs.expected b/plugins/hls-tactics-plugin/test/golden/AutoThetaFix.hs.expected
index db63e2bc18..ba8df349e4 100644
--- a/plugins/hls-tactics-plugin/test/golden/AutoThetaFix.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/AutoThetaFix.hs.expected
@@ -9,5 +9,5 @@ instance ( Functor 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)
+  fmap fab (Fix f) = Fix (fmap (fmap fab) f)
 
diff --git a/plugins/hls-tactics-plugin/test/golden/AutoZip.hs.expected b/plugins/hls-tactics-plugin/test/golden/AutoZip.hs.expected
index 4b1ede7122..997bc09a33 100644
--- a/plugins/hls-tactics-plugin/test/golden/AutoZip.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/AutoZip.hs.expected
@@ -1,6 +1,6 @@
 zip_it_up_and_zip_it_out :: [a] -> [b] -> [(a, b)]
 zip_it_up_and_zip_it_out _ [] = []
 zip_it_up_and_zip_it_out [] (_ : _) = []
-zip_it_up_and_zip_it_out (a : l_a5) (b : l_b3)
-  = (a, b) : zip_it_up_and_zip_it_out l_a5 l_b3
+zip_it_up_and_zip_it_out (a : as') (b : bs')
+  = (a, b) : zip_it_up_and_zip_it_out as' bs'
 
diff --git a/plugins/hls-tactics-plugin/test/golden/DestructAllAnd.hs.expected b/plugins/hls-tactics-plugin/test/golden/DestructAllAnd.hs.expected
index 0559503178..83a0c09f35 100644
--- a/plugins/hls-tactics-plugin/test/golden/DestructAllAnd.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/DestructAllAnd.hs.expected
@@ -1,5 +1,5 @@
 and :: Bool -> Bool -> Bool
 and False False = _
-and True False = _
 and False True = _
+and True False = _
 and True True = _
diff --git a/plugins/hls-tactics-plugin/test/golden/DestructAllMany.hs.expected b/plugins/hls-tactics-plugin/test/golden/DestructAllMany.hs.expected
index 95dd543773..27e3c93ae0 100644
--- a/plugins/hls-tactics-plugin/test/golden/DestructAllMany.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/DestructAllMany.hs.expected
@@ -2,26 +2,26 @@ data ABC = A | B | C
 
 many :: () -> Either a b -> Bool -> Maybe ABC -> ABC -> ()
 many () (Left a) False Nothing A = _
-many () (Right b5) False Nothing A = _
+many () (Left a) False (Just abc') A = _
+many () (Right b') False Nothing A = _
+many () (Right b') False (Just abc') A = _
 many () (Left a) True Nothing A = _
-many () (Right b5) True Nothing A = _
-many () (Left a6) False (Just a) A = _
-many () (Right b6) False (Just a) A = _
-many () (Left a6) True (Just a) A = _
-many () (Right b6) True (Just a) A = _
+many () (Left a) True (Just abc') A = _
+many () (Right b') True Nothing A = _
+many () (Right b') True (Just abc') A = _
 many () (Left a) False Nothing B = _
-many () (Right b5) False Nothing B = _
+many () (Left a) False (Just abc') B = _
+many () (Right b') False Nothing B = _
+many () (Right b') False (Just abc') B = _
 many () (Left a) True Nothing B = _
-many () (Right b5) True Nothing B = _
-many () (Left a6) False (Just a) B = _
-many () (Right b6) False (Just a) B = _
-many () (Left a6) True (Just a) B = _
-many () (Right b6) True (Just a) B = _
+many () (Left a) True (Just abc') B = _
+many () (Right b') True Nothing B = _
+many () (Right b') True (Just abc') B = _
 many () (Left a) False Nothing C = _
-many () (Right b5) False Nothing C = _
+many () (Left a) False (Just abc') C = _
+many () (Right b') False Nothing C = _
+many () (Right b') False (Just abc') C = _
 many () (Left a) True Nothing C = _
-many () (Right b5) True Nothing C = _
-many () (Left a6) False (Just a) C = _
-many () (Right b6) False (Just a) C = _
-many () (Left a6) True (Just a) C = _
-many () (Right b6) True (Just a) C = _
+many () (Left a) True (Just abc') C = _
+many () (Right b') True Nothing C = _
+many () (Right b') True (Just abc') C = _
diff --git a/plugins/hls-tactics-plugin/test/golden/DestructAllNonVarTopMatch.hs.expected b/plugins/hls-tactics-plugin/test/golden/DestructAllNonVarTopMatch.hs.expected
index c63a963932..8588fdcbd2 100644
--- a/plugins/hls-tactics-plugin/test/golden/DestructAllNonVarTopMatch.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/DestructAllNonVarTopMatch.hs.expected
@@ -1,6 +1,6 @@
 and :: (a, b) -> Bool -> Bool -> Bool
 and (a, b) False False = _
-and (a, b) True False = _
 and (a, b) False True = _
+and (a, b) True False = _
 and (a, b) True True = _
 
diff --git a/plugins/hls-tactics-plugin/test/golden/EmptyCaseADT.hs.expected b/plugins/hls-tactics-plugin/test/golden/EmptyCaseADT.hs.expected
index 199bbb0db9..84d2b80d0e 100644
--- a/plugins/hls-tactics-plugin/test/golden/EmptyCaseADT.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/EmptyCaseADT.hs.expected
@@ -2,7 +2,7 @@ data Foo = A Int | B Bool | C
 
 foo :: Foo -> ()
 foo x = case x of
-  A i -> _
+  A n -> _
   B b -> _
   C -> _
 
diff --git a/plugins/hls-tactics-plugin/test/golden/EmptyCaseApply.hs.expected b/plugins/hls-tactics-plugin/test/golden/EmptyCaseApply.hs.expected
index fe22299c93..1895dd6256 100644
--- a/plugins/hls-tactics-plugin/test/golden/EmptyCaseApply.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/EmptyCaseApply.hs.expected
@@ -1,3 +1,3 @@
 blah = case show 5 of
   [] -> _
-  c : l_c -> _
+  c : s -> _
diff --git a/plugins/hls-tactics-plugin/test/golden/EmptyCaseNested.hs.expected b/plugins/hls-tactics-plugin/test/golden/EmptyCaseNested.hs.expected
index 10c6925951..ef873a7c41 100644
--- a/plugins/hls-tactics-plugin/test/golden/EmptyCaseNested.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/EmptyCaseNested.hs.expected
@@ -1,5 +1,5 @@
 test =
   case (case (Just "") of
   Nothing -> _
-  Just l_c -> _) of
+  Just s -> _) of
     True -> _
diff --git a/plugins/hls-tactics-plugin/test/golden/EmptyCaseShadow.hs.expected b/plugins/hls-tactics-plugin/test/golden/EmptyCaseShadow.hs.expected
index d35cf1a1f5..2c5158b856 100644
--- a/plugins/hls-tactics-plugin/test/golden/EmptyCaseShadow.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/EmptyCaseShadow.hs.expected
@@ -4,7 +4,7 @@ data Foo = A Int | B Bool | C
 -- split
 foo :: Int -> Bool -> Foo -> ()
 foo i b x = case x of
-  A i3 -> _
-  B b3 -> _
+  A n -> _
+  B b' -> _
   C -> _
 
diff --git a/plugins/hls-tactics-plugin/test/golden/FmapJoin.hs.expected b/plugins/hls-tactics-plugin/test/golden/FmapJoin.hs.expected
index ede310d808..5dc5026f8b 100644
--- a/plugins/hls-tactics-plugin/test/golden/FmapJoin.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/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 (\ m -> m >>= id)
diff --git a/plugins/hls-tactics-plugin/test/golden/FmapJoinInLet.hs.expected b/plugins/hls-tactics-plugin/test/golden/FmapJoinInLet.hs.expected
index ebdd0a2ebb..ac4b54ae9d 100644
--- a/plugins/hls-tactics-plugin/test/golden/FmapJoinInLet.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/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 = ( (\ m -> m >>= id) :: m (m a) -> m a) in fmap f
diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenFmapTree.hs.expected b/plugins/hls-tactics-plugin/test/golden/GoldenFmapTree.hs.expected
index 8f20041e20..bd0957b703 100644
--- a/plugins/hls-tactics-plugin/test/golden/GoldenFmapTree.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/GoldenFmapTree.hs.expected
@@ -2,4 +2,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 (Branch tr_a' tr_a2)
+     = Branch (fmap fab tr_a') (fmap fab tr_a2)
diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenFoldr.hs.expected b/plugins/hls-tactics-plugin/test/golden/GoldenFoldr.hs.expected
index 4e98d0c50e..89db0adb76 100644
--- a/plugins/hls-tactics-plugin/test/golden/GoldenFoldr.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/GoldenFoldr.hs.expected
@@ -1,3 +1,3 @@
 foldr2 :: (a -> b -> b) -> b -> [a] -> b
 foldr2 _ b [] = b
-foldr2 f_b b (a : l_a4) = f_b a (foldr2 f_b b l_a4)
+foldr2 fabb b (a : as') = fabb a (foldr2 fabb b as')
diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenFromMaybe.hs.expected b/plugins/hls-tactics-plugin/test/golden/GoldenFromMaybe.hs.expected
index 90f8edcb79..5b39ea5a4b 100644
--- a/plugins/hls-tactics-plugin/test/golden/GoldenFromMaybe.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/GoldenFromMaybe.hs.expected
@@ -1,3 +1,3 @@
 fromMaybe :: a -> Maybe a -> a
 fromMaybe a Nothing = a
-fromMaybe _ (Just a2) = a2
+fromMaybe _ (Just a') = a'
diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenIntros.hs.expected b/plugins/hls-tactics-plugin/test/golden/GoldenIntros.hs.expected
index 23eadc5edc..1a17ee1be0 100644
--- a/plugins/hls-tactics-plugin/test/golden/GoldenIntros.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/GoldenIntros.hs.expected
@@ -1,2 +1,2 @@
 blah :: Int -> Bool -> (a -> b) -> String -> Int
-blah i b fab l_c = _
+blah n b fab s = _
diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenJoinCont.hs.expected b/plugins/hls-tactics-plugin/test/golden/GoldenJoinCont.hs.expected
index 042675ab0b..e941214796 100644
--- a/plugins/hls-tactics-plugin/test/golden/GoldenJoinCont.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/GoldenJoinCont.hs.expected
@@ -1,4 +1,4 @@
 type Cont r a = ((a -> r) -> r)
 
 joinCont :: Cont r (Cont r a) -> Cont r a
-joinCont f_r far = f_r (\ f_r2 -> f_r2 far)
+joinCont f far = f (\ g -> g far)
diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenListFmap.hs.expected b/plugins/hls-tactics-plugin/test/golden/GoldenListFmap.hs.expected
index 4a0af02b09..ec44241736 100644
--- a/plugins/hls-tactics-plugin/test/golden/GoldenListFmap.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/GoldenListFmap.hs.expected
@@ -1,3 +1,3 @@
 fmapList :: (a -> b) -> [a] -> [b]
 fmapList _ [] = []
-fmapList fab (a : l_a3) = fab a : fmapList fab l_a3
+fmapList fab (a : as') = fab a : fmapList fab as'
diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenShowMapChar.hs.expected b/plugins/hls-tactics-plugin/test/golden/GoldenShowMapChar.hs.expected
index 22ab0bec15..c32357d1a9 100644
--- a/plugins/hls-tactics-plugin/test/golden/GoldenShowMapChar.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/GoldenShowMapChar.hs.expected
@@ -1,2 +1,2 @@
 test :: Show a => a -> (String -> b) -> b
-test a fl_cb = fl_cb (show a)
+test a f = f (show a)
diff --git a/plugins/hls-tactics-plugin/test/golden/KnownBigSemigroup.hs.expected b/plugins/hls-tactics-plugin/test/golden/KnownBigSemigroup.hs.expected
index b388428aa8..78ba8ca119 100644
--- a/plugins/hls-tactics-plugin/test/golden/KnownBigSemigroup.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/KnownBigSemigroup.hs.expected
@@ -3,7 +3,7 @@ import Data.Monoid
 data Big a = Big [Bool] (Sum Int) String (Endo a) Any
 
 instance Semigroup (Big a) where
-  (<>) (Big l_b7 si8 l_c9 ea10 a11) (Big l_b si l_c ea a)
+  (<>) (Big bs sum s en_a any) (Big bs' sum' str en_a' any')
     = Big
-        (l_b7 <> l_b) (si8 <> si) (l_c9 <> l_c) (ea10 <> ea) (a11 <> a)
+        (bs <> bs') (sum <> sum') (s <> str) (en_a <> en_a') (any <> any')
 
diff --git a/plugins/hls-tactics-plugin/test/golden/KnownCounterfactualSemigroup.hs.expected b/plugins/hls-tactics-plugin/test/golden/KnownCounterfactualSemigroup.hs.expected
index 5612a05b7d..ac653868a8 100644
--- a/plugins/hls-tactics-plugin/test/golden/KnownCounterfactualSemigroup.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/KnownCounterfactualSemigroup.hs.expected
@@ -3,6 +3,5 @@
 data Semi = Semi [String] Int
 
 instance Semigroup Int => Semigroup Semi where
-  (<>) (Semi l_l_c5 i6) (Semi l_l_c i)
-    = Semi (l_l_c5 <> l_l_c) (i6 <> i)
+  (<>) (Semi ss n) (Semi strs i) = Semi (ss <> strs) (n <> i)
 
diff --git a/plugins/hls-tactics-plugin/test/golden/KnownMissingSemigroup.hs.expected b/plugins/hls-tactics-plugin/test/golden/KnownMissingSemigroup.hs.expected
index 3e1adde221..19573d9c8a 100644
--- a/plugins/hls-tactics-plugin/test/golden/KnownMissingSemigroup.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/KnownMissingSemigroup.hs.expected
@@ -1,5 +1,5 @@
 data Semi = Semi [String] Int
 
 instance Semigroup Semi where
-  (<>) (Semi l_l_c4 i5) (Semi l_l_c i) = Semi (l_l_c4 <> l_l_c) _
+  (<>) (Semi ss n) (Semi strs i) = Semi (ss <> strs) _
 
diff --git a/plugins/hls-tactics-plugin/test/golden/KnownModuleInstanceSemigroup.hs.expected b/plugins/hls-tactics-plugin/test/golden/KnownModuleInstanceSemigroup.hs.expected
index 9bd4de84a5..e5f3b54b7b 100644
--- a/plugins/hls-tactics-plugin/test/golden/KnownModuleInstanceSemigroup.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/KnownModuleInstanceSemigroup.hs.expected
@@ -7,5 +7,6 @@ instance Semigroup Foo where
 data Bar = Bar Foo Foo
 
 instance Semigroup Bar where
-  (<>) (Bar f4 f5) (Bar f f3) = Bar (f4 <> f) (f5 <> f3)
+  (<>) (Bar foo foo') (Bar foo2 foo3)
+    = Bar (foo <> foo2) (foo' <> foo3)
 
diff --git a/plugins/hls-tactics-plugin/test/golden/KnownThetaSemigroup.hs.expected b/plugins/hls-tactics-plugin/test/golden/KnownThetaSemigroup.hs.expected
index 3d85f9f3a6..d85d831093 100644
--- a/plugins/hls-tactics-plugin/test/golden/KnownThetaSemigroup.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/KnownThetaSemigroup.hs.expected
@@ -1,5 +1,5 @@
 data Semi a = Semi a
 
 instance Semigroup a => Semigroup (Semi a) where
-  (<>) (Semi a4) (Semi a) = Semi (a4 <> a)
+  (<>) (Semi a) (Semi a') = Semi (a <> a')
 
diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutSplitIn.hs.expected b/plugins/hls-tactics-plugin/test/golden/LayoutSplitIn.hs.expected
index f6f3ffceab..a184fe004f 100644
--- a/plugins/hls-tactics-plugin/test/golden/LayoutSplitIn.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/LayoutSplitIn.hs.expected
@@ -1,5 +1,5 @@
 test :: a
 test =
   let a = (1,"bbb")
-   in case a of { (i, l_c) -> _ }
+   in case a of { (n, s) -> _ }
 
diff --git a/plugins/hls-tactics-plugin/test/golden/LayoutSplitViewPat.hs.expected b/plugins/hls-tactics-plugin/test/golden/LayoutSplitViewPat.hs.expected
index 81d49a4ff7..132ae26baf 100644
--- a/plugins/hls-tactics-plugin/test/golden/LayoutSplitViewPat.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/LayoutSplitViewPat.hs.expected
@@ -2,5 +2,5 @@
 
 splitLookup :: [(Int, String)] -> String
 splitLookup (lookup 5 -> Nothing) = _
-splitLookup (lookup 5 -> (Just l_c)) = _
+splitLookup (lookup 5 -> (Just s)) = _
 
diff --git a/plugins/hls-tactics-plugin/test/golden/PunShadowing.hs.expected b/plugins/hls-tactics-plugin/test/golden/PunShadowing.hs.expected
index 9fde845a96..30085f4711 100644
--- a/plugins/hls-tactics-plugin/test/golden/PunShadowing.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/PunShadowing.hs.expected
@@ -1,5 +1,5 @@
 data Bar = Bar { ax :: Int, bax :: Bool }
 
 bar :: () -> Bar -> Int
-bar ax Bar {ax = i, bax} = _
+bar ax Bar {ax = n, bax} = _
 
diff --git a/plugins/hls-tactics-plugin/test/golden/RecordCon.hs.expected b/plugins/hls-tactics-plugin/test/golden/RecordCon.hs.expected
index 9abb0ff3f9..cfc2235bfb 100644
--- a/plugins/hls-tactics-plugin/test/golden/RecordCon.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/RecordCon.hs.expected
@@ -4,6 +4,6 @@ data MyRecord a = Record
     }
 
 blah :: (a -> Int) -> a -> MyRecord a
-blah fai a = Record {field1 = a, field2 = fai a}
+blah f a = Record {field1 = a, field2 = f a}
 
 
diff --git a/plugins/hls-tactics-plugin/test/golden/SplitPattern.hs.expected b/plugins/hls-tactics-plugin/test/golden/SplitPattern.hs.expected
index 44d98f1fbd..7691dfdbab 100644
--- a/plugins/hls-tactics-plugin/test/golden/SplitPattern.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/SplitPattern.hs.expected
@@ -5,8 +5,8 @@ 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 (Two n)) = _
 case_split (Four b Three) = _
-case_split (Four b (Four b3 a4)) = _
+case_split (Four b (Four b' adt)) = _
 case_split (Four b Five) = _
 case_split Five       = _

From 1222df8d62eb3a99103a1b14de01432fb334b1f3 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Mon, 19 Apr 2021 11:34:52 -0700
Subject: [PATCH 5/9] Haddock and minor prime fix for tycons

---
 .../hls-tactics-plugin/src/Wingman/Naming.hs  | 124 ++++++++++--------
 1 file changed, 72 insertions(+), 52 deletions(-)

diff --git a/plugins/hls-tactics-plugin/src/Wingman/Naming.hs b/plugins/hls-tactics-plugin/src/Wingman/Naming.hs
index a56a87837f..51416ecd21 100644
--- a/plugins/hls-tactics-plugin/src/Wingman/Naming.hs
+++ b/plugins/hls-tactics-plugin/src/Wingman/Naming.hs
@@ -2,6 +2,7 @@ module Wingman.Naming where
 
 import           Control.Arrow
 import           Control.Monad.State.Strict
+import           Data.Aeson (camelTo2)
 import           Data.Bool (bool)
 import           Data.Char
 import           Data.List (isPrefixOf)
@@ -23,6 +24,9 @@ import           TysWiredIn (listTyCon, unitTyCon)
 import           Wingman.GHC (tcTyVar_maybe)
 
 
+------------------------------------------------------------------------------
+-- | A classification of a variable, for which we have specific naming rules.
+-- A variable can have multiple purposes simultaneously.
 data Purpose
   = Function [Type] Type
   | Predicate
@@ -33,30 +37,45 @@ data Purpose
   | List Type
   | Maybe Type
   | TyConned TyCon [Type]
+    -- ^ Something of the form @TC a b c@
   | TyVarred TyVar [Type]
+    -- ^ Something of the form @m a b c@
 
 pattern IsPredicate :: Type
-pattern IsPredicate <- (tcSplitFunTys -> ([isFunTy -> False], isBoolTy -> True))
+pattern IsPredicate <-
+  (tcSplitFunTys -> ([isFunTy -> False], isBoolTy -> True))
 
 pattern IsFunction :: [Type] -> Type -> Type
-pattern IsFunction args res <- (tcSplitFunTys -> (args@(_:_), res))
+pattern IsFunction args res <-
+  (tcSplitFunTys -> (args@(_:_), res))
 
 pattern IsString :: Type
-pattern IsString <- (splitTyConApp_maybe -> Just ((== listTyCon) -> True, [eqType charTy -> True]))
+pattern IsString <-
+  (splitTyConApp_maybe -> Just ((== listTyCon) -> True, [eqType charTy -> True]))
 
 pattern IsMaybe :: Type -> Type
-pattern IsMaybe a <- (splitTyConApp_maybe -> Just ((== maybeTyCon) -> True, [a]))
+pattern IsMaybe a <-
+  (splitTyConApp_maybe -> Just ((== maybeTyCon) -> True, [a]))
 
 pattern IsList :: Type -> Type
-pattern IsList a <- (splitTyConApp_maybe -> Just ((== listTyCon) -> True, [a]))
+pattern IsList a <-
+  (splitTyConApp_maybe -> Just ((== listTyCon) -> True, [a]))
 
 pattern IsTyConned :: TyCon -> [Type] -> Type
-pattern IsTyConned tc args <- (splitTyConApp_maybe -> Just (id &&& isSymOcc . getOccName -> (tc, False), args))
+pattern IsTyConned tc args <-
+  (splitTyConApp_maybe -> Just (id &&& isSymOcc . getOccName -> (tc, False), args))
 
 pattern IsTyVarred :: TyVar -> [Type] -> Type
-pattern IsTyVarred v args <- (tcSplitAppTys -> (tcTyVar_maybe -> Just v, args))
+pattern IsTyVarred v args <-
+  (tcSplitAppTys -> (tcTyVar_maybe -> Just v, args))
 
 
+------------------------------------------------------------------------------
+-- | Get the 'Purpose's of a type. A type can have multiple purposes
+-- simultaneously, so the order of purposes in this function corresponds to the
+-- precedence of that naming rule. Which means, eg, that if a type is both
+-- a 'Predicate' and a 'Function', we should prefer to use the predicate naming
+-- rules, since they come first.
 getPurposes :: Type -> [Purpose]
 getPurposes ty = mconcat
   [ [ Predicate         | IsPredicate         <- [ty] ]
@@ -74,45 +93,57 @@ getPurposes ty = mconcat
   ]
 
 
+------------------------------------------------------------------------------
+-- | Return 'mempty' if the give bool is false.
 with :: Monoid a => Bool -> a -> a
 with False _ = mempty
 with True a = a
 
 
+------------------------------------------------------------------------------
+-- | Names we can give functions
 functionNames :: [String]
 functionNames = ["f", "g", "h"]
 
 
-mkName :: Purpose -> [String]
-mkName (Function args res)
+------------------------------------------------------------------------------
+-- | Get a ranked ordering of names for a given purpose.
+purposeToName :: Purpose -> [String]
+purposeToName (Function args res)
   | Just tv_args <- traverse tcTyVar_maybe $ args <> pure res
   = fmap (<> foldMap (occNameString . occName) tv_args) functionNames
-mkName (Function _ _) = functionNames
-mkName Predicate = pure "p"
-mkName Continuation = pure "k"
-mkName Integral = ["n", "i", "j"]
-mkName Number = ["x", "y", "z", "w"]
-mkName String = ["s", "str"]
-mkName (List t) = fmap (<> "s") $ mkName =<< getPurposes t
-mkName (Maybe t) = fmap ("m_" <>) $ mkName =<< getPurposes t
-mkName (TyVarred tv args)
+purposeToName (Function _ _) = functionNames
+purposeToName Predicate = pure "p"
+purposeToName Continuation = pure "k"
+purposeToName Integral = ["n", "i", "j"]
+purposeToName Number = ["x", "y", "z", "w"]
+purposeToName String = ["s", "str"]
+purposeToName (List t) = fmap (<> "s") $ purposeToName =<< getPurposes t
+purposeToName (Maybe t) = fmap ("m_" <>) $ purposeToName =<< getPurposes t
+purposeToName (TyVarred tv args)
   | Just tv_args <- traverse tcTyVar_maybe args
   = pure $ foldMap (occNameString . occName) $ tv : tv_args
-mkName (TyVarred tv _) = pure $ occNameString $ occName tv
-mkName (TyConned tc args@(_:_))
+purposeToName (TyVarred tv _) = pure $ occNameString $ occName tv
+purposeToName (TyConned tc args@(_:_))
   | Just tv_args <- traverse tcTyVar_maybe args
-  = pure $ mconcat
+  = [ mkTyConName tc
+      -- We insert primes to everything later, but it gets the lowest
+      -- precedence. Here we'd like to prefer it over the more specific type
+      -- name.
+    , mkTyConName tc <> "'"
+    , mconcat
       [ mkTyConName tc
       , bool mempty "_" $ length (mkTyConName tc) > 1
       , foldMap (occNameString . occName) tv_args
       ]
-mkName (TyConned tc _)
+    ]
+purposeToName (TyConned tc _)
   = pure
   $ mkTyConName tc
 
 
 mkTyName :: Type -> [String]
-mkTyName = mkName <=< getPurposes
+mkTyName = purposeToName <=< getPurposes
 
 
 ------------------------------------------------------------------------------
@@ -137,17 +168,20 @@ mkTyConName tc
     name = occNameString occ
 
 
+------------------------------------------------------------------------------
+-- | Split a string into its camel case components.
 camelTerms :: String -> [String]
-camelTerms = split (== '@') . go2 . go1
-  where
-    go1 "" = ""
-    go1 (x:u:l:xs) | isUpper u && isLower l = x : '@' : u : l : go1 xs
-    go1 (x:xs) = x : go1 xs
-    go2 "" = ""
-    go2 (l:u:xs) | isLower l && isUpper u = l : '@' : u : go2 xs
-    go2 (x:xs) = x : go2 xs
+camelTerms = split (== '@') . camelTo2 '@'
 
 
+------------------------------------------------------------------------------
+-- | A stem of a string is either a special-case shortened form, or a shortened
+-- first syllable. If the string is one syllable, we take the full word if it's
+-- short, or just the first two characters if it's long. Otherwise, just take
+-- the first syllable.
+--
+-- NOTE: There's no rhyme or reason here, I just experimented until I got
+-- results that were reasonably consistent with the names I would give things.
 getStem :: String -> String
 getStem str =
   let s = stem str
@@ -156,34 +190,16 @@ getStem str =
         (True, (<= 3) -> True) -> str
         _                      -> take 2 str
 
+------------------------------------------------------------------------------
+-- | Get a special-case stem, or, failing that, give back the first syllable.
 stem :: String -> String
 stem "char" = "c"
 stem "function" = "func"
 stem "bool" = "b"
 stem "either" = "e"
 stem "text" = "txt"
-stem s =
-  let syllables = hyphenate english_US s
-      (as, bs) = break (not . isLowerVowel . last) syllables
-   in join as <>
-     case bs of
-       [] -> ""
-       [b] -> b
-       (b : next : _) -> b <>
-         takeWhile (not . isLowerVowel) next
-
+stem s = join $ take 1 $ hyphenate english_US s
 
-isLowerVowel :: Char -> Bool
-isLowerVowel 'a' = True
-isLowerVowel 'e' = True
-isLowerVowel 'i' = True
-isLowerVowel 'o' = True
-isLowerVowel 'u' = True
-isLowerVowel _ = False
-
-
-takeUntil :: (a -> Bool) -> [a] -> [a]
-takeUntil p = foldr (\x ys -> x : if p x then [] else ys) []
 
 ------------------------------------------------------------------------------
 -- | Maybe replace an element in the list if the predicate matches
@@ -207,6 +223,10 @@ mkGoodName in_scope (mkTyName -> tn)
     check n = S.member (mkVarOcc n) in_scope
 
 
+------------------------------------------------------------------------------
+-- | Given a desired name, compute a new name for it based on how many names in
+-- scope conflict with it. Eg, if we want to name something @x@, but already
+-- have @x@, @x'@ and @x2@ in scope, we will give back @x3@.
 mkNumericSuffix :: Set OccName -> String -> String
 mkNumericSuffix s nm =
   mappend nm . show . length . filter (isPrefixOf nm . occNameString) $ S.toList s

From a218e0795b2ffd3a9b03b720e5597fdb0acd9889 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Mon, 19 Apr 2021 11:35:13 -0700
Subject: [PATCH 6/9] Fix tests

---
 .../test/golden/GoldenFmapTree.hs.expected                   | 3 +--
 .../test/golden/KnownBigSemigroup.hs.expected                | 5 ++---
 2 files changed, 3 insertions(+), 5 deletions(-)

diff --git a/plugins/hls-tactics-plugin/test/golden/GoldenFmapTree.hs.expected b/plugins/hls-tactics-plugin/test/golden/GoldenFmapTree.hs.expected
index bd0957b703..2b32b3a9cd 100644
--- a/plugins/hls-tactics-plugin/test/golden/GoldenFmapTree.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/GoldenFmapTree.hs.expected
@@ -2,5 +2,4 @@ data Tree a = Leaf a | Branch (Tree a) (Tree a)
 
 instance Functor Tree where
    fmap fab (Leaf a) = Leaf (fab a)
-   fmap fab (Branch tr_a' tr_a2)
-     = Branch (fmap fab tr_a') (fmap fab tr_a2)
+   fmap fab (Branch tr' tr_a) = Branch (fmap fab tr') (fmap fab tr_a)
diff --git a/plugins/hls-tactics-plugin/test/golden/KnownBigSemigroup.hs.expected b/plugins/hls-tactics-plugin/test/golden/KnownBigSemigroup.hs.expected
index 78ba8ca119..89cfe57479 100644
--- a/plugins/hls-tactics-plugin/test/golden/KnownBigSemigroup.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/KnownBigSemigroup.hs.expected
@@ -3,7 +3,6 @@ import Data.Monoid
 data Big a = Big [Bool] (Sum Int) String (Endo a) Any
 
 instance Semigroup (Big a) where
-  (<>) (Big bs sum s en_a any) (Big bs' sum' str en_a' any')
-    = Big
-        (bs <> bs') (sum <> sum') (s <> str) (en_a <> en_a') (any <> any')
+  (<>) (Big bs sum s en any) (Big bs' sum' s' en' any')
+    = Big (bs <> bs') (sum <> sum') (s <> s') (en <> en') (any <> any')
 

From e9588bed323fc57662e1d32382dd1a972c212a08 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Mon, 19 Apr 2021 11:35:17 -0700
Subject: [PATCH 7/9] Add Cthulhu test

---
 .../test/CodeAction/DestructSpec.hs           |  9 ++--
 .../test/golden/DestructCthulhu.hs            | 31 +++++++++++
 .../test/golden/DestructCthulhu.hs.expected   | 54 +++++++++++++++++++
 3 files changed, 90 insertions(+), 4 deletions(-)
 create mode 100644 plugins/hls-tactics-plugin/test/golden/DestructCthulhu.hs
 create mode 100644 plugins/hls-tactics-plugin/test/golden/DestructCthulhu.hs.expected

diff --git a/plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs b/plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs
index adf2bce473..aff0d3ee14 100644
--- a/plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs
+++ b/plugins/hls-tactics-plugin/test/CodeAction/DestructSpec.hs
@@ -17,10 +17,11 @@ spec = do
   let destructTest = goldenTest Destruct
 
   describe "golden" $ do
-    destructTest "gadt" 7 17 "GoldenGADTDestruct.hs"
-    destructTest "gadt" 8 17 "GoldenGADTDestructCoercion.hs"
-    destructTest "a"    7 25 "SplitPattern.hs"
-    destructTest "a"    6 18 "DestructPun.hs"
+    destructTest "gadt"  7 17 "GoldenGADTDestruct.hs"
+    destructTest "gadt"  8 17 "GoldenGADTDestructCoercion.hs"
+    destructTest "a"     7 25 "SplitPattern.hs"
+    destructTest "a"     6 18 "DestructPun.hs"
+    destructTest "fp"   31 14 "DestructCthulhu.hs"
 
   describe "layout" $ do
     destructTest "b"  4  3 "LayoutBind.hs"
diff --git a/plugins/hls-tactics-plugin/test/golden/DestructCthulhu.hs b/plugins/hls-tactics-plugin/test/golden/DestructCthulhu.hs
new file mode 100644
index 0000000000..a2d04bb6a2
--- /dev/null
+++ b/plugins/hls-tactics-plugin/test/golden/DestructCthulhu.hs
@@ -0,0 +1,31 @@
+{-# LANGUAGE GADTs #-}
+
+data FreePro r c a b where
+  ID        :: FreePro r c x x
+  Comp      :: FreePro r c x y -> FreePro r c y z -> FreePro r c x z
+  Copy      :: FreePro r c x (x, x)
+  Consume   :: FreePro r c x ()
+  Swap      :: FreePro r c (a, b) (b, a)
+  SwapE     :: FreePro r c (Either a b) (Either b a)
+  Fst       :: FreePro r c (a, b) a
+  Snd       :: FreePro r c (a, b) b
+  InjectL   :: FreePro r c a (Either a b)
+  InjectR   :: FreePro r c b (Either a b)
+  Unify     :: FreePro r c (Either a a) a
+  First     :: FreePro r c a b -> FreePro r c (a, m) (b, m)
+  Second    :: FreePro r c a b -> FreePro r c (m, a) (m, b)
+  Alongside :: FreePro r c a b -> FreePro r c a' b' -> FreePro r c (a, a') (b, b')
+  Fanout    :: FreePro r c a b -> FreePro r c a b' -> FreePro r c a (b, b')
+  Left'     :: FreePro r c a b -> FreePro r c (Either a x) (Either b x)
+  Right'    :: FreePro r c a b -> FreePro r c (Either x a) (Either x b)
+  EitherOf  :: FreePro r c a b -> FreePro r c a' b' -> FreePro r c (Either a a') (Either b b')
+  Fanin     :: FreePro r c a b -> FreePro r c a' b -> FreePro r c (Either a a') b
+  LiftC     :: c a b -> FreePro r c a b
+  Zero      :: FreePro r c x y
+  Plus      :: FreePro r c x y -> FreePro r c x y -> FreePro r c x y
+  Unleft    :: FreePro r c (Either a d) (Either b d) -> FreePro r c a b
+  Unright   :: FreePro r c (Either d a) (Either d b) -> FreePro r c a b
+
+
+cthulhu :: FreePro r c a b -> FreePro r c a b
+cthulhu fp = _
diff --git a/plugins/hls-tactics-plugin/test/golden/DestructCthulhu.hs.expected b/plugins/hls-tactics-plugin/test/golden/DestructCthulhu.hs.expected
new file mode 100644
index 0000000000..610956daea
--- /dev/null
+++ b/plugins/hls-tactics-plugin/test/golden/DestructCthulhu.hs.expected
@@ -0,0 +1,54 @@
+{-# LANGUAGE GADTs #-}
+
+data FreePro r c a b where
+  ID        :: FreePro r c x x
+  Comp      :: FreePro r c x y -> FreePro r c y z -> FreePro r c x z
+  Copy      :: FreePro r c x (x, x)
+  Consume   :: FreePro r c x ()
+  Swap      :: FreePro r c (a, b) (b, a)
+  SwapE     :: FreePro r c (Either a b) (Either b a)
+  Fst       :: FreePro r c (a, b) a
+  Snd       :: FreePro r c (a, b) b
+  InjectL   :: FreePro r c a (Either a b)
+  InjectR   :: FreePro r c b (Either a b)
+  Unify     :: FreePro r c (Either a a) a
+  First     :: FreePro r c a b -> FreePro r c (a, m) (b, m)
+  Second    :: FreePro r c a b -> FreePro r c (m, a) (m, b)
+  Alongside :: FreePro r c a b -> FreePro r c a' b' -> FreePro r c (a, a') (b, b')
+  Fanout    :: FreePro r c a b -> FreePro r c a b' -> FreePro r c a (b, b')
+  Left'     :: FreePro r c a b -> FreePro r c (Either a x) (Either b x)
+  Right'    :: FreePro r c a b -> FreePro r c (Either x a) (Either x b)
+  EitherOf  :: FreePro r c a b -> FreePro r c a' b' -> FreePro r c (Either a a') (Either b b')
+  Fanin     :: FreePro r c a b -> FreePro r c a' b -> FreePro r c (Either a a') b
+  LiftC     :: c a b -> FreePro r c a b
+  Zero      :: FreePro r c x y
+  Plus      :: FreePro r c x y -> FreePro r c x y -> FreePro r c x y
+  Unleft    :: FreePro r c (Either a d) (Either b d) -> FreePro r c a b
+  Unright   :: FreePro r c (Either d a) (Either d b) -> FreePro r c a b
+
+
+cthulhu :: FreePro r c a b -> FreePro r c a b
+cthulhu ID = _
+cthulhu (Comp fp' fp_rcyb) = _
+cthulhu Copy = _
+cthulhu Consume = _
+cthulhu Swap = _
+cthulhu SwapE = _
+cthulhu Fst = _
+cthulhu Snd = _
+cthulhu InjectL = _
+cthulhu InjectR = _
+cthulhu Unify = _
+cthulhu (First fp') = _
+cthulhu (Second fp') = _
+cthulhu (Alongside fp' fp_rca'b') = _
+cthulhu (Fanout fp' fp_rcab') = _
+cthulhu (Left' fp') = _
+cthulhu (Right' fp') = _
+cthulhu (EitherOf fp' fp_rca'b') = _
+cthulhu (Fanin fp' fp_rca'b) = _
+cthulhu (LiftC cab) = _
+cthulhu Zero = _
+cthulhu (Plus fp' fp_rcab) = _
+cthulhu (Unleft fp') = _
+cthulhu (Unright fp') = _

From ce4612d764c4e50f516c8af0f8e716849d9a4052 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Mon, 19 Apr 2021 13:45:14 -0700
Subject: [PATCH 8/9] That whitespace test is still inconsistent between
 versions of ghc

---
 plugins/hls-tactics-plugin/test/CodeAction/AutoSpec.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/plugins/hls-tactics-plugin/test/CodeAction/AutoSpec.hs b/plugins/hls-tactics-plugin/test/CodeAction/AutoSpec.hs
index 2a04166fa9..0c81255756 100644
--- a/plugins/hls-tactics-plugin/test/CodeAction/AutoSpec.hs
+++ b/plugins/hls-tactics-plugin/test/CodeAction/AutoSpec.hs
@@ -16,6 +16,7 @@ import Wingman.FeatureSet (allFeatures)
 spec :: Spec
 spec = do
   let autoTest = goldenTest Auto ""
+      autoTestNoWhitespace = goldenTestNoWhitespace Auto ""
 
   describe "golden" $ do
     autoTest 11  8 "AutoSplitGADT.hs"
@@ -72,7 +73,8 @@ spec = do
 
   describe "known" $ do
     autoTest 25 13 "GoldenArbitrary.hs"
-    autoTest  6 10 "KnownBigSemigroup.hs"
+    autoTestNoWhitespace
+              6 10 "KnownBigSemigroup.hs"
     autoTest  4 10 "KnownThetaSemigroup.hs"
     autoTest  6 10 "KnownCounterfactualSemigroup.hs"
     autoTest 10 10 "KnownModuleInstanceSemigroup.hs"

From 69f3759688723991a3c882d8803537c871829757 Mon Sep 17 00:00:00 2001
From: Sandy Maguire <sandy@sandymaguire.me>
Date: Mon, 19 Apr 2021 16:02:43 -0700
Subject: [PATCH 9/9] Fix test

---
 .../test/golden/KnownBigSemigroup.hs.expected                | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/plugins/hls-tactics-plugin/test/golden/KnownBigSemigroup.hs.expected b/plugins/hls-tactics-plugin/test/golden/KnownBigSemigroup.hs.expected
index 89cfe57479..7b090d52e4 100644
--- a/plugins/hls-tactics-plugin/test/golden/KnownBigSemigroup.hs.expected
+++ b/plugins/hls-tactics-plugin/test/golden/KnownBigSemigroup.hs.expected
@@ -3,6 +3,7 @@ import Data.Monoid
 data Big a = Big [Bool] (Sum Int) String (Endo a) Any
 
 instance Semigroup (Big a) where
-  (<>) (Big bs sum s en any) (Big bs' sum' s' en' any')
-    = Big (bs <> bs') (sum <> sum') (s <> s') (en <> en') (any <> any')
+  (<>) (Big bs sum s en any) (Big bs' sum' str en' any')
+    = Big
+        (bs <> bs') (sum <> sum') (s <> str) (en <> en') (any <> any')