Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Wingman: Use infix notation for operator applications #1675

Merged
merged 10 commits into from
Apr 9, 2021
10 changes: 10 additions & 0 deletions plugins/hls-tactics-plugin/src/Wingman/CodeGen.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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

3 changes: 1 addition & 2 deletions plugins/hls-tactics-plugin/src/Wingman/Tactics.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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


------------------------------------------------------------------------------
Expand Down
3 changes: 3 additions & 0 deletions plugins/hls-tactics-plugin/test/CodeAction/AutoSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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"
Expand Down
3 changes: 3 additions & 0 deletions plugins/hls-tactics-plugin/test/golden/AutoInfixApply.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
test :: (a -> b -> c) -> a -> (a -> b) -> c
test (/:) a f = _

Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
test :: (a -> b -> c) -> a -> (a -> b) -> c
test (/:) a f = a /: f a

3 changes: 3 additions & 0 deletions plugins/hls-tactics-plugin/test/golden/AutoInfixApplyMany.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
test :: (a -> b -> x -> c) -> a -> (a -> b) -> x -> c
test (/:) a f x = _

Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
test :: (a -> b -> x -> c) -> a -> (a -> b) -> x -> c
test (/:) a f x = (a /: f a) x

isovector marked this conversation as resolved.
Show resolved Hide resolved
2 changes: 2 additions & 0 deletions plugins/hls-tactics-plugin/test/golden/AutoInfixInfix.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
test :: (a -> b -> c) -> (c -> d -> e) -> a -> (a -> b) -> d -> e
test (/:) (-->) a f x = _
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
test :: (a -> b -> c) -> (c -> d -> e) -> a -> (a -> b) -> d -> e
test (/:) (-->) a f x = (a /: f a) --> x
Original file line number Diff line number Diff line change
@@ -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)
Original file line number Diff line number Diff line change
@@ -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
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Original file line number Diff line number Diff line change
Expand Up @@ -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)

Original file line number Diff line number Diff line change
@@ -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)

Original file line number Diff line number Diff line change
@@ -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) _

Original file line number Diff line number Diff line change
Expand Up @@ -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)

Original file line number Diff line number Diff line change
@@ -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)