diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index a28467e634..9644b30ccf 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -1627,6 +1627,7 @@ library hls-refactor-plugin Development.IDE.Plugin.Plugins.Diagnostic Development.IDE.Plugin.Plugins.FillHole Development.IDE.Plugin.Plugins.FillTypeWildcard + Development.IDE.Plugin.Plugins.SuggestAddMissingFields Development.IDE.Plugin.Plugins.ImportUtils default-extensions: CPP 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 0916f9c958..a5c13b02d6 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -9,6 +9,7 @@ module Development.IDE.Plugin.CodeAction typeSigsPluginDescriptor, bindingsPluginDescriptor, fillHolePluginDescriptor, + suggestAddMissingFieldsPluginDescriptor, extendImportPluginDescriptor, -- * For testing matchRegExMultipleImports @@ -40,6 +41,7 @@ import Data.Ord (comparing) import qualified Data.Set as S import qualified Data.Text as T import qualified Data.Text.Encoding as T +import Debug.Trace import Development.IDE.Core.Rules import Development.IDE.Core.RuleTypes import Development.IDE.Core.Service @@ -102,7 +104,8 @@ import Language.LSP.Protocol.Types (ApplyWorkspa import Language.LSP.VFS (virtualFileText) import qualified Text.Fuzzy.Parallel as TFP import qualified Text.Regex.Applicative as RE -import Text.Regex.TDFA ((=~), (=~~)) +import Text.Regex.TDFA (mrAfter, + (=~), (=~~)) ------------------------------------------------------------------------------------------------- @@ -167,6 +170,9 @@ bindingsPluginDescriptor recorder plId = mkExactprintPluginDescriptor recorder $ fillHolePluginDescriptor :: Recorder (WithPriority E.Log) -> PluginId -> PluginDescriptor IdeState fillHolePluginDescriptor recorder plId = mkExactprintPluginDescriptor recorder (mkGhcideCAPlugin (wrap suggestFillHole) plId "Provides a code action to fill a hole") +suggestAddMissingFieldsPluginDescriptor :: Recorder (WithPriority E.Log) -> PluginId -> PluginDescriptor IdeState +suggestAddMissingFieldsPluginDescriptor recorder plId = mkExactprintPluginDescriptor recorder (mkGhcideCAPlugin (wrap suggestAddMissingFields) plId "Provides a code action to add missing fields") + extendImportPluginDescriptor :: Recorder (WithPriority E.Log) -> PluginId -> PluginDescriptor IdeState extendImportPluginDescriptor recorder plId = mkExactprintPluginDescriptor recorder $ (defaultPluginDescriptor plId "Provides a command to extend the import list") { pluginCommands = [extendImportCommand] } @@ -1236,7 +1242,6 @@ suggestConstraint df (makeDeltaAst -> parsedModule) diag@Diagnostic {..} -- | Suggests a constraint for an instance declaration for which a constraint is missing. suggestInstanceConstraint :: DynFlags -> ParsedSource -> Diagnostic -> T.Text -> [(T.Text, Rewrite)] - suggestInstanceConstraint df (L _ HsModule {hsmodDecls}) Diagnostic {..} missingConstraint | Just instHead <- instanceHead = [(actionTitle missingConstraint , appendConstraint (T.unpack missingConstraint) instHead)] @@ -1276,6 +1281,225 @@ suggestInstanceConstraint df (L _ HsModule {hsmodDecls}) Diagnostic {..} missing actionTitle constraint = "Add `" <> constraint <> "` to the context of the instance declaration" +suggestAddMissingFields :: ParsedSource -> Diagnostic -> [(T.Text, Rewrite)] +suggestAddMissingFields parsedSrc Diagnostic{_range=_range,..} + | Just constructorName <- extractConstructorName _message + , missingFields <- processMissingFields (T.lines _message) = + addMissingFields parsedSrc _range constructorName missingFields + | otherwise = [] + where + extractConstructorName = fmap (headOrThrow "impossible") . flip matchRegexUnifySpaces "Fields of ‘([^ ]*)’ not initialised" + headOrThrow msg = \case + [] -> error msg + (x:_) -> x + + processMissingFields :: [T.Text] -> [T.Text] + processMissingFields missingFieldLines = do + missingFieldsSection <- + getIndentedGroupsBy (=~ t " *• Fields of ‘([^ ]*)’ not initialised") missingFieldLines + missingFieldLine <- + mapHead + (mrAfter . (=~ t " *• Fields of ‘([^ ]*)’ not initialised")) + missingFieldsSection + let missingField = T.strip $ T.takeWhile (/= ':') missingFieldLine + guard $ not $ T.null missingField + pure missingField + + t = id @T.Text + + mapHead f (a:aa) = f a : aa + mapHead _ [] = [] + +-- TODO: Extract this copy pasted code from FillHole.hs into something else + +-- | +-- > getIndentedGroupsBy (" H" `isPrefixOf`) [" H1", " l1", " l2", " H2", " l3"] = [[" H1", " l1", " l2"], [" H2", " l3"]] +getIndentedGroupsBy :: (T.Text -> Bool) -> [T.Text] -> [[T.Text]] +getIndentedGroupsBy pred inp = case dropWhile (not.pred) inp of + (l:ll) -> case span (\l' -> indentation l < indentation l') ll of + (indented, rest) -> (l:indented) : getIndentedGroupsBy pred rest + _ -> [] + +indentation :: T.Text -> Int +indentation = T.length . T.takeWhile isSpace + +addMissingFields :: ParsedSource -> Range -> T.Text -> [T.Text] -> [(T.Text, Rewrite)] +addMissingFields (L _ HsModule {hsmodDecls}) range constructor missingFields + | Just (L _ (ValD _ FunBind {fun_matches})) <- findDeclContainingLoc (_start range) hsmodDecls + , Just recordCon <- findExprInMatchesWithConstructorApp constructor (_start range) fun_matches + = mkRewriteAddMissingFields missingFields $ traceAst "found-record-con" recordCon + | otherwise = [] + +mkRewriteAddMissingFields :: [T.Text] -> LHsExpr GhcPs -> [(T.Text, Rewrite)] +mkRewriteAddMissingFields missingFields expr + | (Just rewrite) <- appendRecordFields (map T.unpack missingFields) expr + = [("add all missing fields: " <> T.intercalate ", " missingFields, rewrite)] + | otherwise = [] + +findExprInMatchesWithConstructorApp :: T.Text -> Position -> MatchGroup GhcPs (LHsExpr GhcPs) -> Maybe (LHsExpr GhcPs) +findExprInMatchesWithConstructorApp constructor pos (MG _ (L _ matches)) + | Just (L _ (Match{m_grhss = GRHSs {grhssGRHSs, grhssLocalBinds}})) <- findDeclContainingLoc pos matches = + findExprInLGRHSsWithConstructorApp constructor pos grhssGRHSs + <|> findExprInHsLocalBindsWithConstructorApp constructor pos grhssLocalBinds + -- findExprWithConstructorApp constructor pos matchWithLoc + | otherwise = Nothing + +findExprInLGRHSsWithConstructorApp :: T.Text -> Position -> [LGRHS GhcPs (LHsExpr GhcPs)] -> Maybe (LHsExpr GhcPs) +findExprInLGRHSsWithConstructorApp constructor pos grhss + | (Just (L _ (GRHS _ _ expr))) <- findDeclContainingLoc pos grhss = findExprWithConstructorApp constructor pos expr + | otherwise = Nothing + +findExprInHsLocalBindsWithConstructorApp :: T.Text -> Position -> HsLocalBinds GhcPs -> Maybe (LHsExpr GhcPs) +findExprInHsLocalBindsWithConstructorApp constructor pos (HsValBinds _ (ValBinds _ bag _)) + | Just (L _ (FunBind{fun_matches})) <- findDeclContainingLoc pos bag + = findExprInMatchesWithConstructorApp constructor pos fun_matches + | otherwise = Nothing +findExprInHsLocalBindsWithConstructorApp _ _ _ = Nothing + +findExprInHsTupArgWithConstructorApp :: T.Text -> Position -> HsTupArg GhcPs -> Maybe (LHsExpr GhcPs) +findExprInHsTupArgWithConstructorApp constructor pos (Present _ expr) = + findExprWithConstructorApp constructor pos expr +findExprInHsTupArgWithConstructorApp constructor pos _ = Nothing + +findExprInHsRecordBindsWithConstructorApp :: T.Text -> Position -> HsRecordBinds GhcPs -> Maybe (LHsExpr GhcPs) +findExprInHsRecordBindsWithConstructorApp constructor pos (HsRecFields{rec_flds}) + | Just (L _ (HsFieldBind{hfbRHS})) <- findDeclContainingLoc pos rec_flds + = findExprWithConstructorApp constructor pos hfbRHS + | otherwise = Nothing + +findExprInLHsRecUpdFieldsWithConstructorApp :: T.Text -> Position -> LHsRecUpdFields GhcPs -> Maybe (LHsExpr GhcPs) +findExprInLHsRecUpdFieldsWithConstructorApp constructor pos (RegularRecUpdFields{recUpdFields}) + | Just (L _ (HsFieldBind{hfbRHS})) <- findDeclContainingLoc pos recUpdFields + = findExprWithConstructorApp constructor pos hfbRHS + | otherwise = Nothing +findExprInLHsRecUpdFieldsWithConstructorApp constructor pos (OverloadedRecUpdFields{olRecUpdFields}) + | Just (L _ (HsFieldBind{hfbRHS})) <- findDeclContainingLoc pos olRecUpdFields + = findExprWithConstructorApp constructor pos hfbRHS + | otherwise = Nothing + +findExprInStmtLRWithConstructorApp :: T.Text -> Position -> StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> Maybe (LHsExpr GhcPs) +findExprInStmtLRWithConstructorApp constructor pos = \case + LastStmt _ expr _ _ -> findInExpr expr + BindStmt _ _ expr -> findInExpr expr + ApplicativeStmt _ syntaxAndArgs _ -> Nothing + _ -> Nothing + where + findInExpr = findExprWithConstructorApp constructor pos + +findExprWithConstructorApp :: T.Text -> Position -> LHsExpr GhcPs -> Maybe (LHsExpr GhcPs) +findExprWithConstructorApp constructor pos lhsexpr@(L l insideExpr) = + if pos `isInsideSrcSpan` locA l + then go insideExpr + else Nothing + where + findInExpr = findExprWithConstructorApp constructor pos + go (HsLam _ matchGroup) = + findExprInMatchesWithConstructorApp constructor pos matchGroup + go (HsLamCase _ _ matchGroup) = + findExprInMatchesWithConstructorApp constructor pos matchGroup + go (HsApp _ expr1 expr2) = + findInExpr expr1 + <|> findInExpr expr2 + go (HsAppType _ expr _ _) = + findInExpr expr + go (OpApp _ expr1 expr2 expr3) = + findInExpr expr1 + <|> findInExpr expr2 + <|> findInExpr expr3 + go (NegApp _ expr _) = + findInExpr expr + go (HsPar _ _ expr _) = + findInExpr expr + go (SectionL _ expr1 expr2) = + findInExpr expr1 + <|> findInExpr expr2 + go (SectionR _ expr1 expr2) = + findInExpr expr1 + <|> findInExpr expr2 + go (ExplicitTuple _ tupArgs _) = + firstJust (findExprInHsTupArgWithConstructorApp constructor pos) tupArgs + go (ExplicitSum _ _ _ expr) = + findInExpr expr + go (HsCase _ expr matchGroup) = + findInExpr expr + <|> findExprInMatchesWithConstructorApp constructor pos matchGroup + go (HsIf _ expr1 expr2 expr3) = + findInExpr expr1 + <|> findInExpr expr2 + <|> findInExpr expr3 + go (HsMultiIf _ lgrhss) = + findExprInLGRHSsWithConstructorApp constructor pos lgrhss + go (HsLet _ _ localBinds _ expr) = + findExprInHsLocalBindsWithConstructorApp constructor pos localBinds + <|> findInExpr expr + go (HsDo _ _ (L _ statements)) + | (Just (L _ stmtLR)) <- findDeclContainingLoc pos statements + = findExprInStmtLRWithConstructorApp constructor pos stmtLR + | otherwise = Nothing + go (ExplicitList _ lhsexprs) = + firstJust (findInExpr) lhsexprs + go (RecordCon _ (L _ conName) recBinds ) = + -- TODO: this name comparison is dodgy + if Just pos == (_start <$> (srcSpanToRange (locA l))) && occName conName == mkDataOcc (T.unpack constructor) + then Just lhsexpr + else findExprInHsRecordBindsWithConstructorApp constructor pos recBinds + go (RecordUpd _ expr recBinds) = + findInExpr expr + <|> findExprInLHsRecUpdFieldsWithConstructorApp constructor pos recBinds + go (HsGetField{gf_expr}) = + findInExpr gf_expr + go (HsProjection{}) = Nothing + go (ExprWithTySig _ expr _) = + findInExpr expr + go (ArithSeq _ _ (From expr)) = + findInExpr expr + go (ArithSeq _ _ (FromThen expr1 expr2)) = + findInExpr expr1 + <|> findInExpr expr2 + go (ArithSeq _ _ (FromTo expr1 expr2)) = + findInExpr expr1 + <|> findInExpr expr2 + go (ArithSeq _ _ (FromThenTo expr1 expr2 expr3)) = + findInExpr expr1 + <|> findInExpr expr2 + <|> findInExpr expr3 + go (HsTypedBracket _ expr) = + findInExpr expr + go (HsUntypedBracket _ quote) = + findExprInQuoteWithConstructorApp constructor pos quote + go (HsTypedSplice _ expr) = + findInExpr expr + go (HsUntypedSplice _ (HsUntypedSpliceExpr _ expr)) = + findInExpr expr + go (HsUntypedSplice _ _) = + Nothing + go (HsProc _ _ _) = undefined -- TODO + go (HsStatic _ expr) = + findInExpr expr + go (HsPragE _ _ expr) = + findInExpr expr + go (HsVar{}) = + Nothing + go (HsUnboundVar{}) = + Nothing + go (HsRecSel{}) = + Nothing + go (HsOverLabel{}) = + Nothing + go (HsIPVar{}) = + Nothing + go (HsOverLit{}) = + Nothing + go (HsLit{}) = + Nothing + -- go (HsEmbTy _ _) = + -- Nothing + +findExprInQuoteWithConstructorApp :: T.Text -> Position -> HsQuote GhcPs -> Maybe (LHsExpr GhcPs) +findExprInQuoteWithConstructorApp constructor pos (ExpBr _ expr) + = findExprWithConstructorApp constructor pos expr +findExprInQuoteWithConstructorApp _ _ _ = Nothing + suggestImplicitParameter :: ParsedSource -> Diagnostic -> diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs index a9d5c48cc1..8f446be894 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs @@ -11,6 +11,7 @@ module Development.IDE.Plugin.CodeAction.ExactPrint ( extendImport, hideSymbol, liftParseAST, + appendRecordFields, wildCardSymbol ) where @@ -50,7 +51,7 @@ import GHC (AddEpAnn (..), NameAdornment (NameParens), TrailingAnn (AddCommaAnn), addAnns, ann, - emptyComments, reAnnL) + emptyComments, reAnnL, NoEpAnns (..)) ------------------------------------------------------------------------------ @@ -191,6 +192,44 @@ appendConstraint constraintT = go . traceAst "appendConstraint" return $ reLocA $ L lTop $ HsQualTy noExtField context ast +appendRecordFields :: [String] -> LHsExpr GhcPs -> Maybe Rewrite +appendRecordFields newFields (L l recordCon@RecordCon{rcon_flds}) = Just $ Rewrite @(HsExpr GhcPs) (locA l) $ \df -> do + lContext <- uniqueSrcSpanT + let mkLFieldOcc :: XRec GhcPs RdrName -> TransformT (Either String) (LFieldOcc GhcPs) + mkLFieldOcc label = do + pure $ reAnnL NoEpAnns emptyComments $ L lContext $ FieldOcc {foExt = NoExtField , foLabel = label} + newRecPairs :: [(LFieldOcc GhcPs, LHsExpr GhcPs)] <- mapM (\f -> (,) + <$> (mkLFieldOcc =<< liftParseAST df f) + <*> liftParseAST df ("_" <> f) + ) newFields + let newFieldRec :: (LFieldOcc GhcPs, LHsExpr GhcPs) -> (LHsRecField GhcPs (LHsExpr GhcPs)) + newFieldRec (name, val) = + let bind = HsFieldBind { hfbAnn = epAnn lContext [AddEpAnn AnnEqual (epl 0)] + , hfbLHS = name + , hfbRHS = val + , hfbPun = False + } + in reAnnL (AnnListItem [AddCommaAnn (epl 0)]) emptyComments $ L lContext bind + newRecFlds = map newFieldRec newRecPairs + oldRecFlds = rec_flds rcon_flds + + addTrailingComma :: [LHsRecField GhcPs (LHsExpr GhcPs)] -> [LHsRecField GhcPs (LHsExpr GhcPs)] + addTrailingComma = updateLast $ \(L _ x) -> reAnnL (AnnListItem [AddCommaAnn (epl 0)]) emptyComments $ L lContext x + + removeTrailingComma :: [LHsRecField GhcPs (LHsExpr GhcPs)] -> [LHsRecField GhcPs (LHsExpr GhcPs)] + removeTrailingComma = updateLast $ \(L _ x) -> reAnnL (AnnListItem []) emptyComments $ L lContext x + pure $ L l (recordCon { + rcon_flds = rcon_flds { + rec_flds = addTrailingComma oldRecFlds <> removeTrailingComma newRecFlds + } + }) +appendRecordFields _ _ = Nothing + +updateLast :: (a -> a) -> [a] -> [a] +updateLast _ [] = [] +updateLast f [x] = [f x] +updateLast f (x : xs) = x : updateLast f xs + liftParseAST :: forall ast l. (ASTElement l ast, ExactPrint (LocatedAn l ast)) => DynFlags -> String -> TransformT (Either String) (LocatedAn l ast) diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Util.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Util.hs index 40f3c76127..afbb5b2243 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Util.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Util.hs @@ -42,4 +42,3 @@ traceAst lbl x [prettyCallStack callStack ++ ":" , exactPrint x , "file://" ++ htmlDumpFileName] - diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/SuggestAddMissingFields.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/SuggestAddMissingFields.hs new file mode 100644 index 0000000000..b3d6718322 --- /dev/null +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/SuggestAddMissingFields.hs @@ -0,0 +1,69 @@ +module Development.IDE.Plugin.Plugins.SuggestAddMissingFields + ( suggestAddMissingFields + ) where + +import Control.Monad (guard) +import Data.Char +import qualified Data.Text as T +import Development.IDE.GHC.Compat +import Development.IDE.Plugin.Plugins.Diagnostic +import Development.IDE.Types.Location +import Language.LSP.Protocol.Types (Diagnostic (..), + TextEdit (TextEdit)) +import Text.Regex.TDFA (MatchResult (..), + (=~)) + +suggestAddMissingFields :: ParsedSource -> Diagnostic -> [(T.Text, TextEdit)] +suggestAddMissingFields parsedSrc Diagnostic{_range=_range,..} + | Just constructorName <- extractConstructorName _message + , missingFields <- processMissingFields (T.lines _message) = + [proposeAddAllMissingFields constructorName missingFields] + | otherwise = [] + where + extractConstructorName = fmap (headOrThrow "impossible") . flip matchRegexUnifySpaces "Fields of ‘([^ ]*)’ not initialised" + proposeAddAllMissingFields :: T.Text -> [T.Text] -> (T.Text, TextEdit) + proposeAddAllMissingFields constructorName missingFields = + ( "add all missing fields: " <> T.intercalate ", " missingFields + , TextEdit _range $ + constructorName <> " {" + <> T.intercalate ", " (fieldWithDummyValue <$> missingFields) + <> "}" + ) + fieldWithDummyValue field = field <> " = _" <> field + headOrThrow msg = \case + [] -> error msg + (x:_) -> x + + +newSrc :: ParsedSource -> Range -> T.Text -> [T.Text] -> ParsedSource +newSrc = undefined + + +processMissingFields :: [T.Text] -> [T.Text] +processMissingFields missingFieldLines = do + missingFieldsSection <- + getIndentedGroupsBy (=~ t " *• Fields of ‘([^ ]*)’ not initialised") missingFieldLines + missingFieldLine <- + mapHead + (mrAfter . (=~ t " *• Fields of ‘([^ ]*)’ not initialised")) + missingFieldsSection + let missingField = T.strip $ T.takeWhile (/= ':') missingFieldLine + guard $ not $ T.null missingField + pure missingField + where + t = id @T.Text + mapHead f (a:aa) = f a : aa + mapHead _ [] = [] + +-- TODO: Extract this copy pasted code from FillHole.hs into something else + +-- | +-- > getIndentedGroupsBy (" H" `isPrefixOf`) [" H1", " l1", " l2", " H2", " l3"] = [[" H1", " l1", " l2"], [" H2", " l3"]] +getIndentedGroupsBy :: (T.Text -> Bool) -> [T.Text] -> [[T.Text]] +getIndentedGroupsBy pred inp = case dropWhile (not.pred) inp of + (l:ll) -> case span (\l' -> indentation l < indentation l') ll of + (indented, rest) -> (l:indented) : getIndentedGroupsBy pred rest + _ -> [] + +indentation :: T.Text -> Int +indentation = T.length . T.takeWhile isSpace diff --git a/plugins/hls-refactor-plugin/test/Main.hs b/plugins/hls-refactor-plugin/test/Main.hs index 6bde5b861f..4b5fb266b5 100644 --- a/plugins/hls-refactor-plugin/test/Main.hs +++ b/plugins/hls-refactor-plugin/test/Main.hs @@ -60,6 +60,7 @@ refactorPlugin = do <> mkPluginTestDescriptor Refactor.typeSigsPluginDescriptor "ghcide-code-actions-type-signatures" <> mkPluginTestDescriptor Refactor.bindingsPluginDescriptor "ghcide-code-actions-bindings" <> mkPluginTestDescriptor Refactor.fillHolePluginDescriptor "ghcide-code-actions-fill-holes" + <> mkPluginTestDescriptor Refactor.suggestAddMissingFieldsPluginDescriptor "ghcide-code-actions-add-missing-fields" <> mkPluginTestDescriptor Refactor.extendImportPluginDescriptor "ghcide-completions-1" @@ -317,6 +318,7 @@ codeActionTests = testGroup "code actions" , exportUnusedTests , addImplicitParamsConstraintTests , removeExportTests + , suggestMissingFieldsTests , Test.AddArgument.tests ] @@ -3478,6 +3480,39 @@ exportTemplate mRange initialLines expectedAction expectedLines = do Nothing -> liftIO $ [_title | InR CodeAction{_title} <- actions, _title == expectedAction ] @?= [] +suggestMissingFieldsTests :: TestTree +suggestMissingFieldsTests = testGroup "suggest missing fields" + [ testSession "when no fields are specified" $ do + let mkDoc x = T.unlines + [ "module Testing where" + , "data Person = Person { firstname :: String, lastname :: String }" + , "test :: Person" + , "test = Person {" <> x <>"}" + ] + doc <- createDoc "Test.hs" "haskell" $ mkDoc "" + _ <- waitForDiagnostics + actions <- getCodeActions doc (Range (Position 3 7) (Position 3 16)) + chosen <- pickActionWithTitle "add all missing fields: firstname, lastname" actions + executeCodeAction chosen + modifiedCode <- documentContents doc + liftIO $ mkDoc "firstname=_firstname,lastname=_lastname" @=? modifiedCode + , testSession "when some fields are specified" $ do + let mkDoc x = T.unlines + [ "module Testing where" + , "data Person = Person { foo :: String, firstname :: String, lastname :: String }" + , "test :: Person" + , "test = Person {foo = \"bar\", firstname = \"Somebody\"" <> x <>"}" + ] + doc <- createDoc "Test.hs" "haskell" $ mkDoc "" + _ <- waitForDiagnostics + -- actions <- getCodeActions doc (Range (Position 0 0) (Position 4 0)) + actions <- getAllCodeActions doc + chosen <- pickActionWithTitle "add all missing fields: lastname" actions + executeCodeAction chosen + modifiedCode <- documentContents doc + liftIO $ mkDoc ",lastname=_lastname" @=? modifiedCode + ] + removeExportTests :: TestTree removeExportTests = testGroup "remove export actions" [ testSession "single export" $ template