Add newGhcModEnv for allowing multiple active sessions

Conflicts:
	Language/Haskell/GhcMod/Monad.hs

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

@@ -9,6 +9,7 @@ module Language.Haskell.GhcMod.Monad (
  , GhcModState(..)
  , runGhcMod'
  , runGhcMod
+ , newGhcModEnv
  , withErrorHandler
  , toGhcMod
  , options
@@ -53,6 +54,7 @@ import Control.Monad.Writer.Class
 import Data.IORef (IORef, readIORef, writeIORef, newIORef)
 import System.Exit (exitSuccess)
 import System.IO (hPutStr, hPrint, stderr)
+import System.Directory (getCurrentDirectory)
 
 ----------------------------------------------------------------
 
@@ -98,18 +100,23 @@ 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