Fix tests

haskell · Oct 19, 2022 · 15b21a9 · 15b21a9
1 parent 167fbc9
commit 15b21a9
Show file tree

Hide file tree

Showing 2 changed files with 6 additions and 6 deletions.
diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Types.hs b/hls-graph/src/Development/IDE/Graph/Internal/Types.hs
@@ -140,7 +140,7 @@ renderKey :: Key -> Text
 renderKey (lookupKeyValue -> KeyValue _ t) = t
 
 newtype KeySet = KeySet IntSet
-  deriving (Eq, Ord, Semigroup, Monoid)
+  deriving newtype (Eq, Ord, Semigroup, Monoid)
 
 instance Show KeySet where
   showsPrec p (KeySet is)= showParen (p > 10) $

diff --git a/hls-graph/test/ActionSpec.hs b/hls-graph/test/ActionSpec.hs
@@ -43,8 +43,8 @@ spec = do
         pure $ do
           apply1 theKey
       res `shouldBe` [True]
-      Just (Clean res) <- lookup (mkKey theKey) <$> getDatabaseValues theDb
-      resultDeps res `shouldBe` ResultDeps [Key (Rule @())]
+      Just (Clean res) <- lookup (newKey theKey) <$> getDatabaseValues theDb
+      resultDeps res `shouldBe` ResultDeps (singletonKeySet $ newKey (Rule @()))
     it "tracks reverse dependencies" $ do
       db@(ShakeDatabase _ _ Database {..}) <- shakeNewDatabase shakeOptions $ do
         ruleUnit
@@ -54,8 +54,8 @@ spec = do
         pure $ do
           apply1 theKey
       res `shouldBe` [True]
-      Just KeyDetails {..} <- atomically $ STM.lookup (Key (Rule @())) databaseValues
-      keyReverseDeps `shouldBe` HashSet.fromList [mkKey theKey]
+      Just KeyDetails {..} <- atomically $ STM.lookup (newKey (Rule @())) databaseValues
+      keyReverseDeps `shouldBe` (singletonKeySet $ newKey theKey)
     it "rethrows exceptions" $ do
       db <- shakeNewDatabase shakeOptions $ do
         addRule $ \(Rule :: Rule ()) old mode -> error "boom"
@@ -74,5 +74,5 @@ spec = do
         pure $ do
           applyWithoutDependency [theKey]
       res `shouldBe` [[True]]
-      Just (Clean res) <- lookup (Key theKey) <$> getDatabaseValues theDb
+      Just (Clean res) <- lookup (newKey theKey) <$> getDatabaseValues theDb
       resultDeps res `shouldBe` UnknownDeps