Add newGhcModEnv for allowing multiple active sessions

Language/Haskell/GhcMod/Cradle.hs

@@ -1,5 +1,6 @@
 module Language.Haskell.GhcMod.Cradle (
     findCradle
+  , findCradle'
   , findCradleWithoutSandbox
   ) where
 
@@ -22,8 +23,10 @@ import System.FilePath ((</>), takeDirectory)
 --   in a cabal directory.
 findCradle :: IO Cradle
 findCradle = do
-    wdir <- getCurrentDirectory
-    cabalCradle wdir ||> sandboxCradle wdir ||> plainCradle wdir
+    findCradle' =<< getCurrentDirectory
+
+findCradle' :: FilePath -> IO Cradle
+findCradle' dir = cabalCradle dir ||> sandboxCradle dir ||> plainCradle dir
 
 cabalCradle :: FilePath -> IO Cradle
 cabalCradle wdir = do

Language/Haskell/GhcMod/Monad.hs

@@ -7,6 +7,7 @@ module Language.Haskell.GhcMod.Monad (
  , GhcModState(..)
  , runGhcMod'
  , runGhcMod
+ , newGhcModEnv
  , withErrorHandler
  , toGhcMod
  , options
@@ -58,6 +59,7 @@ import Control.Monad.State.Class
 
 import System.IO (hPutStr, hPrint, stderr)
 import System.Exit (exitSuccess)
+import System.Directory (getCurrentDirectory)
 
 
 data GhcModEnv = GhcModEnv {
@@ -97,21 +99,27 @@ runGhcMod' r s a = do
   (a', s',w) <- runRWST (unGhcMod $ initGhcMonad (Just libdir) >> a) r s
   return (a',(s',w))
 
+newGhcModEnv :: Options -> FilePath -> IO GhcModEnv
+newGhcModEnv opt dir = do
+      session <- newIORef (error "empty session")
+      cradle <- findCradle' dir
+      return GhcModEnv {
+          gmGhcSession = session
+        , gmOptions = opt
+        , gmCradle = cradle
+        }
 
 runGhcMod :: Options -> GhcMod a -> IO a
 runGhcMod opt action = do
-    session <- newIORef (error "empty session")
-    cradle <- findCradle
-    let env = GhcModEnv { gmGhcSession = session
-                        , gmOptions = opt
-                        , gmCradle = cradle }
+    env <- liftIO $ newGhcModEnv opt =<< getCurrentDirectory
     (a,(_,_)) <- runGhcMod' env defaultState $ do
         dflags <- getSessionDynFlags
         defaultCleanupHandler dflags $ do
-            toGhcMod $ initializeFlagsWithCradle opt cradle
+            toGhcMod $ initializeFlagsWithCradle opt (gmCradle env)
             action
     return a
 
+
 withErrorHandler :: String -> GhcMod a -> GhcMod a
 withErrorHandler label = ghandle ignore
   where