From 6e74ae0d5071bcb6629a1174aca04dcf211a039f Mon Sep 17 00:00:00 2001
From: Pepe Iborra <pepeiborra@gmail.com>
Date: Sun, 6 Sep 2020 13:26:22 +0100
Subject: [PATCH] Fix bug in exports map

It was appending lists of identifiers without pruning duplicates
---
 session-loader/Development/IDE/Session.hs |  3 ++-
 src/Development/IDE/Core/OfInterest.hs    |  2 +-
 src/Development/IDE/Core/Shake.hs         |  2 +-
 src/Development/IDE/Plugin/CodeAction.hs  |  5 +++--
 src/Development/IDE/Types/Exports.hs      | 20 ++++++++++++++++----
 5 files changed, 23 insertions(+), 9 deletions(-)

diff --git a/session-loader/Development/IDE/Session.hs b/session-loader/Development/IDE/Session.hs
index 42546d35d..ec7231ba7 100644
--- a/session-loader/Development/IDE/Session.hs
+++ b/session-loader/Development/IDE/Session.hs
@@ -64,6 +64,7 @@ import Linker
 import Module
 import NameCache
 import Packages
+import Control.Exception (evaluate)
 
 -- | Given a root directory, return a Shake 'Action' which setups an
 -- 'IdeGhcSession' given a file.
@@ -312,7 +313,7 @@ loadSession dir = do
             -- update xports map
             extras <- getShakeExtras
             let !exportsMap' = createExportsMap $ mapMaybe (fmap hirModIface) modIfaces
-            liftIO $ modifyVar_ (exportsMap extras) $ return . (exportsMap' <>)
+            liftIO $ modifyVar_ (exportsMap extras) $ evaluate . (exportsMap' <>)
       pure opts
 
 -- | Run the specific cradle on a specific FilePath via hie-bios.
diff --git a/src/Development/IDE/Core/OfInterest.hs b/src/Development/IDE/Core/OfInterest.hs
index 851a1d0e1..1c375ec3c 100644
--- a/src/Development/IDE/Core/OfInterest.hs
+++ b/src/Development/IDE/Core/OfInterest.hs
@@ -99,6 +99,6 @@ kick = mkDelayedAction "kick" Debug $ do
     ShakeExtras{exportsMap} <- getShakeExtras
     let modIfaces = mapMaybe (fmap (hm_iface . tmrModInfo)) results
         !exportsMap' = createExportsMap modIfaces
-    liftIO $ modifyVar_ exportsMap $ return . (exportsMap' <>)
+    liftIO $ modifyVar_ exportsMap $ evaluate . (exportsMap' <>)
 
     liftIO $ progressUpdate KickCompleted
diff --git a/src/Development/IDE/Core/Shake.hs b/src/Development/IDE/Core/Shake.hs
index 7c09507dc..10628fa7d 100644
--- a/src/Development/IDE/Core/Shake.hs
+++ b/src/Development/IDE/Core/Shake.hs
@@ -413,7 +413,7 @@ shakeOpen getLspId eventer withProgress withIndefiniteProgress logger debouncer
         progressAsync <- async $
             when reportProgress $
                 progressThread mostRecentProgressEvent inProgress
-        exportsMap <- newVar HMap.empty
+        exportsMap <- newVar mempty
 
         actionQueue <- newQueue
 
diff --git a/src/Development/IDE/Plugin/CodeAction.hs b/src/Development/IDE/Plugin/CodeAction.hs
index 10210ca75..7bab40598 100644
--- a/src/Development/IDE/Plugin/CodeAction.hs
+++ b/src/Development/IDE/Plugin/CodeAction.hs
@@ -59,6 +59,7 @@ import Control.Applicative ((<|>))
 import Safe (atMay)
 import Bag (isEmptyBag)
 import Control.Concurrent.Extra (readVar)
+import qualified Data.HashSet as Set
 
 plugin :: Plugin c
 plugin = codeActionPluginWithRules rules codeAction <> Plugin mempty setHandlersCodeLens
@@ -85,7 +86,7 @@ codeAction lsp state (TextDocumentIdentifier uri) _range CodeActionContext{_diag
     -- This is quite expensive 0.6-0.7s on GHC
     pkgExports <- runAction "CodeAction:PackageExports" state $ (useNoFile_ . PackageExports) `traverse` env
     localExports <- readVar (exportsMap $ shakeExtras state)
-    let exportsMap = Map.unionWith (<>) localExports (fromMaybe mempty pkgExports)
+    let exportsMap = localExports <> fromMaybe mempty pkgExports
     let dflags = hsc_dflags . hscEnv <$> env
     pure $ Right
         [ CACodeAction $ CodeAction title (Just CodeActionQuickFix) (Just $ List [x]) (Just edit) Nothing
@@ -881,7 +882,7 @@ constructNewImportSuggestions
   :: ExportsMap -> NotInScope -> Maybe [T.Text] -> [T.Text]
 constructNewImportSuggestions exportsMap thingMissing notTheseModules = nubOrd
   [ suggestion
-  | (identInfo, m) <- fromMaybe [] $ Map.lookup name exportsMap
+  | (identInfo, m) <- maybe [] Set.toList $ Map.lookup name (getExportsMap exportsMap)
   , canUseIdent thingMissing identInfo
   , m `notElem` fromMaybe [] notTheseModules
   , suggestion <- renderNewImport identInfo m
diff --git a/src/Development/IDE/Types/Exports.hs b/src/Development/IDE/Types/Exports.hs
index e26489e89..5c80ef312 100644
--- a/src/Development/IDE/Types/Exports.hs
+++ b/src/Development/IDE/Types/Exports.hs
@@ -1,7 +1,9 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DerivingStrategies #-}
 module Development.IDE.Types.Exports
 (
     IdentInfo(..),
-    ExportsMap,
+    ExportsMap(..),
     createExportsMap,
 ) where
 
@@ -16,8 +18,17 @@ import Name
 import FieldLabel (flSelector)
 import qualified Data.HashMap.Strict as Map
 import GhcPlugins (IfaceExport)
+import Data.HashSet (HashSet)
+import qualified Data.HashSet as Set
+import Data.Bifunctor (Bifunctor(second))
+import Data.Hashable (Hashable)
 
-type ExportsMap = HashMap IdentifierText [(IdentInfo,ModuleNameText)]
+newtype ExportsMap = ExportsMap
+    {getExportsMap :: HashMap IdentifierText (HashSet (IdentInfo,ModuleNameText))}
+    deriving newtype (Monoid, NFData, Show)
+
+instance Semigroup ExportsMap where
+    ExportsMap a <> ExportsMap b = ExportsMap $ Map.unionWith (<>) a b
 
 type IdentifierText = Text
 type ModuleNameText = Text
@@ -29,6 +40,7 @@ data IdentInfo = IdentInfo
     , isDatacon :: !Bool
     }
     deriving (Eq, Generic, Show)
+    deriving anyclass Hashable
 
 instance NFData IdentInfo
 
@@ -51,9 +63,9 @@ mkIdentInfos (AvailTC _ nn flds)
       ]
 
 createExportsMap :: [ModIface] -> ExportsMap
-createExportsMap = Map.fromListWith (++) . concatMap doOne
+createExportsMap = ExportsMap . Map.fromListWith (<>) . concatMap doOne
   where
-    doOne mi = concatMap (unpackAvail mn) (mi_exports mi)
+    doOne mi = concatMap (fmap (second Set.fromList) . unpackAvail mn) (mi_exports mi)
       where
         mn = moduleName $ mi_module mi