Make sure stdoutGateway is running during findCradle'

Language/Haskell/GhcMod/Monad.hs

@@ -26,7 +26,6 @@ module Language.Haskell.GhcMod.Monad (
   , runGmlTWith
   , runGmPkgGhc
   , withGhcModEnv
-  , withGhcModEnv'
   , module Language.Haskell.GhcMod.Monad.Types
   ) where
 
@@ -52,28 +51,23 @@ import Exception (ExceptionMonad(..))
 import System.Directory
 import Prelude
 
-withCradle :: (IOish m, GmOut m) => FilePath -> (Cradle -> m a) -> m a
-withCradle cradledir f =
-    gbracket (findCradle' cradledir) (liftIO . cleanupCradle) f
-
 withGhcModEnv :: (IOish m, GmOut m) => FilePath -> Options -> (GhcModEnv -> m a) -> m a
 withGhcModEnv dir opts f =
-    withCradle dir (withGhcModEnv' opts f)
+    withStdoutGateway $
-
+      withCradle $ \crdl ->
-withGhcModEnv' :: (IOish m, GmOut m) => Options -> (GhcModEnv -> m a) -> Cradle -> m a
+        withCradleRootDir crdl $
-withGhcModEnv' opts f crdl = do
+          f $ GhcModEnv opts crdl
-    olddir <- liftIO getCurrentDirectory
-    gbracket_ setup (teardown olddir) (f $ GhcModEnv opts crdl)
  where
-   setup = do
+   withStdoutGateway a = do
-     c <- gmoChan <$> gmoAsk
+       c <- gmoChan <$> gmoAsk
-     liftIO $ do
+       gbracket_ (liftIO $ forkIO $ stdoutGateway c) (liftIO . killThread) a
-       setCurrentDirectory $ cradleRootDir crdl
-       forkIO $ stdoutGateway c
 
-   teardown olddir tid = liftIO $ do
+   withCradle =
-     setCurrentDirectory olddir
+       gbracket (findCradle' dir) (liftIO . cleanupCradle)
-     killThread tid
+
+   withCradleRootDir (cradleRootDir -> projdir) =
+       gbracket_ (liftIO $ setCurrentDirectory projdir >> getCurrentDirectory)
+                 (liftIO . setCurrentDirectory)
 
    gbracket_ ma mb mc = gbracket ma mb (const mc)