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 <[email protected]>

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)