Wingman: Use infix notation for operator applications (#1675)

* Use infix notation for operator applications

* Update tests

* Add test suggest by Ailrun

* Use isSymOcc

Co-authored-by: Javier Neira <atreyu.bbb@gmail.com>

Author: isovector

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

@@ -26,6 +26,7 @@ import           GHC.SourceGen.Binds
 import           GHC.SourceGen.Expr
 import           GHC.SourceGen.Overloaded
 import           GHC.SourceGen.Pat
+import           GhcPlugins (isSymOcc)
 import           PatSyn
 import           Type hiding (Var)
 import           Wingman.CodeGen.Utils
@@ -203,3 +204,12 @@ buildDataCon should_blacklist jdg dc tyapps = do
     & #syn_trace %~ rose (show dc) . pure
     & #syn_val   %~ mkCon dc tyapps
 
+
+------------------------------------------------------------------------------
+-- | Make a function application, correctly handling the infix case.
+mkApply :: OccName -> [HsExpr GhcPs] -> LHsExpr GhcPs
+mkApply occ (lhs : rhs : more)
+  | isSymOcc occ
+  = noLoc $ foldl' (@@) (op lhs (coerceName occ) rhs) more
+mkApply occ args = noLoc $ foldl' (@@) (var' occ) args
+

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

@@ -22,7 +22,6 @@ import           DataCon
 import           Development.IDE.GHC.Compat
 import           GHC.Exts
 import           GHC.SourceGen.Expr
-import           GHC.SourceGen.Overloaded
 import           Name (occNameString, occName)
 import           Refinery.Tactic
 import           Refinery.Tactic.Internal
@@ -204,7 +203,7 @@ apply hi = requireConcreteHole $ tracing ("apply' " <> show (hi_name hi)) $ do
     pure $
       ext
         & #syn_used_vals %~ S.insert func
-        & #syn_val       %~ noLoc . foldl' (@@) (var' func) . fmap unLoc
+        & #syn_val       %~ mkApply func . fmap unLoc
 
 
 ------------------------------------------------------------------------------

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

@@ -50,6 +50,9 @@ spec = do
     autoTest  2 16 "AutoEmptyString.hs"
     autoTest  7 35 "AutoPatSynUse.hs"
     autoTest  2 28 "AutoZip.hs"
+    autoTest  2 17 "AutoInfixApply.hs"
+    autoTest  2 19 "AutoInfixApplyMany.hs"
+    autoTest  2 25 "AutoInfixInfix.hs"
 
     failing "flaky in CI" $
       autoTest 2 11 "GoldenApplicativeThen.hs"

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

@@ -0,0 +1,3 @@
+test :: (a -> b -> c) -> a -> (a -> b) -> c
+test (/:) a f = _
+

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

@@ -0,0 +1,3 @@
+test :: (a -> b -> c) -> a -> (a -> b) -> c
+test (/:) a f = a /: f a
+

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

@@ -0,0 +1,3 @@
+test :: (a -> b -> x -> c) -> a -> (a -> b) -> x -> c
+test (/:) a f x = _
+

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

@@ -0,0 +1,3 @@
+test :: (a -> b -> x -> c) -> a -> (a -> b) -> x -> c
+test (/:) a f x = (a /: f a) x
+

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

@@ -0,0 +1,2 @@
+test :: (a -> b -> c) -> (c -> d -> e) -> a -> (a -> b) -> d -> e
+test (/:) (-->) a f x = _

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

@@ -0,0 +1,2 @@
+test :: (a -> b -> c) -> (c -> d -> e) -> a -> (a -> b) -> d -> e
+test (/:) (-->) a f x = (a /: f a) --> x

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 (\ mma -> mma >>= id)

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 = ( (\ mma -> mma >>= id) :: m (m a) -> m a) in fmap f

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

@@ -5,9 +5,5 @@ 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
-        ((<>) l_b7 l_b)
-        ((<>) si8 si)
-        ((<>) l_c9 l_c)
-        ((<>) ea10 ea)
-        ((<>) a11 a)
+        (l_b7 <> l_b) (si8 <> si) (l_c9 <> l_c) (ea10 <> ea) (a11 <> a)
 

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

@@ -4,5 +4,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 (l_l_c5 <> l_l_c) (i6 <> i)
 

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

@@ -1,5 +1,5 @@
 data Test a = Test [a]
 
 instance Semigroup (Test a) where
-  (<>) (Test a) (Test c) = Test ((<>) a c)
+  (<>) (Test a) (Test c) = Test (a <> c)
 

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 l_l_c4 i5) (Semi l_l_c i) = Semi (l_l_c4 <> l_l_c) _
 

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

@@ -7,5 +7,5 @@ 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 f4 f5) (Bar f f3) = Bar (f4 <> f) (f5 <> f3)
 

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 a4) (Semi a) = Semi (a4 <> a)