Skip to content

Commit

Permalink
optimize ambiguity import suggestions (#1669)
Browse files Browse the repository at this point in the history
  • Loading branch information
July541 committed Apr 5, 2021
1 parent c2c02fb commit 6fce454
Show file tree
Hide file tree
Showing 7 changed files with 93 additions and 32 deletions.
1 change: 1 addition & 0 deletions ghcide/ghcide.cabal
Expand Up @@ -346,6 +346,7 @@ test-suite ghcide-tests
QuickCheck,
quickcheck-instances,
rope-utf16-splay,
regex-tdfa ^>= 1.3.1,
safe,
safe-exceptions,
shake,
Expand Down
54 changes: 31 additions & 23 deletions ghcide/src/Development/IDE/Plugin/CodeAction.hs
Expand Up @@ -848,31 +848,39 @@ suggestImportDisambiguation df (Just txt) ps@(L _ HsModule {hsmodImports}) diag@
toModuleTarget mName = ExistingImp <$> Map.lookup mName locDic
parensed =
"(" `T.isPrefixOf` T.strip (textInRange _range txt)
-- > removeAllDuplicates [1, 1, 2, 3, 2] = [3]
removeAllDuplicates = map head . filter ((==1) <$> length) . group . sort
hasDuplicate xs = length xs /= length (S.fromList xs)
suggestions symbol mods
| Just targets <- mapM toModuleTarget mods =
sortOn fst
[ ( renderUniquify mode modNameText symbol
, disambiguateSymbol ps diag symbol mode
)
| (modTarget, restImports) <- oneAndOthers targets
, let modName = targetModuleName modTarget
modNameText = T.pack $ moduleNameString modName
, mode <-
HideOthers restImports :
[ ToQualified parensed qual
| ExistingImp imps <- [modTarget]
, L _ qual <- nubOrd $ mapMaybe (ideclAs . unLoc)
$ NE.toList imps
]
++ [ToQualified parensed modName
| any (occursUnqualified symbol . unLoc)
(targetImports modTarget)
|| case modTarget of
ImplicitPrelude{} -> True
_ -> False
]
| hasDuplicate mods = case mapM toModuleTarget (removeAllDuplicates mods) of
Just targets -> suggestionsImpl symbol (map (, []) targets)
Nothing -> []
| otherwise = case mapM toModuleTarget mods of
Just targets -> suggestionsImpl symbol (oneAndOthers targets)
Nothing -> []
suggestionsImpl symbol targetsWithRestImports =
sortOn fst
[ ( renderUniquify mode modNameText symbol
, disambiguateSymbol ps diag symbol mode
)
| (modTarget, restImports) <- targetsWithRestImports
, let modName = targetModuleName modTarget
modNameText = T.pack $ moduleNameString modName
, mode <-
[ ToQualified parensed qual
| ExistingImp imps <- [modTarget]
, L _ qual <- nubOrd $ mapMaybe (ideclAs . unLoc)
$ NE.toList imps
]
| otherwise = []
++ [ToQualified parensed modName
| any (occursUnqualified symbol . unLoc)
(targetImports modTarget)
|| case modTarget of
ImplicitPrelude{} -> True
_ -> False
]
++ [HideOthers restImports | not (null restImports)]
]
renderUniquify HideOthers {} modName symbol =
"Use " <> modName <> " for " <> symbol <> ", hiding other imports"
renderUniquify (ToQualified _ qual) _ symbol =
Expand Down
9 changes: 9 additions & 0 deletions ghcide/test/data/hiding/FVec.hs
@@ -0,0 +1,9 @@
{-# LANGUAGE DuplicateRecordFields #-}

module FVec (RecA(..), RecB(..)) where

data Vec a

newtype RecA a = RecA { fromList :: [a] -> Vec a }

newtype RecB a = RecB { fromList :: [a] -> Vec a }
@@ -0,0 +1,10 @@
module HideQualifyDuplicateRecordFields where

import AVec
import BVec
import CVec
import DVec
import EVec
import FVec

theFun = AVec.fromList
10 changes: 10 additions & 0 deletions ghcide/test/data/hiding/HideQualifyDuplicateRecordFields.hs
@@ -0,0 +1,10 @@
module HideQualifyDuplicateRecordFields where

import AVec
import BVec
import CVec
import DVec
import EVec
import FVec

theFun = fromList
@@ -0,0 +1,5 @@
module HideQualifyDuplicateRecordFieldsSelf where

import FVec

x = fromList
36 changes: 27 additions & 9 deletions ghcide/test/exe/Main.hs
Expand Up @@ -93,14 +93,15 @@ import Test.Tasty.ExpectedFailure
import Test.Tasty.HUnit
import Test.Tasty.Ingredients.Rerun
import Test.Tasty.QuickCheck
import Data.IORef
import Ide.PluginUtils (pluginDescToIdePlugins)
import Control.Concurrent.Async
import Ide.Types
import Data.String (IsString(fromString))
import qualified Language.LSP.Types as LSP
import Data.IORef.Extra (atomicModifyIORef_)
import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide
import Data.IORef
import Ide.PluginUtils (pluginDescToIdePlugins)
import Control.Concurrent.Async
import Ide.Types
import Data.String (IsString(fromString))
import qualified Language.LSP.Types as LSP
import Data.IORef.Extra (atomicModifyIORef_)
import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide
import Text.Regex.TDFA ((=~))

waitForProgressBegin :: Session ()
waitForProgressBegin = skipManyTill anyMessage $ satisfyMaybe $ \case
Expand Down Expand Up @@ -1673,6 +1674,23 @@ suggestImportDisambiguationTests = testGroup "suggest import disambiguation acti
compareHideFunctionTo [(8,9),(10,8)]
"Replace with qualified: E.fromList"
"HideFunction.expected.qualified.fromList.E.hs"
, testCase "Hide DuplicateRecordFields" $
compareTwo
"HideQualifyDuplicateRecordFields.hs" [(9, 9)]
"Replace with qualified: AVec.fromList"
"HideQualifyDuplicateRecordFields.expected.hs"
, testCase "Duplicate record fields should not be imported" $ do
withTarget ("HideQualifyDuplicateRecordFields" <.> ".hs") [(9, 9)] $
\_ actions -> do
liftIO $
assertBool "Hidings should not be presented while DuplicateRecordFields exists" $
all not [ actionTitle =~ T.pack "Use ([A-Za-z][A-Za-z0-9]*) for fromList, hiding other imports"
| InR CodeAction { _title = actionTitle } <- actions]
withTarget ("HideQualifyDuplicateRecordFieldsSelf" <.> ".hs") [(4, 4)] $
\_ actions -> do
liftIO $
assertBool "ambiguity from DuplicateRecordFields should not be imported" $
null actions
]
, testGroup "(++)"
[ testCase "Prelude, parensed" $
Expand Down Expand Up @@ -1708,7 +1726,7 @@ suggestImportDisambiguationTests = testGroup "suggest import disambiguation acti
contentAfterAction <- documentContents doc
liftIO $ T.replace "\r\n" "\n" expected @=? contentAfterAction
compareHideFunctionTo = compareTwo "HideFunction.hs"
auxFiles = ["AVec.hs", "BVec.hs", "CVec.hs", "DVec.hs", "EVec.hs"]
auxFiles = ["AVec.hs", "BVec.hs", "CVec.hs", "DVec.hs", "EVec.hs", "FVec.hs"]
withTarget file locs k = withTempDir $ \dir -> runInDir dir $ do
liftIO $ mapM_ (\fp -> copyFile (hidingDir </> fp) $ dir </> fp)
$ file : auxFiles
Expand Down

0 comments on commit 6fce454

Please sign in to comment.