[fix] don't store thunk for shown key when the Show dict is in the existential anyway

Author: MangoIV

hls-graph/src/Development/IDE/Graph/Internal/Key.hs

@@ -52,17 +52,17 @@ import           System.IO.Unsafe
 newtype Key = UnsafeMkKey Int
 
 pattern Key :: () => (Typeable a, Hashable a, Show a) => a -> Key
-pattern Key a <- (lookupKeyValue -> KeyValue a _)
+pattern Key a <- (lookupKeyValue -> KeyValue a)
 {-# COMPLETE Key #-}
 
-data KeyValue = forall a . (Typeable a, Hashable a, Show a) => KeyValue a Text
+data KeyValue = forall a . (Typeable a, Hashable a, Show a) => KeyValue a
 
 instance Eq KeyValue where
-    KeyValue a _ == KeyValue b _ = Just a == cast b
+    KeyValue a == KeyValue b = Just a == cast b
 instance Hashable KeyValue where
-    hashWithSalt i (KeyValue x _) = hashWithSalt i (typeOf x, x)
+    hashWithSalt i (KeyValue x) = hashWithSalt i (typeOf x, x)
 instance Show KeyValue where
-    show (KeyValue _ t) = T.unpack t
+    show (KeyValue k) = show k
 
 data GlobalKeyValueMap = GlobalKeyValueMap !(Map.HashMap KeyValue Key) !(IntMap KeyValue) {-# UNPACK #-} !Int
 
@@ -73,7 +73,7 @@ keyMap = unsafePerformIO $ newIORef (GlobalKeyValueMap Map.empty IM.empty 0)
 
 newKey :: (Typeable a, Hashable a, Show a) => a -> Key
 newKey k = unsafePerformIO $ do
-  let !newKey = KeyValue k (T.pack (show k))
+  let !newKey = KeyValue k
   atomicModifyIORef' keyMap $ \km@(GlobalKeyValueMap hm im n) ->
     let new_key = Map.lookup newKey hm
     in case new_key of
@@ -98,7 +98,7 @@ instance Show Key where
   show (Key x) = show x
 
 renderKey :: Key -> Text
-renderKey (lookupKeyValue -> KeyValue _ t) = t
+renderKey (lookupKeyValue -> KeyValue k) = T.pack (show k)
 
 newtype KeySet = KeySet IntSet
   deriving newtype (Eq, Ord, Semigroup, Monoid, NFData)