Rebase on mpickering ghcide at wip/multi-rebase

Commit 256f8b50415a08454d471a6a28f742c0a1e39978

Author: alanz

exe/Arguments.hs

@@ -36,7 +36,7 @@ data Arguments = Arguments
     -- them to just change the name of the exe and still work.
     , argsDebugOn       :: Bool
     , argsLogFile       :: Maybe String
-    , argsThread        :: Int
+    , argsThreads       :: Int
     } deriving Show
 
 getArguments :: String -> IO Arguments

exe/Main.hs

@@ -13,6 +13,7 @@
 module Main(main) where
 
 import Arguments
+import Control.Concurrent.Async
 import Control.Concurrent.Extra
 import Control.Exception
 import Control.Monad.Extra
@@ -190,8 +191,8 @@ main = do
                     { optReportProgress = clientSupportsProgress caps
                     , optShakeProfiling = argsShakeProfiling
                     , optTesting        = argsTesting
+                    , optThreads        = argsThreads
                     , optInterfaceLoadingDiagnostics = argsTesting
-                    , optThreads = argsThread
                     }
             debouncer <- newAsyncDebouncer
             initialise caps (mainRule >> pluginRules plugins >> action kick)
@@ -408,7 +409,6 @@ loadSession dir = liftIO $ do
         return res
 
     lock <- newLock
-    cradle_lock <- newLock
 
     -- This caches the mapping from hie.yaml + Mod.hs -> [String]
     sessionOpts <- return $ \(hieYaml, file) -> do
@@ -435,17 +435,39 @@ loadSession dir = liftIO $ do
                 finished_barrier <- newBarrier
                 -- fork a new thread here which won't be killed by shake
                 -- throwing an async exception
-                void $ forkIO $ withLock cradle_lock $ do
-                  putStrLn $ "Shelling out to cabal " <> show file
+                void $ forkIO $ do
+                  putStrLn $ "Consulting the cradle for " <> show file
                   cradle <- maybe (loadImplicitCradle $ addTrailingPathSeparator dir) loadCradle hieYaml
                   opts <- cradleToSessionOpts cradle cfp
                   print opts
                   res <- fst <$> session (hieYaml, toNormalizedFilePath' cfp, opts)
                   signalBarrier finished_barrier res
                 waitBarrier finished_barrier
-    return $ \file -> liftIO $ mask_ $ withLock lock $ do
-              hieYaml <- cradleLoc file
-              sessionOpts (hieYaml, file)
+
+    dummyAs <- async $ return (error "Uninitialised")
+    runningCradle <- newIORef dummyAs
+    -- The main function which gets options for a file. We only want one of these running
+    -- at a time.
+    let getOptions file = do
+            hieYaml <- cradleLoc file
+            sessionOpts (hieYaml, file)
+    -- The lock is on the `runningCradle` resource
+    return $ \file -> liftIO $ withLock lock $ do
+        as <- readIORef runningCradle
+        finished <- poll as
+        case finished of
+            Just {} -> do
+                as <- async $ getOptions file
+                writeIORef runningCradle as
+                wait as
+             -- If it's not finished then wait and then get options, this could of course be killed still
+            Nothing -> do
+                _ <- wait as
+                getOptions file
+
+
+
+
 
 checkDependencyInfo :: Map.Map FilePath (Maybe UTCTime) -> IO Bool
 checkDependencyInfo old_di = do

ghcide

@@ -133,6 +133,7 @@ executable haskell-language-server
   build-depends:
       base >=4.7 && <5
     , aeson
+    , async
     , base16-bytestring
     , binary
     , bytestring