Trace more Shake evaluation details

pepeiborra · May 16, 2021 · 4807d7a · 4807d7a
1 parent 5b5cece
commit 4807d7a
Show file tree

Hide file tree

Showing 2 changed files with 18 additions and 12 deletions.
diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs
@@ -864,9 +864,9 @@ defineEarlyCutoff
     :: IdeRule k v
     => RuleBody k v
     -> Rules ()
-defineEarlyCutoff (Rule op) = addRule $ \(Q (key, file)) (old :: Maybe BS.ByteString) mode -> otTracedAction key file isSuccess $ do
+defineEarlyCutoff (Rule op) = addRule $ \(Q (key, file)) (old :: Maybe BS.ByteString) mode -> otTracedAction key file mode isSuccess $ do
     defineEarlyCutoff' True key file old mode $ op key file
-defineEarlyCutoff (RuleNoDiagnostics op) = addRule $ \(Q (key, file)) (old :: Maybe BS.ByteString) mode -> otTracedAction key file isSuccess $ do
+defineEarlyCutoff (RuleNoDiagnostics op) = addRule $ \(Q (key, file)) (old :: Maybe BS.ByteString) mode -> otTracedAction key file mode isSuccess $ do
     defineEarlyCutoff' False key file old mode $ second (mempty,) <$> op key file
 
 defineNoFile :: IdeRule k v => (k -> Action v) -> Rules ()
@@ -941,9 +941,9 @@ defineEarlyCutoff' doDiagnostics key file old mode action = do
         liftIO $ atomicModifyIORef'_ dirtyKeys (HSet.delete $ toKey key file)
         return res
 
-isSuccess :: RunResult (A v) -> Bool
-isSuccess (RunResult _ _ (A Failed{})) = False
-isSuccess _                            = True
+isSuccess :: A v -> Bool
+isSuccess (A Failed{}) = False
+isSuccess _            = True
 
 -- | Rule type, input file
 data QDisk k = QDisk k NormalizedFilePath

diff --git a/ghcide/src/Development/IDE/Core/Tracing.hs b/ghcide/src/Development/IDE/Core/Tracing.hs
@@ -1,5 +1,5 @@
+{-# LANGUAGE CPP             #-}
 {-# LANGUAGE NoApplicativeDo #-}
-{-# LANGUAGE CPP #-}
 module Development.IDE.Core.Tracing
     ( otTracedHandler
     , otTracedAction
@@ -32,12 +32,13 @@ import           Debug.Trace.Flags              (userTracingEnabled)
 import           Development.IDE.Core.RuleTypes (GhcSession (GhcSession),
                                                  GhcSessionDeps (GhcSessionDeps),
                                                  GhcSessionIO (GhcSessionIO))
+import           Development.IDE.Graph          (Action, actionBracket)
+import           Development.IDE.Graph.Rule
 import           Development.IDE.Types.Location (Uri (..))
 import           Development.IDE.Types.Logger   (Logger, logDebug, logInfo)
 import           Development.IDE.Types.Shake    (Key (..), Value,
                                                  ValueWithDiagnostics (..),
                                                  Values)
-import           Development.IDE.Graph              (Action, actionBracket)
 import           Foreign.Storable               (Storable (sizeOf))
 import           HeapSize                       (recursiveSize, runHeapsize)
 import           Ide.PluginUtils                (installSigUsr1Handler)
@@ -77,21 +78,26 @@ otTracedAction
     :: Show k
     => k -- ^ The Action's Key
     -> NormalizedFilePath -- ^ Path to the file the action was run for
-    -> (a -> Bool) -- ^ Did this action succeed?
-    -> Action a -- ^ The action
-    -> Action a
-otTracedAction key file success act
+    -> RunMode
+    -> (a -> Bool)
+    -> Action (RunResult a) -- ^ The action
+    -> Action (RunResult a)
+otTracedAction key file mode success act
   | userTracingEnabled =
     actionBracket
         (do
             sp <- beginSpan (fromString (show key))
             setTag sp "File" (fromString $ fromNormalizedFilePath file)
+            setTag sp "Mode" (fromString $ show mode)
             return sp
         )
         endSpan
         (\sp -> do
             res <- act
-            unless (success res) $ setTag sp "error" "1"
+            unless (success $ runValue res) $ setTag sp "error" "1"
+            setTag sp "changed" $ case res of
+              RunResult ChangedRecomputeSame _ _ -> "0"
+              _                                  -> "1"
             return res)
   | otherwise = act