diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index 857e686c7b..994e502d3e 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -1557,10 +1557,13 @@ importStyles IdentInfo {parent, rendered, isDatacon} | otherwise = ImportTopLevel rendered :| [] +-- | Used for adding new imports renderImportStyle :: ImportStyle -> T.Text -renderImportStyle (ImportTopLevel x) = x +renderImportStyle (ImportTopLevel x) = x +renderImportStyle (ImportViaParent x p@(T.uncons -> Just ('(', _))) = "type " <> p <> "(" <> x <> ")" renderImportStyle (ImportViaParent x p) = p <> "(" <> x <> ")" +-- | Used for extending import lists unImportStyle :: ImportStyle -> (Maybe String, String) unImportStyle (ImportTopLevel x) = (Nothing, T.unpack x) unImportStyle (ImportViaParent x y) = (Just $ T.unpack y, T.unpack x) diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs index fcd8625d59..e5fa05ce8f 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs @@ -35,7 +35,7 @@ import Development.IDE.GHC.ExactPrint (ASTElement (parseAST), import Development.IDE.Spans.Common import FieldLabel (flLabel) import GHC.Exts (IsList (fromList)) -import GhcPlugins (sigPrec) +import GhcPlugins (mkRdrUnqual, sigPrec) import Language.Haskell.GHC.ExactPrint import Language.Haskell.GHC.ExactPrint.Types (DeltaPos (DP), KeywordId (G), mkAnnKey) @@ -200,44 +200,48 @@ extendImport mparent identifier lDecl@(L l _) = Rewrite l $ \df -> do case mparent of Just parent -> extendImportViaParent df parent identifier lDecl - _ -> extendImportTopLevel df identifier lDecl + _ -> extendImportTopLevel identifier lDecl --- | Add an identifier to import list +-- | Add an identifier or a data type to import list -- -- extendImportTopLevel "foo" AST: -- -- import A --> Error -- import A (foo) --> Error -- import A (bar) --> import A (bar, foo) -extendImportTopLevel :: DynFlags -> String -> LImportDecl GhcPs -> TransformT (Either String) (LImportDecl GhcPs) -extendImportTopLevel df idnetifier (L l it@ImportDecl{..}) +extendImportTopLevel :: + -- | rendered + String -> + LImportDecl GhcPs -> + TransformT (Either String) (LImportDecl GhcPs) +extendImportTopLevel thing (L l it@ImportDecl{..}) | Just (hide, L l' lies) <- ideclHiding , hasSibling <- not $ null lies = do src <- uniqueSrcSpanT top <- uniqueSrcSpanT - rdr <- liftParseAST df idnetifier + let rdr = L src $ mkRdrUnqual $ mkVarOcc thing let alreadyImported = showNameWithoutUniques (occName (unLoc rdr)) `elem` map (showNameWithoutUniques @OccName) (listify (const True) lies) when alreadyImported $ - lift (Left $ idnetifier <> " already imported") + lift (Left $ thing <> " already imported") let lie = L src $ IEName rdr x = L top $ IEVar noExtField lie if x `elem` lies - then lift (Left $ idnetifier <> " already imported") + then lift (Left $ thing <> " already imported") else do when hasSibling $ addTrailingCommaT (last lies) addSimpleAnnT x (DP (0, if hasSibling then 1 else 0)) [] - addSimpleAnnT rdr dp00 $ unqalDP $ hasParen idnetifier + addSimpleAnnT rdr dp00 [(G AnnVal, dp00)] -- Parens are attachted to `lies`, so if `lies` was empty previously, -- we need change the ann key from `[]` to `:` to keep parens and other anns. unless hasSibling $ transferAnn (L l' lies) (L l' [x]) id return $ L l it{ideclHiding = Just (hide, L l' $ lies ++ [x])} -extendImportTopLevel _ _ _ = lift $ Left "Unable to extend the import list" +extendImportTopLevel _ _ = lift $ Left "Unable to extend the import list" -- | Add an identifier with its parent to import list -- @@ -249,7 +253,14 @@ extendImportTopLevel _ _ _ = lift $ Left "Unable to extend the import list" -- import A () --> import A (Bar(Cons)) -- import A (Foo, Bar) --> import A (Foo, Bar(Cons)) -- import A (Foo, Bar()) --> import A (Foo, Bar(Cons)) -extendImportViaParent :: DynFlags -> String -> String -> LImportDecl GhcPs -> TransformT (Either String) (LImportDecl GhcPs) +extendImportViaParent :: + DynFlags -> + -- | parent (already parenthesized if needs) + String -> + -- | rendered child + String -> + LImportDecl GhcPs -> + TransformT (Either String) (LImportDecl GhcPs) extendImportViaParent df parent child (L l it@ImportDecl{..}) | Just (hide, L l' lies) <- ideclHiding = go hide l' [] lies where @@ -260,8 +271,8 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) -- ThingAbs ie => ThingWith ie child | parent == unIEWrappedName ie = do srcChild <- uniqueSrcSpanT - childRdr <- liftParseAST df child - let childLIE = L srcChild $ IEName childRdr + let childRdr = L srcChild $ mkRdrUnqual $ mkVarOcc child + childLIE = L srcChild $ IEName childRdr x :: LIE GhcPs = L ll' $ IEThingWith noExtField absIE NoIEWildcard [childLIE] [] -- take anns from ThingAbs, and attatch parens to it transferAnn lAbs x $ \old -> old{annsDP = annsDP old ++ [(G AnnOpenP, DP (0, 1)), (G AnnCloseP, dp00)]} @@ -273,7 +284,7 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) , hasSibling <- not $ null lies' = do srcChild <- uniqueSrcSpanT - childRdr <- liftParseAST df child + let childRdr = L srcChild $ mkRdrUnqual $ mkVarOcc child let alreadyImported = showNameWithoutUniques (occName (unLoc childRdr)) @@ -284,7 +295,7 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) when hasSibling $ addTrailingCommaT (last lies') let childLIE = L srcChild $ IEName childRdr - addSimpleAnnT childRdr (DP (0, if hasSibling then 1 else 0)) $ unqalDP $ hasParen child + addSimpleAnnT childRdr (DP (0, if hasSibling then 1 else 0)) [(G AnnVal, dp00)] return $ L l it{ideclHiding = Just (hide, L l' $ reverse pre ++ [L l'' (IEThingWith noExtField twIE NoIEWildcard (lies' ++ [childLIE]) [])] ++ xs)} go hide l' pre (x : xs) = go hide l' (x : pre) xs go hide l' pre [] @@ -294,14 +305,18 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) srcParent <- uniqueSrcSpanT srcChild <- uniqueSrcSpanT parentRdr <- liftParseAST df parent - childRdr <- liftParseAST df child + let childRdr = L srcChild $ mkRdrUnqual $ mkVarOcc child + isParentOperator = hasParen parent when hasSibling $ addTrailingCommaT (head pre) - let parentLIE = L srcParent $ IEName parentRdr + let parentLIE = L srcParent $ (if isParentOperator then IEType else IEName) parentRdr childLIE = L srcChild $ IEName childRdr x :: LIE GhcPs = L l'' $ IEThingWith noExtField parentLIE NoIEWildcard [childLIE] [] - addSimpleAnnT parentRdr (DP (0, if hasSibling then 1 else 0)) $ unqalDP $ hasParen parent - addSimpleAnnT childRdr (DP (0, 0)) $ unqalDP $ hasParen child + -- Add AnnType for the parent if it's parenthesized (type operator) + when isParentOperator $ + addSimpleAnnT parentLIE (DP (0, 0)) [(G AnnType, DP (0, 0))] + addSimpleAnnT parentRdr (DP (0, if hasSibling then 1 else 0)) $ unqalDP 1 isParentOperator + addSimpleAnnT childRdr (DP (0, 0)) [(G AnnVal, dp00)] addSimpleAnnT x (DP (0, 0)) [(G AnnOpenP, DP (0, 1)), (G AnnCloseP, DP (0, 0))] -- Parens are attachted to `pre`, so if `pre` was empty previously, -- we need change the ann key from `[]` to `:` to keep parens and other anns. @@ -317,10 +332,10 @@ hasParen :: String -> Bool hasParen ('(' : _) = True hasParen _ = False -unqalDP :: Bool -> [(KeywordId, DeltaPos)] -unqalDP paren = +unqalDP :: Int -> Bool -> [(KeywordId, DeltaPos)] +unqalDP c paren = ( if paren - then \x -> (G AnnOpenP, dp00) : x : [(G AnnCloseP, dp00)] + then \x -> (G AnnOpenP, DP (0, c)) : x : [(G AnnCloseP, dp00)] else pure ) (G AnnVal, dp00) @@ -364,7 +379,7 @@ extendHiding symbol (L l idecls) mlies df = do , (G AnnCloseP, DP (0, 0)) ] addSimpleAnnT x (DP (0, 0)) [] - addSimpleAnnT rdr dp00 $ unqalDP $ isOperator $ unLoc rdr + addSimpleAnnT rdr dp00 $ unqalDP 0 $ isOperator $ unLoc rdr if hasSibling then when hasSibling $ do addTrailingCommaT x diff --git a/ghcide/src/Development/IDE/Types/Exports.hs b/ghcide/src/Development/IDE/Types/Exports.hs index 28de5b6d58..a25d2faf0f 100644 --- a/ghcide/src/Development/IDE/Types/Exports.hs +++ b/ghcide/src/Development/IDE/Types/Exports.hs @@ -56,21 +56,30 @@ instance NFData IdentInfo where -- deliberately skip the rendered field rnf name `seq` rnf parent `seq` rnf isDatacon `seq` rnf moduleNameText +-- | Render an identifier as imported or exported style. +-- TODO: pattern synonym +renderIEWrapped :: Name -> Text +renderIEWrapped n + | isTcOcc occ && isSymOcc occ = "type " <> pack (printName n) + | otherwise = pack $ printName n + where + occ = occName n + mkIdentInfos :: Text -> AvailInfo -> [IdentInfo] mkIdentInfos mod (Avail n) = - [IdentInfo (pack (prettyPrint n)) (pack (printName n)) Nothing (isDataConName n) mod] + [IdentInfo (pack (prettyPrint n)) (renderIEWrapped n) Nothing (isDataConName n) mod] mkIdentInfos mod (AvailTC parent (n:nn) flds) -- Following the GHC convention that parent == n if parent is exported | n == parent - = [ IdentInfo (pack (prettyPrint n)) (pack (printName n)) (Just $! parentP) (isDataConName n) mod + = [ IdentInfo (pack (prettyPrint n)) (renderIEWrapped n) (Just $! parentP) (isDataConName n) mod | n <- nn ++ map flSelector flds ] ++ - [ IdentInfo (pack (prettyPrint n)) (pack (printName n)) Nothing (isDataConName n) mod] + [ IdentInfo (pack (prettyPrint n)) (renderIEWrapped n) Nothing (isDataConName n) mod] where parentP = pack $ printName parent mkIdentInfos mod (AvailTC _ nn flds) - = [ IdentInfo (pack (prettyPrint n)) (pack (printName n)) Nothing (isDataConName n) mod + = [ IdentInfo (pack (prettyPrint n)) (renderIEWrapped n) Nothing (isDataConName n) mod | n <- nn ++ map flSelector flds ] diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 7089247fd6..f724374bde 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -1380,13 +1380,33 @@ extendImportTests = testGroup "extend import actions" , "x = Refl" ]) (Range (Position 3 17) (Position 3 18)) - ["Add (:~:)(Refl) to the import list of Data.Type.Equality"] + ["Add type (:~:)(Refl) to the import list of Data.Type.Equality"] (T.unlines [ "module ModuleA where" , "import Data.Type.Equality ((:~:) (Refl))" , "x :: (:~:) [] []" , "x = Refl" ]) + , expectFailBecause "importing pattern synonyms is unsupported" + $ testSession "extend import list with pattern synonym" $ template + [("ModuleA.hs", T.unlines + [ "{-# LANGUAGE PatternSynonyms #-}" + , "module ModuleA where" + , "pattern Some x = Just x" + ]) + ] + ("ModuleB.hs", T.unlines + [ "module ModuleB where" + , "import A ()" + , "k (Some x) = x" + ]) + (Range (Position 2 3) (Position 2 7)) + ["Add pattern Some to the import list of A"] + (T.unlines + [ "module ModuleB where" + , "import A (pattern Some)" + , "k (Some x) = x" + ]) ] where codeActionTitle CodeAction{_title=x} = x @@ -1549,6 +1569,7 @@ suggestImportTests = testGroup "suggest import actions" , test True [] "f = (&) [] id" [] "import Data.Function ((&))" , test True [] "f = (.|.)" [] "import Data.Bits (Bits((.|.)))" , test True [] "f = (.|.)" [] "import Data.Bits ((.|.))" + , test True [] "f :: a ~~ b" [] "import Data.Type.Equality (type (~~))" , test True ["qualified Data.Text as T" ] "f = T.putStrLn" [] "import qualified Data.Text.IO as T" @@ -1563,6 +1584,7 @@ suggestImportTests = testGroup "suggest import actions" , "qualified Data.Data as T" ] "f = T.putStrLn" [] "import qualified Data.Text.IO as T" ] + , expectFailBecause "importing pattern synonyms is unsupported" $ test True [] "k (Some x) = x" [] "import B (pattern Some)" ] where test = test' False @@ -1570,8 +1592,9 @@ suggestImportTests = testGroup "suggest import actions" test' waitForCheckProject wanted imps def other newImp = testSessionWithExtraFiles "hover" (T.unpack def) $ \dir -> do let before = T.unlines $ "module A where" : ["import " <> x | x <- imps] ++ def : other after = T.unlines $ "module A where" : ["import " <> x | x <- imps] ++ [newImp] ++ def : other - cradle = "cradle: {direct: {arguments: [-hide-all-packages, -package, base, -package, text, -package-env, -, A, Bar, Foo]}}" + cradle = "cradle: {direct: {arguments: [-hide-all-packages, -package, base, -package, text, -package-env, -, A, Bar, Foo, B]}}" liftIO $ writeFileUTF8 (dir "hie.yaml") cradle + liftIO $ writeFileUTF8 (dir "B.hs") $ unlines ["{-# LANGUAGE PatternSynonyms #-}", "module B where", "pattern Some x = Just x"] doc <- createDoc "Test.hs" "haskell" before waitForProgressDone _diags <- waitForDiagnostics @@ -3987,7 +4010,7 @@ nonLocalCompletionTests = ["module A where", "import Data.Type.Equality ()", "f = Ref"] (Position 2 8) "Refl" - ["module A where", "import Data.Type.Equality ((:~:) (Refl))", "f = Ref"] + ["module A where", "import Data.Type.Equality (type (:~:) (Refl))", "f = Ref"] ] , testGroup "Record completion" [ completionCommandTest