From 7e06c77569026a6b0fd94dbefd0c8580a47ef94c Mon Sep 17 00:00:00 2001 From: Santiago Weight Date: Sun, 11 Sep 2022 19:27:07 +0200 Subject: [PATCH 1/6] support add to where --- .../src/Development/IDE/GHC/ExactPrint.hs | 93 ++++++++ .../src/Development/IDE/Plugin/CodeAction.hs | 99 ++++++-- plugins/hls-refactor-plugin/test/Main.hs | 212 +++++++++++++++++- 3 files changed, 378 insertions(+), 26 deletions(-) diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs index 67c1f89f32..2cc7f68084 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs @@ -47,6 +47,8 @@ module Development.IDE.GHC.ExactPrint ExceptStringT (..), TransformT, Log(..), + prependDecl, + prependDeclToWhereDecls, ) where @@ -109,6 +111,13 @@ import GHC.Parser.Annotation (AnnContext (..), DeltaPos (SameLine), EpaLocation (EpaDelta), deltaPos) +import GHC (DeltaPos(..)) +import GHC.Types.SrcLoc (generatedSrcSpan) +import GHC (Anchor(..)) +import GHC (AnchorOperation(..)) +import GHC (realSrcSpan) +import GHC (EpAnnComments(..)) +import Debug.Trace (traceShowM, trace, traceM) #endif #if MIN_VERSION_ghc(9,2,0) @@ -475,6 +484,90 @@ modifyMgMatchesT :: modifyMgMatchesT (MG xMg (L locMatches matches) originMg) f = do matches' <- mapM f matches pure $ MG xMg (L locMatches matches') originMg + +insertAtStart' :: (Monad m, HasDecls ast) => ast -> HsDecl GhcPs -> TransformT m ast +insertAtStart' old newDecl = do + srcs <- replicateM 5 uniqueSrcSpanT + liftT $ insertAt (insertDeclAtStart srcs) old . noLocA $ newDecl + where + insertDeclAtStart ssps (L _ newDecl) [] = [L (noAnnSrcSpanDP (ssps !! 0) (DifferentLine 1 4)) newDecl] + insertDeclAtStart _ (L _ newDecl) [L (SrcSpanAnn (EpAnn (Anchor dRealSpan (MovedAnchor (SameLine _))) dAnn dComments) dSpan) d] = + [ L (noAnnSrcSpanDP generatedSrcSpan (DifferentLine 1 2)) newDecl, + L (SrcSpanAnn (EpAnn (Anchor dRealSpan (MovedAnchor $ DifferentLine 1 0)) dAnn dComments) dSpan) d + ] + insertDeclAtStart ssps (L _ newDecl) (L (SrcSpanAnn (EpAnn (Anchor dRealSpan ancOp) dAnn dComments) dSpan) d:ds) = + let newDeclSpan = ssps !! 0 + newDecl' = L + (SrcSpanAnn + (EpAnn (Anchor dRealSpan ancOp) mempty emptyComments) + newDeclSpan) + newDecl + secondDecl' = L + (SrcSpanAnn + (EpAnn + (Anchor (realSrcSpan $ newDeclSpan) (MovedAnchor $ DifferentLine 1 0)) + dAnn + dComments) + dSpan) + d + in newDecl' : secondDecl' : ds + insertDeclAtStart _ d ds = d : ds + +prependDeclToWhereDecls decl newWhereDecl = do + traceShowM "tag2" + ds <- balanceCommentsList =<< hsDecls decl + traceShowM "tag3" + let ds' = prependDecl (wrapDecl newWhereDecl) ds + traceShowM "tag4" + replaceDecls decl ds' + +prependDecl :: LHsDecl GhcPs -> [LHsDecl GhcPs] -> [LHsDecl GhcPs] +prependDecl ldecl = \case + [] -> [setEntryDP ldecl (DifferentLine 1 2)] + ld1:lds -> ldecl':ld1'':lds + where + (ancOp, ld1'') = case ld1 of + L (SrcSpanAnn (EpAnn d1Anc d1Ann (EpaComments (L (Anchor c1Rss cAnc) c1:restCs))) ss) d1 -> + -- NOTE cannot use setEntryDP to simply assign `DL 1 0` here because when there is no prior decl, the + -- DeltaPos on the declaration is absolute instead of relative, and so we must manually update the + -- DeltaPos to be relative (since there is about to be a prior declaration). + let ld1' = L + (SrcSpanAnn + (EpAnn + (setAnchorDp d1Anc $ DifferentLine 1 0) + d1Ann + (EpaCommentsBalanced (L (Anchor c1Rss $ MovedAnchor $ DifferentLine 1 0) c1:restCs) [])) + ss) + d1 + in (cAnc, ld1') + (L (SrcSpanAnn (EpAnn d1Anc d1Ann (EpaCommentsBalanced (L (Anchor c1Rss cAnc) c1:restCs) d1AfterCs)) ss) d1) -> + -- NOTE cannot use setEntryDP to simply assign `DL 1 0` here because when there is no prior decl, the + -- DeltaPos on the declaration is absolute instead of relative, and so we must manually update the + -- DeltaPos to be relative (since there is about to be a prior declaration). + let ld1' = L + (SrcSpanAnn + (EpAnn + (setAnchorDp d1Anc $ DifferentLine 1 0) + d1Ann + (EpaCommentsBalanced (L (Anchor c1Rss $ MovedAnchor $ DifferentLine 1 0) c1:restCs) d1AfterCs)) + ss) + d1 + in (cAnc, ld1') + (L (SrcSpanAnn (EpAnn (Anchor d1Rss d1AncOp) d1Ann epaCs@(EpaComments [])) ss) d1) -> + let ld1' = L (SrcSpanAnn (EpAnn (Anchor d1Rss $ MovedAnchor $ DifferentLine 1 0) d1Ann epaCs) ss) d1 + in (d1AncOp, ld1') + (L (SrcSpanAnn (EpAnn (Anchor d1Rss d1AncOp) d1Ann epaCs@(EpaCommentsBalanced [] _)) ss) d1) -> + let ld1' = L (SrcSpanAnn (EpAnn (Anchor d1Rss $ MovedAnchor $ DifferentLine 1 0) d1Ann epaCs) ss) d1 + in (d1AncOp, ld1') + L (SrcSpanAnn EpAnnNotUsed _) _ -> trace "tag6" error "Unexpected EpAnnNotUsed" + ldecl' = setEntryDP ldecl (maybe (trace "tag7" error "what to do with UnchangedAnchor?") id $ getAnchorOpDp ancOp) + +setAnchorDp :: Anchor -> DeltaPos -> Anchor +setAnchorDp (Anchor rss _) dp = Anchor rss (MovedAnchor dp) + +getAnchorOpDp :: AnchorOperation -> Maybe DeltaPos +getAnchorOpDp (MovedAnchor dp) = Just dp +getAnchorOpDp UnchangedAnchor = Nothing #endif graftSmallestDeclsWithM :: diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs index 442ffcb253..e6c6dc8e45 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -1,6 +1,6 @@ -- Copyright (c) 2019 The DAML Authors. All rights reserved. -- SPDX-License-Identifier: Apache-2.0 -{-# LANGUAGE GADTs #-} +{-# LANGUAGE GADTs #-} module Development.IDE.Plugin.CodeAction ( @@ -92,14 +92,17 @@ import qualified Text.Fuzzy.Parallel as TFP import Text.Regex.TDFA (mrAfter, (=~), (=~~)) #if MIN_VERSION_ghc(9,2,1) +import GHC (realSrcSpan) +import GHC.Parser.Annotation (emptyComments) import GHC.Types.SrcLoc (generatedSrcSpan) -import Language.Haskell.GHC.ExactPrint (noAnnSrcSpanDP1, - runTransformT) +import Language.Haskell.GHC.ExactPrint.Transform #endif #if MIN_VERSION_ghc(9,2,0) +import Control.Monad.Except (lift) +import Control.Monad.Identity (Identity (..)) import Extra (maybeToEither) import GHC (AddEpAnn (AddEpAnn), - Anchor (anchor_op), + Anchor (..), AnchorOperation (..), AnnsModule (am_main), DeltaPos (..), @@ -107,6 +110,9 @@ import GHC (AddEpAnn (Ad EpaLocation (..), LEpaComment, LocatedA) +import Debug.Trace +import Control.Lens (bimap) + #else import Language.Haskell.GHC.ExactPrint.Types (Annotation (annsDP), DeltaPos, @@ -177,7 +183,8 @@ bindingsPluginDescriptor recorder plId = mkExactprintPluginDescriptor recorder $ #endif , wrap suggestNewDefinition #if MIN_VERSION_ghc(9,2,1) - , wrap suggestAddArgument + , wrap (undefinedVariableCodeAction addAsLastArgument) + , wrap (undefinedVariableCodeAction addToWhere) #endif , wrap suggestDeleteUnusedBinding ] @@ -950,12 +957,30 @@ newDefinitionAction IdeOptions {..} parsedModule Range {_start} name typ ParsedModule {pm_parsed_source = L _ HsModule {hsmodDecls}} = parsedModule #if MIN_VERSION_ghc(9,2,1) + +type UndefinedVariableCodeAction = ParsedModule -> Diagnostic -> Either ResponseError [(T.Text, [TextEdit])] + +type UndefinedVariableHandler = ParsedModule -> Range -> T.Text -> Maybe T.Text -> Either ResponseError [(T.Text, [TextEdit])] + -- When GHC tells us that a variable is not bound, it will tell us either: -- - there is an unbound variable with a given type -- - there is an unbound variable (GHC provides no type suggestion) +-- - there is a typed hole `_` -- --- When we receive either of these errors, we produce a text edit that will add a new argument (as a new pattern in the --- last position of each LHS of the top-level bindings for this HsDecl). +-- When we receive either of these errors, we can produce a text edit that will put this variable in scope, such as: +-- - Adding an argument binding +-- - Adding a binding in a where clause +-- - ... up to your creativity :) +undefinedVariableCodeAction :: UndefinedVariableHandler -> UndefinedVariableCodeAction +undefinedVariableCodeAction handler parsedModule Diagnostic {_message, _range} + | Just (name, typ) <- matchVariableNotInScope message = handler parsedModule _range name typ + | Just (name, typ) <- matchFoundHoleIncludeUnderscore message = handler parsedModule _range name (Just typ) + | otherwise = pure [] + where + message = unifySpaces _message + +-- Handle unbound variables by adding a new argument as a new pattern in the last position of each LHS of the +-- top-level bindings for this HsDecl. -- -- TODO Include logic to also update the type signature of a binding -- @@ -964,17 +989,8 @@ newDefinitionAction IdeOptions {..} parsedModule Range {_start} name typ -- foo :: a -> b -> c -> d -- foo a b = \c -> ... -- In this case a new argument would have to add its type between b and c in the signature. -suggestAddArgument :: ParsedModule -> Diagnostic -> Either ResponseError [(T.Text, [TextEdit])] -suggestAddArgument parsedModule Diagnostic {_message, _range} - | Just (name, typ) <- matchVariableNotInScope message = addArgumentAction parsedModule _range name typ - | Just (name, typ) <- matchFoundHoleIncludeUnderscore message = addArgumentAction parsedModule _range name (Just typ) - | otherwise = pure [] - where - message = unifySpaces _message - --- TODO use typ to modify type signature -addArgumentAction :: ParsedModule -> Range -> T.Text -> Maybe T.Text -> Either ResponseError [(T.Text, [TextEdit])] -addArgumentAction (ParsedModule _ parsedSource _ _) range name _typ = +addAsLastArgument :: UndefinedVariableHandler +addAsLastArgument (ParsedModule _ parsedSource _ _) range name _typ = do let addArgToMatch (L locMatch (Match xMatch ctxMatch pats rhs)) = do let unqualName = mkRdrUnqual $ mkVarOcc $ T.unpack name @@ -986,17 +1002,56 @@ addArgumentAction (ParsedModule _ parsedSource _ _) range name _typ = let decl' = L locDecl (ValD xVal (FunBind xFunBind idFunBind mg' coreFunBind)) pure [decl'] decl -> pure [decl] - case runTransformT $ modifySmallestDeclWithM spanContainsRangeOrErr insertArg (makeDeltaAst parsedSource) of + case runTransformT $ modifySmallestDeclWithM (flip spanContainsRangeOrErr range) insertArg (makeDeltaAst parsedSource) of Left err -> Left err Right (newSource, _, _) -> let diff = makeDiffTextEdit (T.pack $ exactPrint parsedSource) (T.pack $ exactPrint newSource) in pure [("Add argument ‘" <> name <> "’ to function", fromLspList diff)] - where - spanContainsRangeOrErr = maybeToEither (responseError "SrcSpan was not valid range") . (`spanContainsRange` range) -#endif + +-- TODO use typ to initialise type signature +addToWhere :: ParsedModule -> Range -> T.Text -> Maybe T.Text -> Either ResponseError [(T.Text, [TextEdit])] +addToWhere (ParsedModule _ parsedSource _ _) range name _typ = bimap traceShowId id $ do + let mkUnqual name = noLocA $ mkRdrUnqual $ mkVarOcc $ T.unpack name + equalAnn dp = AddEpAnn AnnEqual (EpaDelta dp []) + addArg = modifySmallestDeclWithM (flip spanContainsRangeOrErr range) $ \case + (L locDecl (ValD xVal (FunBind xFunBind idFunBind mg coreFunBind))) -> do + declMatchSrcSpan <- uniqueSrcSpanT + grhsSrcSpan <- uniqueSrcSpanT + mg' <- modifyMgMatchesT mg $ \match -> do + spanInRange <- lift $ getLoc match `spanContainsRangeOrErr` range + if spanInRange + then do + let grhs_ann = GrhsAnn Nothing $ equalAnn (SameLine 0) + rhs_hole = L (noAnnSrcSpanDP1 generatedSrcSpan) $ HsVar NoExtField (mkUnqual "_") + grhs = GRHS (EpAnn (generatedAnchor m1) grhs_ann emptyComments) [] rhs_hole + grhss = GRHSs emptyComments [L grhsSrcSpan grhs] (EmptyLocalBinds NoExtField) + newDeclMatchAnn = emptyEpAnnAnchor (generatedAnchor m0) + newDeclMatch = + noLocA (Match newDeclMatchAnn (FunRhs (mkUnqual name) Prefix SrcStrict) [] grhss) + newDeclMg = MG NoExtField (L (noAnnSrcSpanDP0 declMatchSrcSpan) [newDeclMatch]) Generated + newDecl = (FunBind NoExtField (mkUnqual name) newDeclMg []) + traceShowM "tag1" + prependDeclToWhereDecls match (noLocA newDecl) + else pure match + let decl' = L locDecl (ValD xVal (FunBind xFunBind idFunBind mg' coreFunBind)) + pure [decl'] + _ -> pure [] + (newSource, _, _) <- runTransformT $ addArg (makeDeltaAst parsedSource) + let diffText = makeDiffTextEdit (T.pack $ exactPrint parsedSource) (T.pack $ exactPrint newSource) + pure [("Add to where ‘" <> name <> "’", fromLspList diffText)] + +spanContainsRangeOrErr :: SrcSpan -> Range -> Either ResponseError Bool +spanContainsRangeOrErr srcSpan range = maybeToEither (responseError "SrcSpan was not valid range") . (`spanContainsRange` range) $ srcSpan + +generatedAnchor :: AnchorOperation -> Anchor +generatedAnchor anchorOp = GHC.Anchor (GHC.realSrcSpan generatedSrcSpan) anchorOp + +emptyEpAnnAnchor :: Monoid a => Anchor -> EpAnn a +emptyEpAnnAnchor anchor = EpAnn anchor mempty emptyComments fromLspList :: List a -> [a] fromLspList (List a) = a +#endif suggestFillTypeWildcard :: Diagnostic -> [(T.Text, TextEdit)] suggestFillTypeWildcard Diagnostic{_range=_range,..} diff --git a/plugins/hls-refactor-plugin/test/Main.hs b/plugins/hls-refactor-plugin/test/Main.hs index 124f28acf1..54a3d629ed 100644 --- a/plugins/hls-refactor-plugin/test/Main.hs +++ b/plugins/hls-refactor-plugin/test/Main.hs @@ -3,9 +3,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE ImplicitParams #-} {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} @@ -312,7 +310,6 @@ codeActionTests = testGroup "code actions" , fillTypedHoleTests , addSigActionTests , insertNewDefinitionTests - , deleteUnusedDefinitionTests , addInstanceConstraintTests , addFunctionConstraintTests , removeRedundantConstraintsTests @@ -322,6 +319,7 @@ codeActionTests = testGroup "code actions" , removeExportTests #if MIN_VERSION_ghc(9,2,1) , addFunctionArgumentTests + , addToWhereTests #endif ] @@ -1511,7 +1509,10 @@ extendImportTests = testGroup "extend import actions" actionsOrCommands <- getCodeActions docB range let codeActions = filter - (liftA2 (&&) (T.isPrefixOf "Add") (not . T.isPrefixOf "Add argument") . codeActionTitle) + (liftA2 (&&) + (T.isPrefixOf "Add") + (\cmd -> not $ or $ fmap ($ cmd) [T.isPrefixOf "Add argument", T.isPrefixOf "Add to where"]) + . codeActionTitle) [ca | InR ca <- actionsOrCommands] actualTitles = codeActionTitle <$> codeActions -- Note that we are not testing the order of the actions, as the @@ -2376,6 +2377,209 @@ addFunctionArgumentTests = ] #endif +addToWhereTests :: TestTree +addToWhereTests = + testGroup + "add_to_where" + [ testSession "insert_new_where" $ do + let foo = + [ "module Foo where" + , "" + , "bar = 1" + , "" + , "foo True = _select [True]" + , "" + , "foo False = False" + ] + foo' = + [ "module Foo where" + , "" + , "bar = 1" + , "" + , "foo True = _select [True]" + , " where" + , " _select = _" + , "" + , "foo False = False" + ] + docB <- createDoc "ModuleB.hs" "haskell" (T.unlines foo) + _ <- waitForDiagnostics + InR action@CodeAction { _title = actionTitle } : _ + <- filter (\(InR CodeAction{_title=x}) -> "Add to " `isPrefixOf` T.unpack x ) <$> + getCodeActions docB (R 4 0 4 50) + liftIO $ actionTitle @?= "Add to where ‘_select’" + executeCodeAction action + contentAfterAction <- documentContents docB + liftIO $ contentAfterAction @?= T.unlines foo' + , testSession "simple" $ do + let foo = + [ "module Foo where" + , "" + , "bar = 1" + , "" + , "foo True = _select [True]" + , " where" + , " baz = 2" + , "foo False = False" + ] + foo' = + [ "module Foo where" + , "" + , "bar = 1" + , "" + , "foo True = _select [True]" + , " where" + , " _select = _" + , " baz = 2" + , "foo False = False" + ] + docB <- createDoc "ModuleB.hs" "haskell" (T.unlines foo) + _ <- waitForDiagnostics + InR action@CodeAction { _title = actionTitle } : _ + <- filter (\(InR CodeAction{_title=x}) -> "Add to " `isPrefixOf` T.unpack x ) <$> + getCodeActions docB (R 4 0 4 50) + liftIO $ actionTitle @?= "Add to where ‘_select’" + executeCodeAction action + contentAfterAction <- documentContents docB + liftIO $ contentAfterAction @?= T.unlines foo' + , testSession "simple" $ do + let foo = + [ "module Foo where" + , "" + , "bar = 1" + , "" + , "foo True = _select [True]" + , " where baz = 2" + , "foo False = False" + ] + foo' = + [ "module Foo where" + , "" + , "bar = 1" + , "" + , "foo True = _select [True]" + , " where _select = _" + , " baz = 2" + , "foo False = False" + ] + docB <- createDoc "ModuleB.hs" "haskell" (T.unlines foo) + _ <- waitForDiagnostics + InR action@CodeAction { _title = actionTitle } : _ + <- filter (\(InR CodeAction{_title=x}) -> "Add to " `isPrefixOf` T.unpack x ) <$> + getCodeActions docB (R 4 0 4 50) + liftIO $ actionTitle @?= "Add to where ‘_select’" + executeCodeAction action + contentAfterAction <- documentContents docB + liftIO $ contentAfterAction @?= T.unlines foo' + , testSession "simple" $ do + let foo = + [ "module Foo where" + , "" + , "bar = 1" + , "" + , "foo True = _select [True]" + , " where" + , "foo False = False" + ] + foo' = + [ "module Foo where" + , "" + , "bar = 1" + , "" + , "foo True = _select [True]" + , " where" + , " _select = _" + , "foo False = False" + ] + docB <- createDoc "ModuleB.hs" "haskell" (T.unlines foo) + _ <- waitForDiagnostics + InR action@CodeAction { _title = actionTitle } : _ + <- filter (\(InR CodeAction{_title=x}) -> "Add to " `isPrefixOf` T.unpack x ) <$> + getCodeActions docB (R 4 0 4 50) + liftIO $ actionTitle @?= "Add to where ‘_select’" + executeCodeAction action + contentAfterAction <- documentContents docB + liftIO $ contentAfterAction @?= T.unlines foo' + , testSession "empty where" $ do + let foo = + [ "module Foo where" + , "" + , "bar = 1" + , "" + , "foo True = _select [True]" + , " where" + , "foo False = False" + ] + foo' = + [ "module Foo where" + , "" + , "bar = 1" + , "" + , "foo True = _select [True]" + , " where" + , " _select = _" + , "foo False = False" + ] + docB <- createDoc "ModuleB.hs" "haskell" (T.unlines foo) + _ <- waitForDiagnostics + InR action@CodeAction { _title = actionTitle } : _ + <- filter (\(InR CodeAction{_title=x}) -> "Add to " `isPrefixOf` T.unpack x ) <$> + getCodeActions docB (R 4 0 4 50) + liftIO $ actionTitle @?= "Add to where ‘_select’" + executeCodeAction action + contentAfterAction <- documentContents docB + liftIO $ contentAfterAction @?= T.unlines foo' + , testSession "untyped error" $ do + let foo = + ["module Foo where" + ,"" + ,"foo = select" + ] + foo' = + ["module Foo where" + ,"" + ,"foo = select" + , " where" + , " select = _" + ] + docB <- createDoc "ModuleB.hs" "haskell" (T.unlines foo) + _ <- waitForDiagnostics + InR action@CodeAction { _title = actionTitle } : _ + <- filter (\(InR CodeAction{_title=x}) -> "Add to " `isPrefixOf` T.unpack x ) <$> + getCodeActions docB (R 2 0 2 50) + liftIO $ actionTitle @?= "Add to where ‘select’" + executeCodeAction action + contentAfterAction <- documentContents docB + liftIO $ contentAfterAction @?= T.unlines foo' + , testSession "untyped_error" $ do + let foo = + [ "module Foo where" + , "" + , "foo = new_def" + , " where" + , " -- hi" + , " baz = 2" + ] + foo' = + [ "module Foo where" + , "" + , "foo = new_def" + , " where" + , " new_def = _" + , " " + , " -- hibaz = 2" + ] + docB <- createDoc "ModuleB.hs" "haskell" (T.unlines foo) + _ <- waitForDiagnostics + InR action@CodeAction { _title = actionTitle } : _ + <- filter (\(InR CodeAction{_title=x}) -> "Add to " `isPrefixOf` T.unpack x ) <$> + getCodeActions docB (R 2 0 2 50) + liftIO $ actionTitle @?= "Add to where ‘new_def’" + executeCodeAction action + contentAfterAction <- documentContents docB + liftIO $ contentAfterAction @?= T.unlines foo' + ] + deleteUnusedDefinitionTests :: TestTree deleteUnusedDefinitionTests = testGroup "delete unused definition action" [ testSession "delete unused top level binding" $ From 96cc578708be8cec28e55d267849af3bdbf3d7d0 Mon Sep 17 00:00:00 2001 From: Santiago Weight Date: Sun, 6 Nov 2022 16:00:01 -0800 Subject: [PATCH 2/6] wip --- .../src/Development/IDE/GHC/ExactPrint.hs | 7 ++----- .../src/Development/IDE/Plugin/CodeAction.hs | 1 - plugins/hls-refactor-plugin/test/Main.hs | 4 ++-- 3 files changed, 4 insertions(+), 8 deletions(-) diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs index 2cc7f68084..afb83f48af 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs @@ -514,11 +514,8 @@ insertAtStart' old newDecl = do insertDeclAtStart _ d ds = d : ds prependDeclToWhereDecls decl newWhereDecl = do - traceShowM "tag2" ds <- balanceCommentsList =<< hsDecls decl - traceShowM "tag3" let ds' = prependDecl (wrapDecl newWhereDecl) ds - traceShowM "tag4" replaceDecls decl ds' prependDecl :: LHsDecl GhcPs -> [LHsDecl GhcPs] -> [LHsDecl GhcPs] @@ -559,8 +556,8 @@ prependDecl ldecl = \case (L (SrcSpanAnn (EpAnn (Anchor d1Rss d1AncOp) d1Ann epaCs@(EpaCommentsBalanced [] _)) ss) d1) -> let ld1' = L (SrcSpanAnn (EpAnn (Anchor d1Rss $ MovedAnchor $ DifferentLine 1 0) d1Ann epaCs) ss) d1 in (d1AncOp, ld1') - L (SrcSpanAnn EpAnnNotUsed _) _ -> trace "tag6" error "Unexpected EpAnnNotUsed" - ldecl' = setEntryDP ldecl (maybe (trace "tag7" error "what to do with UnchangedAnchor?") id $ getAnchorOpDp ancOp) + L (SrcSpanAnn EpAnnNotUsed _) _ -> error "Unexpected EpAnnNotUsed" + ldecl' = setEntryDP ldecl (maybe (error "what to do with UnchangedAnchor?") id $ getAnchorOpDp ancOp) setAnchorDp :: Anchor -> DeltaPos -> Anchor setAnchorDp (Anchor rss _) dp = Anchor rss (MovedAnchor dp) diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs index e6c6dc8e45..c0d8a5812a 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -1030,7 +1030,6 @@ addToWhere (ParsedModule _ parsedSource _ _) range name _typ = bimap traceShowId noLocA (Match newDeclMatchAnn (FunRhs (mkUnqual name) Prefix SrcStrict) [] grhss) newDeclMg = MG NoExtField (L (noAnnSrcSpanDP0 declMatchSrcSpan) [newDeclMatch]) Generated newDecl = (FunBind NoExtField (mkUnqual name) newDeclMg []) - traceShowM "tag1" prependDeclToWhereDecls match (noLocA newDecl) else pure match let decl' = L locDecl (ValD xVal (FunBind xFunBind idFunBind mg' coreFunBind)) diff --git a/plugins/hls-refactor-plugin/test/Main.hs b/plugins/hls-refactor-plugin/test/Main.hs index 54a3d629ed..f8a31420aa 100644 --- a/plugins/hls-refactor-plugin/test/Main.hs +++ b/plugins/hls-refactor-plugin/test/Main.hs @@ -2380,8 +2380,8 @@ addFunctionArgumentTests = addToWhereTests :: TestTree addToWhereTests = testGroup - "add_to_where" - [ testSession "insert_new_where" $ do + "add to where" + [ testSession "insert new where" $ do let foo = [ "module Foo where" , "" From 6bffb7b8359d2cd9894c44723c354e24c4565f12 Mon Sep 17 00:00:00 2001 From: Santiago Weight Date: Sun, 6 Nov 2022 16:13:53 -0800 Subject: [PATCH 3/6] wip --- .../hls-refactor-plugin.cabal | 1 + plugins/hls-refactor-plugin/test/Main.hs | 35 ++------------- .../test/Test/AddToWhere.hs | 45 +++++++++++++++++++ .../add_to_where/InsertNewWhere.expected.hs | 5 +++ .../golden/add_to_where/InsertNewWhere.hs | 3 ++ .../PrependWhereDecls.expected.hs | 5 +++ .../golden/add_to_where/PrependWhereDecls.hs | 4 ++ 7 files changed, 66 insertions(+), 32 deletions(-) create mode 100644 plugins/hls-refactor-plugin/test/Test/AddToWhere.hs create mode 100644 plugins/hls-refactor-plugin/test/data/golden/add_to_where/InsertNewWhere.expected.hs create mode 100644 plugins/hls-refactor-plugin/test/data/golden/add_to_where/InsertNewWhere.hs create mode 100644 plugins/hls-refactor-plugin/test/data/golden/add_to_where/PrependWhereDecls.expected.hs create mode 100644 plugins/hls-refactor-plugin/test/data/golden/add_to_where/PrependWhereDecls.hs diff --git a/plugins/hls-refactor-plugin/hls-refactor-plugin.cabal b/plugins/hls-refactor-plugin/hls-refactor-plugin.cabal index 80979f2f6e..f116b013f3 100644 --- a/plugins/hls-refactor-plugin/hls-refactor-plugin.cabal +++ b/plugins/hls-refactor-plugin/hls-refactor-plugin.cabal @@ -97,6 +97,7 @@ test-suite tests default-language: Haskell2010 hs-source-dirs: test main-is: Main.hs + other-modules: Test.AddToWhere ghc-options: -O0 -threaded -rtsopts -with-rtsopts=-N -Wunused-imports build-depends: , base diff --git a/plugins/hls-refactor-plugin/test/Main.hs b/plugins/hls-refactor-plugin/test/Main.hs index f8a31420aa..5dc5425ba0 100644 --- a/plugins/hls-refactor-plugin/test/Main.hs +++ b/plugins/hls-refactor-plugin/test/Main.hs @@ -58,6 +58,7 @@ import Test.Hls import Control.Applicative (liftA2) import qualified Development.IDE.Plugin.CodeAction as Refactor import qualified Development.IDE.Plugin.HLS.GhcIde as GhcIde +import qualified Test.AddToWhere main :: IO () main = defaultTestRunner tests @@ -319,7 +320,7 @@ codeActionTests = testGroup "code actions" , removeExportTests #if MIN_VERSION_ghc(9,2,1) , addFunctionArgumentTests - , addToWhereTests + , Test.AddToWhere.tests #endif ] @@ -2381,37 +2382,7 @@ addToWhereTests :: TestTree addToWhereTests = testGroup "add to where" - [ testSession "insert new where" $ do - let foo = - [ "module Foo where" - , "" - , "bar = 1" - , "" - , "foo True = _select [True]" - , "" - , "foo False = False" - ] - foo' = - [ "module Foo where" - , "" - , "bar = 1" - , "" - , "foo True = _select [True]" - , " where" - , " _select = _" - , "" - , "foo False = False" - ] - docB <- createDoc "ModuleB.hs" "haskell" (T.unlines foo) - _ <- waitForDiagnostics - InR action@CodeAction { _title = actionTitle } : _ - <- filter (\(InR CodeAction{_title=x}) -> "Add to " `isPrefixOf` T.unpack x ) <$> - getCodeActions docB (R 4 0 4 50) - liftIO $ actionTitle @?= "Add to where ‘_select’" - executeCodeAction action - contentAfterAction <- documentContents docB - liftIO $ contentAfterAction @?= T.unlines foo' - , testSession "simple" $ do + [ testSession "simple" $ do let foo = [ "module Foo where" , "" diff --git a/plugins/hls-refactor-plugin/test/Test/AddToWhere.hs b/plugins/hls-refactor-plugin/test/Test/AddToWhere.hs new file mode 100644 index 0000000000..0dc26d33ea --- /dev/null +++ b/plugins/hls-refactor-plugin/test/Test/AddToWhere.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE PatternSynonyms #-} + +module Test.AddToWhere (tests) where + +import Development.IDE +import Test.Tasty +import Language.LSP.Types (CodeAction(..)) +import qualified Data.Text as T +import qualified Development.IDE.Plugin.CodeAction as Refactor +import Test.Hls + +import Data.List.Extra + +tests = testGroup "add to where" [ + mkGoldenAddArgTest "InsertNewWhere" (R 0 0 0 50), + mkGoldenAddArgTest "PrependWhereDecls" (R 0 0 0 50) + ] + +mkGoldenAddArgTest :: FilePath -> Range -> TestTree +mkGoldenAddArgTest testFileName range = do + let action docB = do + _ <- waitForDiagnostics + InR action@CodeAction {_title = actionTitle} : _ <- + filter (\(InR CodeAction {_title = x}) -> "Add to" `isPrefixOf` T.unpack x) + <$> getCodeActions docB range + liftIO $ actionTitle @?= "Add to where ‘new_def’" + executeCodeAction action + goldenWithHaskellDoc + (Refactor.bindingsPluginDescriptor mempty "ghcide-code-actions-bindings") + (testFileName <> " (golden)") + "test/data/golden/add_to_where" + testFileName + "expected" + "hs" + action + +pattern R :: UInt -> UInt -> UInt -> UInt -> Range +pattern R x y x' y' = Range (Position x y) (Position x' y') diff --git a/plugins/hls-refactor-plugin/test/data/golden/add_to_where/InsertNewWhere.expected.hs b/plugins/hls-refactor-plugin/test/data/golden/add_to_where/InsertNewWhere.expected.hs new file mode 100644 index 0000000000..ea582fb9f7 --- /dev/null +++ b/plugins/hls-refactor-plugin/test/data/golden/add_to_where/InsertNewWhere.expected.hs @@ -0,0 +1,5 @@ +foo True = new_def [True] + where + new_def = _ + +foo False = False \ No newline at end of file diff --git a/plugins/hls-refactor-plugin/test/data/golden/add_to_where/InsertNewWhere.hs b/plugins/hls-refactor-plugin/test/data/golden/add_to_where/InsertNewWhere.hs new file mode 100644 index 0000000000..f50b723ab4 --- /dev/null +++ b/plugins/hls-refactor-plugin/test/data/golden/add_to_where/InsertNewWhere.hs @@ -0,0 +1,3 @@ +foo True = new_def [True] + +foo False = False \ No newline at end of file diff --git a/plugins/hls-refactor-plugin/test/data/golden/add_to_where/PrependWhereDecls.expected.hs b/plugins/hls-refactor-plugin/test/data/golden/add_to_where/PrependWhereDecls.expected.hs new file mode 100644 index 0000000000..ea79b7b3ad --- /dev/null +++ b/plugins/hls-refactor-plugin/test/data/golden/add_to_where/PrependWhereDecls.expected.hs @@ -0,0 +1,5 @@ +foo True = new_def [True] + where + new_def = _ + baz = 2 +foo False = False \ No newline at end of file diff --git a/plugins/hls-refactor-plugin/test/data/golden/add_to_where/PrependWhereDecls.hs b/plugins/hls-refactor-plugin/test/data/golden/add_to_where/PrependWhereDecls.hs new file mode 100644 index 0000000000..b34f4a5541 --- /dev/null +++ b/plugins/hls-refactor-plugin/test/data/golden/add_to_where/PrependWhereDecls.hs @@ -0,0 +1,4 @@ +foo True = new_def [True] + where + baz = 2 +foo False = False \ No newline at end of file From dfea3c9698dd62c0dca0ffcfc10ddfd0872bad8e Mon Sep 17 00:00:00 2001 From: Santiago Weight Date: Sun, 6 Nov 2022 16:19:42 -0800 Subject: [PATCH 4/6] wip --- plugins/hls-refactor-plugin/test/Main.hs | 62 +------------------ .../test/Test/AddToWhere.hs | 3 +- .../PrependWhereDeclsComplex.expected.hs | 6 ++ .../add_to_where/PrependWhereDeclsComplex.hs | 5 ++ 4 files changed, 14 insertions(+), 62 deletions(-) create mode 100644 plugins/hls-refactor-plugin/test/data/golden/add_to_where/PrependWhereDeclsComplex.expected.hs create mode 100644 plugins/hls-refactor-plugin/test/data/golden/add_to_where/PrependWhereDeclsComplex.hs diff --git a/plugins/hls-refactor-plugin/test/Main.hs b/plugins/hls-refactor-plugin/test/Main.hs index 5dc5425ba0..4ef449f99d 100644 --- a/plugins/hls-refactor-plugin/test/Main.hs +++ b/plugins/hls-refactor-plugin/test/Main.hs @@ -2382,67 +2382,7 @@ addToWhereTests :: TestTree addToWhereTests = testGroup "add to where" - [ testSession "simple" $ do - let foo = - [ "module Foo where" - , "" - , "bar = 1" - , "" - , "foo True = _select [True]" - , " where" - , " baz = 2" - , "foo False = False" - ] - foo' = - [ "module Foo where" - , "" - , "bar = 1" - , "" - , "foo True = _select [True]" - , " where" - , " _select = _" - , " baz = 2" - , "foo False = False" - ] - docB <- createDoc "ModuleB.hs" "haskell" (T.unlines foo) - _ <- waitForDiagnostics - InR action@CodeAction { _title = actionTitle } : _ - <- filter (\(InR CodeAction{_title=x}) -> "Add to " `isPrefixOf` T.unpack x ) <$> - getCodeActions docB (R 4 0 4 50) - liftIO $ actionTitle @?= "Add to where ‘_select’" - executeCodeAction action - contentAfterAction <- documentContents docB - liftIO $ contentAfterAction @?= T.unlines foo' - , testSession "simple" $ do - let foo = - [ "module Foo where" - , "" - , "bar = 1" - , "" - , "foo True = _select [True]" - , " where baz = 2" - , "foo False = False" - ] - foo' = - [ "module Foo where" - , "" - , "bar = 1" - , "" - , "foo True = _select [True]" - , " where _select = _" - , " baz = 2" - , "foo False = False" - ] - docB <- createDoc "ModuleB.hs" "haskell" (T.unlines foo) - _ <- waitForDiagnostics - InR action@CodeAction { _title = actionTitle } : _ - <- filter (\(InR CodeAction{_title=x}) -> "Add to " `isPrefixOf` T.unpack x ) <$> - getCodeActions docB (R 4 0 4 50) - liftIO $ actionTitle @?= "Add to where ‘_select’" - executeCodeAction action - contentAfterAction <- documentContents docB - liftIO $ contentAfterAction @?= T.unlines foo' - , testSession "simple" $ do + [ testSession "simple" $ do let foo = [ "module Foo where" , "" diff --git a/plugins/hls-refactor-plugin/test/Test/AddToWhere.hs b/plugins/hls-refactor-plugin/test/Test/AddToWhere.hs index 0dc26d33ea..c9d5b078bd 100644 --- a/plugins/hls-refactor-plugin/test/Test/AddToWhere.hs +++ b/plugins/hls-refactor-plugin/test/Test/AddToWhere.hs @@ -20,7 +20,8 @@ import Data.List.Extra tests = testGroup "add to where" [ mkGoldenAddArgTest "InsertNewWhere" (R 0 0 0 50), - mkGoldenAddArgTest "PrependWhereDecls" (R 0 0 0 50) + mkGoldenAddArgTest "PrependWhereDecls" (R 0 0 0 50), + mkGoldenAddArgTest "PrependWhereDeclsComplex" (R 0 0 0 50) ] mkGoldenAddArgTest :: FilePath -> Range -> TestTree diff --git a/plugins/hls-refactor-plugin/test/data/golden/add_to_where/PrependWhereDeclsComplex.expected.hs b/plugins/hls-refactor-plugin/test/data/golden/add_to_where/PrependWhereDeclsComplex.expected.hs new file mode 100644 index 0000000000..4cd99a6b3a --- /dev/null +++ b/plugins/hls-refactor-plugin/test/data/golden/add_to_where/PrependWhereDeclsComplex.expected.hs @@ -0,0 +1,6 @@ +foo True = new_def [True] + where + new_def = _ + -- c1baz = 2 -- c2 + -- c3 +foo False = False \ No newline at end of file diff --git a/plugins/hls-refactor-plugin/test/data/golden/add_to_where/PrependWhereDeclsComplex.hs b/plugins/hls-refactor-plugin/test/data/golden/add_to_where/PrependWhereDeclsComplex.hs new file mode 100644 index 0000000000..e9d0bb349b --- /dev/null +++ b/plugins/hls-refactor-plugin/test/data/golden/add_to_where/PrependWhereDeclsComplex.hs @@ -0,0 +1,5 @@ +foo True = new_def [True] + where -- c1 + baz = 2 -- c2 + -- c3 +foo False = False \ No newline at end of file From aac1e72c071a58233ce690a9a3519b6afb2e671b Mon Sep 17 00:00:00 2001 From: Santiago Weight Date: Sun, 6 Nov 2022 17:25:50 -0800 Subject: [PATCH 5/6] wip --- .../src/Development/IDE/GHC/ExactPrint.hs | 1 + plugins/hls-refactor-plugin/test/Test/AddToWhere.hs | 11 +++++++---- .../golden/add_to_where/PrependWhereDeclsComplex.hs | 9 ++++++++- 3 files changed, 16 insertions(+), 5 deletions(-) diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs index afb83f48af..f22790aae6 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs @@ -513,6 +513,7 @@ insertAtStart' old newDecl = do in newDecl' : secondDecl' : ds insertDeclAtStart _ d ds = d : ds +prependDeclToWhereDecls :: (Monad m, HasDecls b) => b -> LHsBindLR GhcPs GhcPs -> TransformT m b prependDeclToWhereDecls decl newWhereDecl = do ds <- balanceCommentsList =<< hsDecls decl let ds' = prependDecl (wrapDecl newWhereDecl) ds diff --git a/plugins/hls-refactor-plugin/test/Test/AddToWhere.hs b/plugins/hls-refactor-plugin/test/Test/AddToWhere.hs index c9d5b078bd..2455ae3998 100644 --- a/plugins/hls-refactor-plugin/test/Test/AddToWhere.hs +++ b/plugins/hls-refactor-plugin/test/Test/AddToWhere.hs @@ -17,15 +17,17 @@ import qualified Development.IDE.Plugin.CodeAction as Refactor import Test.Hls import Data.List.Extra +import System.FilePath tests = testGroup "add to where" [ mkGoldenAddArgTest "InsertNewWhere" (R 0 0 0 50), mkGoldenAddArgTest "PrependWhereDecls" (R 0 0 0 50), - mkGoldenAddArgTest "PrependWhereDeclsComplex" (R 0 0 0 50) + mkGoldenAddArgTest "PrependWhereDeclsComplex" (R 0 0 0 50), + mkGoldenAddArgTest "PrependWhereDeclsComplex" (R 6 0 6 50) ] mkGoldenAddArgTest :: FilePath -> Range -> TestTree -mkGoldenAddArgTest testFileName range = do +mkGoldenAddArgTest testFileName range@(Range (Position sl sc) (Position el ec)) = do let action docB = do _ <- waitForDiagnostics InR action@CodeAction {_title = actionTitle} : _ <- @@ -33,12 +35,13 @@ mkGoldenAddArgTest testFileName range = do <$> getCodeActions docB range liftIO $ actionTitle @?= "Add to where ‘new_def’" executeCodeAction action + rangeName = show sl <> "_" <> show sc <> "_" <> show el <> "_" <> show ec goldenWithHaskellDoc (Refactor.bindingsPluginDescriptor mempty "ghcide-code-actions-bindings") - (testFileName <> " (golden)") + (testFileName <> " " <> rangeName <> " (golden)") "test/data/golden/add_to_where" testFileName - "expected" + (rangeName <.> "expected") "hs" action diff --git a/plugins/hls-refactor-plugin/test/data/golden/add_to_where/PrependWhereDeclsComplex.hs b/plugins/hls-refactor-plugin/test/data/golden/add_to_where/PrependWhereDeclsComplex.hs index e9d0bb349b..7f0f4265fa 100644 --- a/plugins/hls-refactor-plugin/test/data/golden/add_to_where/PrependWhereDeclsComplex.hs +++ b/plugins/hls-refactor-plugin/test/data/golden/add_to_where/PrependWhereDeclsComplex.hs @@ -2,4 +2,11 @@ foo True = new_def [True] where -- c1 baz = 2 -- c2 -- c3 -foo False = False \ No newline at end of file +foo False = False + +bar True = new_def [True] + where + -- c1 + baz = 2 -- c2 + -- c3 +bar False = False \ No newline at end of file From 27407172e225760f92b4417604c969c3bb052cd8 Mon Sep 17 00:00:00 2001 From: Santiago Weight Date: Mon, 7 Nov 2022 10:29:18 -0800 Subject: [PATCH 6/6] wip --- .../add_to_where/InsertNewWhere.0_0_0_50.expected.hs | 5 +++++ .../PrependWhereDecls.0_0_0_50.expected.hs | 4 ++++ .../PrependWhereDeclsComplex.0_0_0_50.expected.hs | 12 ++++++++++++ .../PrependWhereDeclsComplex.6_0_6_50.expected.hs | 12 ++++++++++++ 4 files changed, 33 insertions(+) create mode 100644 plugins/hls-refactor-plugin/test/data/golden/add_to_where/InsertNewWhere.0_0_0_50.expected.hs create mode 100644 plugins/hls-refactor-plugin/test/data/golden/add_to_where/PrependWhereDecls.0_0_0_50.expected.hs create mode 100644 plugins/hls-refactor-plugin/test/data/golden/add_to_where/PrependWhereDeclsComplex.0_0_0_50.expected.hs create mode 100644 plugins/hls-refactor-plugin/test/data/golden/add_to_where/PrependWhereDeclsComplex.6_0_6_50.expected.hs diff --git a/plugins/hls-refactor-plugin/test/data/golden/add_to_where/InsertNewWhere.0_0_0_50.expected.hs b/plugins/hls-refactor-plugin/test/data/golden/add_to_where/InsertNewWhere.0_0_0_50.expected.hs new file mode 100644 index 0000000000..ea582fb9f7 --- /dev/null +++ b/plugins/hls-refactor-plugin/test/data/golden/add_to_where/InsertNewWhere.0_0_0_50.expected.hs @@ -0,0 +1,5 @@ +foo True = new_def [True] + where + new_def = _ + +foo False = False \ No newline at end of file diff --git a/plugins/hls-refactor-plugin/test/data/golden/add_to_where/PrependWhereDecls.0_0_0_50.expected.hs b/plugins/hls-refactor-plugin/test/data/golden/add_to_where/PrependWhereDecls.0_0_0_50.expected.hs new file mode 100644 index 0000000000..f3722920fe --- /dev/null +++ b/plugins/hls-refactor-plugin/test/data/golden/add_to_where/PrependWhereDecls.0_0_0_50.expected.hs @@ -0,0 +1,4 @@ +foo True = new_def [True] + where + new_def = _baz = 2 +foo False = False \ No newline at end of file diff --git a/plugins/hls-refactor-plugin/test/data/golden/add_to_where/PrependWhereDeclsComplex.0_0_0_50.expected.hs b/plugins/hls-refactor-plugin/test/data/golden/add_to_where/PrependWhereDeclsComplex.0_0_0_50.expected.hs new file mode 100644 index 0000000000..f0f9a8d4a1 --- /dev/null +++ b/plugins/hls-refactor-plugin/test/data/golden/add_to_where/PrependWhereDeclsComplex.0_0_0_50.expected.hs @@ -0,0 +1,12 @@ +foo True = new_def [True] + where + new_def = _ -- c1baz = 2 -- c2 + -- c3 +foo False = False + +bar True = new_def [True] + where + -- c1 + baz = 2 -- c2 + -- c3 +bar False = False \ No newline at end of file diff --git a/plugins/hls-refactor-plugin/test/data/golden/add_to_where/PrependWhereDeclsComplex.6_0_6_50.expected.hs b/plugins/hls-refactor-plugin/test/data/golden/add_to_where/PrependWhereDeclsComplex.6_0_6_50.expected.hs new file mode 100644 index 0000000000..80c026895d --- /dev/null +++ b/plugins/hls-refactor-plugin/test/data/golden/add_to_where/PrependWhereDeclsComplex.6_0_6_50.expected.hs @@ -0,0 +1,12 @@ +foo True = new_def [True] + where -- c1 + baz = 2 -- c2 + -- c3 +foo False = False + +bar True = new_def [True] + where + new_def = _ + -- c1baz = 2 -- c2 + -- c3 +bar False = False \ No newline at end of file