fix 9.2.8

Author: soulomoon

ghcide/src/Development/IDE/Core/Shake.hs

@@ -1200,7 +1200,7 @@ defineEarlyCutoff' doDiagnostics cmp key file mbOld mode action = do
                     Just (v@(Succeeded _ x), diags) -> do
                         ver <- estimateFileVersionUnsafely key (Just x) file
                         doDiagnostics (vfsVersion =<< ver) $ Vector.toList diags
-                        return $ Just $ RunResult ChangedNothing old (A v) mempty
+                        return $ Just $ RunResult ChangedNothing old (A v) $ return ()
                     _ -> return Nothing
             _ ->
                 -- assert that a "clean" rule is never a cache miss

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

@@ -204,7 +204,7 @@ data RunResult value = RunResult
     ,runValue   :: value
         -- ^ The value to return from 'Development.Shake.Rule.apply'.
     ,runHook    :: STM ()
-        -- ^ The value to return from 'Development.Shake.Rule.apply'.
+        -- ^ The hook to run after the rule completes.
     } deriving Functor
 
 ---------------------------------------------------------------------

hls-graph/test/ActionSpec.hs

@@ -87,7 +87,7 @@ spec = do
         ruleUnit
         addRule $ \Rule _old _mode -> do
             [()] <- applyWithoutDependency [Rule]
-            return $ RunResult ChangedRecomputeDiff "" True mempty
+            return $ RunResult ChangedRecomputeDiff "" True $ return ()
 
       let theKey = Rule @Bool
       res <- shakeRunDatabase db $

hls-graph/test/DatabaseSpec.hs

@@ -20,6 +20,6 @@ spec = do
                 ruleBool
                 addRule $ \Rule _old _mode -> do
                     True <- apply1 (Rule @Bool)
-                    return $ RunResult ChangedRecomputeDiff "" () mempty
+                    return $ RunResult ChangedRecomputeDiff "" () (return ())
             let res = shakeRunDatabase db $ pure $ apply1 (Rule @())
             timeout 1 res `shouldThrow` \StackException{} -> True

hls-graph/test/Example.hs

@@ -22,13 +22,13 @@ type instance RuleResult (Rule a) = a
 
 ruleUnit :: Rules ()
 ruleUnit = addRule $ \(Rule :: Rule ()) _old _mode -> do
-    return $ RunResult ChangedRecomputeDiff "" () mempty
+    return $ RunResult ChangedRecomputeDiff "" () (return ())
 
 -- | Depends on Rule @()
 ruleBool :: Rules ()
 ruleBool = addRule $ \Rule _old _mode -> do
     () <- apply1 Rule
-    return $ RunResult ChangedRecomputeDiff "" True mempty
+    return $ RunResult ChangedRecomputeDiff "" True (return ())
 
 
 data CondRule = CondRule
@@ -39,7 +39,7 @@ type instance RuleResult CondRule = Bool
 ruleCond :: C.MVar Bool -> Rules ()
 ruleCond mv = addRule $ \CondRule _old _mode -> do
     r <- liftIO $ C.modifyMVar mv $ \x -> return (not x, x)
-    return $ RunResult ChangedRecomputeDiff "" r mempty
+    return $ RunResult ChangedRecomputeDiff "" r (return ())
 
 data BranchedRule = BranchedRule
     deriving (Eq, Generic, Hashable, NFData, Show, Typeable)
@@ -50,9 +50,9 @@ ruleWithCond = addRule $ \BranchedRule _old _mode -> do
     r <- apply1 CondRule
     if r then do
             _ <- apply1 SubBranchRule
-            return $ RunResult ChangedRecomputeDiff "" (1 :: Int) mempty
+            return $ RunResult ChangedRecomputeDiff "" (1 :: Int) (return ())
          else
-            return $ RunResult ChangedRecomputeDiff "" (2 :: Int) mempty
+            return $ RunResult ChangedRecomputeDiff "" (2 :: Int) (return ())
 
 data SubBranchRule = SubBranchRule
     deriving (Eq, Generic, Hashable, NFData, Show, Typeable)
@@ -61,4 +61,4 @@ type instance RuleResult SubBranchRule = Int
 ruleSubBranch :: C.MVar Int -> Rules ()
 ruleSubBranch mv = addRule $ \SubBranchRule _old _mode -> do
     r <- liftIO $ C.modifyMVar mv $ \x -> return (x+1, x)
-    return $ RunResult ChangedRecomputeDiff "" r mempty
+    return $ RunResult ChangedRecomputeDiff "" r (return ())