diff --git a/ghcide/src/Development/IDE/GHC/ExactPrint.hs b/ghcide/src/Development/IDE/GHC/ExactPrint.hs index b0636174a1..fe34a3b28c 100644 --- a/ghcide/src/Development/IDE/GHC/ExactPrint.hs +++ b/ghcide/src/Development/IDE/GHC/ExactPrint.hs @@ -8,6 +8,7 @@ module Development.IDE.GHC.ExactPrint ( Graft(..), graft, + graftWithoutParentheses, graftDecls, graftDeclsWithM, annotate, @@ -179,8 +180,18 @@ graft :: SrcSpan -> Located ast -> Graft (Either String) a -graft dst val = Graft $ \dflags a -> do - (anns, val') <- annotate dflags $ maybeParensAST val +graft dst = graftWithoutParentheses dst . maybeParensAST + +-- | Like 'graft', but trusts that you have correctly inserted the parentheses +-- yourself. If you haven't, the resulting AST will not be valid! +graftWithoutParentheses :: + forall ast a. + (Data a, ASTElement ast) => + SrcSpan -> + Located ast -> + Graft (Either String) a +graftWithoutParentheses dst val = Graft $ \dflags a -> do + (anns, val') <- annotate dflags val modifyAnnsT $ mappend anns pure $ everywhere' diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic.hs index a261080aab..d2f61d0829 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic.hs +++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic.hs @@ -21,6 +21,7 @@ import Control.Monad.Error.Class (MonadError(throwError)) import Control.Monad.Trans import Control.Monad.Trans.Maybe import Data.Aeson +import Data.Bool (bool) import Data.Coerce import Data.Functor ((<&>)) import Data.Generics.Aliases (mkQ) @@ -39,7 +40,8 @@ import Development.IDE.Core.Service (runAction) import Development.IDE.Core.Shake (useWithStale, IdeState (..)) import Development.IDE.GHC.Compat import Development.IDE.GHC.Error (realSrcSpanToRange) -import Development.IDE.GHC.ExactPrint (graft, transform, useAnnotatedSource) +import Development.IDE.GHC.ExactPrint (graft, transform, useAnnotatedSource, maybeParensAST) +import Development.IDE.GHC.ExactPrint (graftWithoutParentheses) import Development.IDE.Spans.LocalBindings (getDefiningBindings) import Development.Shake (Action) import DynFlags (xopt) @@ -327,8 +329,11 @@ 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 + traceMX "simplified" $ rtr_extract rtr + let g = graftWithoutParentheses (RealSrcSpan span) + -- Parenthesize the extract iff we're not in a top level hole + $ bool maybeParensAST id (_jIsTopHole jdg) + $ rtr_extract rtr response = transform dflags (clientCapabilities lf) uri g pm pure $ case response of Right res -> (Right Null , Just (WorkspaceApplyEdit, ApplyWorkspaceEditParams res)) diff --git a/test/testdata/tactic/Fgmap.hs.expected b/test/testdata/tactic/Fgmap.hs.expected index 8c0b9a2f4a..4f4921fa05 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 = (fmap . fmap) +fgmap = fmap . fmap diff --git a/test/testdata/tactic/FmapBoth.hs.expected b/test/testdata/tactic/FmapBoth.hs.expected index a513b35a42..3160676e8f 100644 --- a/test/testdata/tactic/FmapBoth.hs.expected +++ b/test/testdata/tactic/FmapBoth.hs.expected @@ -1,4 +1,4 @@ fmapBoth :: (Functor f, Functor g) => (a -> b) -> (f a, g a) -> (f b, g b) -fmapBoth = (\ fab p_faga - -> case p_faga of { (fa, ga) -> (fmap fab fa, fmap fab ga) }) +fmapBoth = \ fab p_faga + -> case p_faga of { (fa, ga) -> (fmap fab fa, fmap fab ga) } diff --git a/test/testdata/tactic/GoldenArbitrary.hs.expected b/test/testdata/tactic/GoldenArbitrary.hs.expected index a3f677d1a1..1d533bef3f 100644 --- a/test/testdata/tactic/GoldenArbitrary.hs.expected +++ b/test/testdata/tactic/GoldenArbitrary.hs.expected @@ -22,31 +22,31 @@ data Obj arbitrary :: Gen Obj -arbitrary = (let - terminal - = [(Square <$> arbitrary) <*> arbitrary, Circle <$> arbitrary, - Polygon <$> arbitrary, pure Empty, pure Full] - in - sized - $ (\ n - -> case n <= 1 of - True -> oneof terminal - False - -> oneof - $ ([(Rotate2 <$> arbitrary) <*> scale (subtract 1) arbitrary, - Complement <$> scale (subtract 1) arbitrary, - (UnionR <$> arbitrary) <*> scale (subtract 1) arbitrary, - ((DifferenceR <$> arbitrary) <*> scale (flip div 2) arbitrary) - <*> scale (flip div 2) arbitrary, - (IntersectR <$> arbitrary) <*> scale (subtract 1) arbitrary, - ((Translate <$> arbitrary) <*> arbitrary) - <*> scale (subtract 1) arbitrary, - ((Scale <$> arbitrary) <*> arbitrary) - <*> scale (subtract 1) arbitrary, - ((Mirror <$> arbitrary) <*> arbitrary) - <*> scale (subtract 1) arbitrary, - (Outset <$> arbitrary) <*> scale (subtract 1) arbitrary, - (Shell <$> arbitrary) <*> scale (subtract 1) arbitrary, - (WithRounding <$> arbitrary) <*> scale (subtract 1) arbitrary] - <> terminal))) +arbitrary = let + terminal + = [(Square <$> arbitrary) <*> arbitrary, Circle <$> arbitrary, + Polygon <$> arbitrary, pure Empty, pure Full] + in + sized + $ (\ n + -> case n <= 1 of + True -> oneof terminal + False + -> oneof + $ ([(Rotate2 <$> arbitrary) <*> scale (subtract 1) arbitrary, + Complement <$> scale (subtract 1) arbitrary, + (UnionR <$> arbitrary) <*> scale (subtract 1) arbitrary, + ((DifferenceR <$> arbitrary) <*> scale (flip div 2) arbitrary) + <*> scale (flip div 2) arbitrary, + (IntersectR <$> arbitrary) <*> scale (subtract 1) arbitrary, + ((Translate <$> arbitrary) <*> arbitrary) + <*> scale (subtract 1) arbitrary, + ((Scale <$> arbitrary) <*> arbitrary) + <*> scale (subtract 1) arbitrary, + ((Mirror <$> arbitrary) <*> arbitrary) + <*> scale (subtract 1) arbitrary, + (Outset <$> arbitrary) <*> scale (subtract 1) arbitrary, + (Shell <$> arbitrary) <*> scale (subtract 1) arbitrary, + (WithRounding <$> arbitrary) <*> scale (subtract 1) arbitrary] + <> terminal)) diff --git a/test/testdata/tactic/GoldenBigTuple.hs.expected b/test/testdata/tactic/GoldenBigTuple.hs.expected index 36a7141036..c750f48356 100644 --- a/test/testdata/tactic/GoldenBigTuple.hs.expected +++ b/test/testdata/tactic/GoldenBigTuple.hs.expected @@ -1,4 +1,4 @@ -- There used to be a bug where we were unable to perform a nested split. The -- more serious regression test of this is 'AutoTupleSpec'. bigTuple :: (a, b, c, d) -> (a, b, (c, d)) -bigTuple = (\ pabcd -> case pabcd of { (a, b, c, d) -> (a, b, (c, d)) }) +bigTuple = \ pabcd -> case pabcd of { (a, b, c, d) -> (a, b, (c, d)) } diff --git a/test/testdata/tactic/GoldenEitherAuto.hs.expected b/test/testdata/tactic/GoldenEitherAuto.hs.expected index 10d633470c..833c250f0b 100644 --- a/test/testdata/tactic/GoldenEitherAuto.hs.expected +++ b/test/testdata/tactic/GoldenEitherAuto.hs.expected @@ -1,5 +1,5 @@ either' :: (a -> c) -> (b -> c) -> Either a b -> c -either' = (\ fac fbc eab - -> case eab of - (Left a) -> fac a - (Right b) -> fbc b) +either' = \ fac fbc eab + -> case eab of + (Left a) -> fac a + (Right b) -> fbc b diff --git a/test/testdata/tactic/GoldenEitherHomomorphic.hs.expected b/test/testdata/tactic/GoldenEitherHomomorphic.hs.expected index 8276908d71..af8e10f357 100644 --- a/test/testdata/tactic/GoldenEitherHomomorphic.hs.expected +++ b/test/testdata/tactic/GoldenEitherHomomorphic.hs.expected @@ -1,5 +1,5 @@ eitherSplit :: a -> Either (a -> b) (a -> c) -> Either b c -eitherSplit = (\ a efabfac - -> case efabfac of - (Left fab) -> Left (fab a) - (Right fac) -> Right (fac a)) +eitherSplit = \ a efabfac + -> case efabfac of + (Left fab) -> Left (fab a) + (Right fac) -> Right (fac a) diff --git a/test/testdata/tactic/GoldenFmapTree.hs.expected b/test/testdata/tactic/GoldenFmapTree.hs.expected index 4e8b97d735..ed608dcbbd 100644 --- a/test/testdata/tactic/GoldenFmapTree.hs.expected +++ b/test/testdata/tactic/GoldenFmapTree.hs.expected @@ -1,7 +1,7 @@ data Tree a = Leaf a | Branch (Tree a) (Tree a) instance Functor Tree where - fmap = (\ fab ta - -> case ta of - (Leaf a) -> Leaf (fab a) - (Branch ta2 ta3) -> Branch (fmap fab ta2) (fmap fab ta3)) + fmap = \ fab ta + -> case ta of + (Leaf a) -> Leaf (fab a) + (Branch ta2 ta3) -> Branch (fmap fab ta2) (fmap fab ta3) diff --git a/test/testdata/tactic/GoldenFoldr.hs.expected b/test/testdata/tactic/GoldenFoldr.hs.expected index 9fde1acaeb..e043416a4d 100644 --- a/test/testdata/tactic/GoldenFoldr.hs.expected +++ b/test/testdata/tactic/GoldenFoldr.hs.expected @@ -1,5 +1,5 @@ foldr2 :: (a -> b -> b) -> b -> [a] -> b -foldr2 = (\ f_b b l_a - -> case l_a of - [] -> b - (a : l_a4) -> f_b a (foldr2 f_b b l_a4)) +foldr2 = \ f_b b l_a + -> case l_a of + [] -> b + (a : l_a4) -> f_b a (foldr2 f_b b l_a4) diff --git a/test/testdata/tactic/GoldenFromMaybe.hs.expected b/test/testdata/tactic/GoldenFromMaybe.hs.expected index 1375967a70..7d08d130e5 100644 --- a/test/testdata/tactic/GoldenFromMaybe.hs.expected +++ b/test/testdata/tactic/GoldenFromMaybe.hs.expected @@ -1,5 +1,5 @@ fromMaybe :: a -> Maybe a -> a -fromMaybe = (\ a ma - -> case ma of - Nothing -> a - (Just a2) -> a2) +fromMaybe = \ a ma + -> case ma of + Nothing -> a + (Just a2) -> a2 diff --git a/test/testdata/tactic/GoldenGADTAuto.hs.expected b/test/testdata/tactic/GoldenGADTAuto.hs.expected index 2159d09f3b..88f33dd2da 100644 --- a/test/testdata/tactic/GoldenGADTAuto.hs.expected +++ b/test/testdata/tactic/GoldenGADTAuto.hs.expected @@ -4,4 +4,4 @@ data CtxGADT a where MkCtxGADT :: (Show a, Eq a) => a -> CtxGADT a ctxGADT :: CtxGADT () -ctxGADT = (MkCtxGADT ()) +ctxGADT = MkCtxGADT () diff --git a/test/testdata/tactic/GoldenGADTDestruct.hs.expected b/test/testdata/tactic/GoldenGADTDestruct.hs.expected index 2243aafdf6..fe8d1a8bd8 100644 --- a/test/testdata/tactic/GoldenGADTDestruct.hs.expected +++ b/test/testdata/tactic/GoldenGADTDestruct.hs.expected @@ -4,4 +4,4 @@ data CtxGADT where MkCtxGADT :: (Show a, Eq a) => a -> CtxGADT ctxGADT :: CtxGADT -> String -ctxGADT gadt = (case gadt of { (MkCtxGADT a) -> _ }) +ctxGADT gadt = case gadt of { (MkCtxGADT a) -> _ } diff --git a/test/testdata/tactic/GoldenGADTDestructCoercion.hs.expected b/test/testdata/tactic/GoldenGADTDestructCoercion.hs.expected index dca8ee9260..e3a3e4ed80 100644 --- a/test/testdata/tactic/GoldenGADTDestructCoercion.hs.expected +++ b/test/testdata/tactic/GoldenGADTDestructCoercion.hs.expected @@ -5,4 +5,4 @@ data E a b where E :: forall a b. (b ~ a, Ord a) => b -> E a [a] ctxGADT :: E a b -> String -ctxGADT gadt = (case gadt of { (E b) -> _ }) +ctxGADT gadt = case gadt of { (E b) -> _ } diff --git a/test/testdata/tactic/GoldenIdentityFunctor.hs.expected b/test/testdata/tactic/GoldenIdentityFunctor.hs.expected index fa0a8b629b..91d1e22d3d 100644 --- a/test/testdata/tactic/GoldenIdentityFunctor.hs.expected +++ b/test/testdata/tactic/GoldenIdentityFunctor.hs.expected @@ -1,3 +1,3 @@ data Ident a = Ident a instance Functor Ident where - fmap = (\ fab ia -> case ia of { (Ident a) -> Ident (fab a) }) + fmap = \ fab ia -> case ia of { (Ident a) -> Ident (fab a) } diff --git a/test/testdata/tactic/GoldenIntros.hs.expected b/test/testdata/tactic/GoldenIntros.hs.expected index 26d8599e4e..8da62d6b9b 100644 --- a/test/testdata/tactic/GoldenIntros.hs.expected +++ b/test/testdata/tactic/GoldenIntros.hs.expected @@ -1,2 +1,2 @@ blah :: Int -> Bool -> (a -> b) -> String -> Int -blah = (\ i b fab l_c -> _) +blah = \ i b fab l_c -> _ diff --git a/test/testdata/tactic/GoldenJoinCont.hs.expected b/test/testdata/tactic/GoldenJoinCont.hs.expected index ebf84d1371..7397859c4d 100644 --- a/test/testdata/tactic/GoldenJoinCont.hs.expected +++ b/test/testdata/tactic/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_r far -> f_r (\ f_r2 -> f_r2 far) diff --git a/test/testdata/tactic/GoldenListFmap.hs.expected b/test/testdata/tactic/GoldenListFmap.hs.expected index 6d183a9578..7ff6fabfce 100644 --- a/test/testdata/tactic/GoldenListFmap.hs.expected +++ b/test/testdata/tactic/GoldenListFmap.hs.expected @@ -1,5 +1,5 @@ fmapList :: (a -> b) -> [a] -> [b] -fmapList = (\ fab l_a - -> case l_a of - [] -> [] - (a : l_a3) -> fab a : fmapList fab l_a3) +fmapList = \ fab l_a + -> case l_a of + [] -> [] + (a : l_a3) -> fab a : fmapList fab l_a3 diff --git a/test/testdata/tactic/GoldenNote.hs.expected b/test/testdata/tactic/GoldenNote.hs.expected index 47a9bd6d92..420ce242a0 100644 --- a/test/testdata/tactic/GoldenNote.hs.expected +++ b/test/testdata/tactic/GoldenNote.hs.expected @@ -1,5 +1,5 @@ note :: e -> Maybe a -> Either e a -note = (\ e ma - -> case ma of - Nothing -> Left e - (Just a) -> Right a) +note = \ e ma + -> case ma of + Nothing -> Left e + (Just a) -> Right a diff --git a/test/testdata/tactic/GoldenPureList.hs.expected b/test/testdata/tactic/GoldenPureList.hs.expected index c02e91622d..fc5bcdc2a3 100644 --- a/test/testdata/tactic/GoldenPureList.hs.expected +++ b/test/testdata/tactic/GoldenPureList.hs.expected @@ -1,2 +1,2 @@ pureList :: a -> [a] -pureList = (\ a -> a : []) +pureList = \ a -> a : [] diff --git a/test/testdata/tactic/GoldenSafeHead.hs.expected b/test/testdata/tactic/GoldenSafeHead.hs.expected index 7a404f1d4e..194b8922c0 100644 --- a/test/testdata/tactic/GoldenSafeHead.hs.expected +++ b/test/testdata/tactic/GoldenSafeHead.hs.expected @@ -1,5 +1,5 @@ safeHead :: [x] -> Maybe x -safeHead = (\ l_x - -> case l_x of - [] -> Nothing - (x : l_x2) -> Just x) +safeHead = \ l_x + -> case l_x of + [] -> Nothing + (x : l_x2) -> Just x diff --git a/test/testdata/tactic/GoldenShowCompose.hs.expected b/test/testdata/tactic/GoldenShowCompose.hs.expected index e672cc6a02..8152b5a0ae 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 -> show . fba) +showCompose = \ fba -> show . fba diff --git a/test/testdata/tactic/GoldenShowMapChar.hs.expected b/test/testdata/tactic/GoldenShowMapChar.hs.expected index 8750e4e1f4..d4cb942825 100644 --- a/test/testdata/tactic/GoldenShowMapChar.hs.expected +++ b/test/testdata/tactic/GoldenShowMapChar.hs.expected @@ -1,2 +1,2 @@ test :: Show a => a -> (String -> b) -> b -test = (\ a fl_cb -> fl_cb (show a)) +test = \ a fl_cb -> fl_cb (show a) diff --git a/test/testdata/tactic/GoldenSwap.hs.expected b/test/testdata/tactic/GoldenSwap.hs.expected index 57a3a114f4..2560c15acb 100644 --- a/test/testdata/tactic/GoldenSwap.hs.expected +++ b/test/testdata/tactic/GoldenSwap.hs.expected @@ -1,2 +1,2 @@ swap :: (a, b) -> (b, a) -swap = (\ p_ab -> case p_ab of { (a, b) -> (b, a) }) +swap = \ p_ab -> case p_ab of { (a, b) -> (b, a) } diff --git a/test/testdata/tactic/GoldenSwapMany.hs.expected b/test/testdata/tactic/GoldenSwapMany.hs.expected index a37687cc3c..aaffc2d873 100644 --- a/test/testdata/tactic/GoldenSwapMany.hs.expected +++ b/test/testdata/tactic/GoldenSwapMany.hs.expected @@ -1,2 +1,2 @@ swapMany :: (a, b, c, d, e) -> (e, d, c, b, a) -swapMany = (\ pabcde -> case pabcde of { (a, b, c, d, e) -> (e, d, c, b, a) }) +swapMany = \ pabcde -> case pabcde of { (a, b, c, d, e) -> (e, d, c, b, a) } diff --git a/test/testdata/tactic/RecordCon.hs.expected b/test/testdata/tactic/RecordCon.hs.expected index 33f74796f5..235efbdbfa 100644 --- a/test/testdata/tactic/RecordCon.hs.expected +++ b/test/testdata/tactic/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 = \ fai a -> Record {field1 = a, field2 = fai a}