Merge experiments onto main 2025-06-07

ghc-worker/ghc-worker.cabal

@@ -30,7 +30,7 @@ library
   ghc-options: -O2
   hs-source-dirs: lib
   exposed-modules:
-    GhcWorker.BuckArgs
+    GhcWorker.CompileResult
     GhcWorker.GhcHandler
     GhcWorker.Grpc
     GhcWorker.Instrumentation

ghc-worker/lib/GhcWorker/BuckArgs.hs → ghc-worker/lib/GhcWorker/CompileResult.hs

@@ -1,4 +1,4 @@
-module GhcWorker.BuckArgs where
+module GhcWorker.CompileResult where
 
 import Data.Foldable (for_)
 import Data.Int (Int32)

ghc-worker/lib/GhcWorker/GhcHandler.hs

@@ -12,7 +12,7 @@ import GHC (DynFlags (..), Ghc, getSession)
 import GHC.Driver.DynFlags (GhcMode (..))
 import GHC.Driver.Env (hscUpdateFlags)
 import GHC.Driver.Monad (modifySession)
-import GhcWorker.BuckArgs (CompileResult (..), writeCloseOutput, writeResult)
+import GhcWorker.CompileResult (CompileResult (..), writeCloseOutput, writeResult)
 import GhcWorker.Instrumentation (Hooks (..), InstrumentedHandler (..))
 import Internal.AbiHash (AbiHash (..), showAbiHash)
 import Internal.Cache (Cache (..), ModuleArtifacts (..), Target (..))
@@ -23,7 +23,6 @@ import Internal.Metadata (computeMetadata)
 import Internal.Session (Env (..), withGhc, withGhcMhu)
 import Prelude hiding (log)
 import System.Exit (ExitCode (ExitSuccess))
-import System.FilePath (takeBaseName)
 import System.Posix.Process (exitImmediately)
 import Types.BuckArgs (BuckArgs, Mode (..), parseBuckArgs, toGhcArgs)
 import qualified Types.BuckArgs

ghc-worker/test/CompileHptTest.hs

@@ -135,7 +135,7 @@ stepCompile Conf {cache, tmp, args0} Module {unit, src} = do
     dbg (">>> compiling " ++ takeFileName target.get)
     modifySession $ hscUpdateFlags \ d -> d {ghcMode = CompManager}
     cache' <- liftIO $ readMVar env.cache
-    compileModuleWithDepsInHpt cache'.counter target
+    compileModuleWithDepsInHpt target
   when (isNothing result) do
       liftIO $ throwGhcExceptionIO (ProgramError "Compile failed")
   dbgs result

ghc-worker/test/TestSetup.hs

@@ -9,7 +9,7 @@ import GHC.Unit (UnitId, stringToUnitId, unitIdString)
 import Internal.Cache (Cache (..), CacheFeatures (..), emptyCacheWith)
 import Internal.Log (dbg)
 import Prelude hiding (log)
-import System.Directory (createDirectoryIfMissing, listDirectory)
+import System.Directory (createDirectoryIfMissing, listDirectory, withCurrentDirectory)
 import System.Environment (getEnv)
 import System.FilePath ((<.>), (</>))
 import System.IO.Temp (withSystemTempDirectory)

instrument/Main.hs

@@ -22,6 +22,8 @@ import System.Directory (doesPathExist, getModificationTime, listDirectory)
 import System.Environment (lookupEnv)
 import System.FSNotify (Event(..), watchTree, withManager)
 import UI qualified
+import UI.SessionSelector qualified as SS
+import UI.Session qualified as Session
 
 newtype WorkerPath
   = WorkerPath {path :: FilePath}
@@ -35,7 +37,7 @@ listen eventChan instrPath = do
   void $ forkIO $ go 5
  where
   go :: Int -> IO ()
-  go 0 = getCurrentTime >>= writeBChan eventChan . UI.SessionEvent instrPath . UI.EndSession
+  go 0 = getCurrentTime >>= writeBChan eventChan . UI.SessionSelectorEvent . SS.EndSession instrPath
   go n =
     catch @SomeException
       ( withConnection def (ServerUnix instrPath) $ \conn -> do
@@ -45,8 +47,9 @@ listen eventChan instrPath = do
                     mkOptions options
           serverStreaming conn (rpc @(Protobuf Instrument "notifyMe")) defMessage $ \recv -> do
             time <- getModificationTime instrPath
-            writeBChan eventChan $ UI.SessionEvent instrPath $ UI.StartSession time sendOptions
-            whileNext_ recv $ writeBChan eventChan . UI.SessionEvent instrPath . UI.InstrEvent
+            writeBChan eventChan $ UI.SessionSelectorEvent $ SS.StartSession instrPath time sendOptions
+            writeBChan eventChan UI.SendOptions
+            whileNext_ recv $ writeBChan eventChan . UI.SessionSelectorEvent . SS.SessionEvent instrPath . Session.InstrEvent
       )
       (const $ threadDelay 100_000 >> go (n - 1))
   mkOptions :: Options -> Proto Instr.Options