From dc5ba6d00d4558dfb9379524bf567085a2141e5c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= <dxld@darkboxed.org>
Date: Sun, 18 May 2014 01:32:09 +0000
Subject: [PATCH] Add newGhcModEnv for allowing multiple active sessions

Conflicts:
	Language/Haskell/GhcMod/Monad.hs
---
 Language/Haskell/GhcMod/Cradle.hs |  7 +++++--
 Language/Haskell/GhcMod/Monad.hs  | 19 +++++++++++++------
 2 files changed, 18 insertions(+), 8 deletions(-)

diff --git a/Language/Haskell/GhcMod/Cradle.hs b/Language/Haskell/GhcMod/Cradle.hs
index 1e6e594..ecfc1c8 100644
--- a/Language/Haskell/GhcMod/Cradle.hs
+++ b/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
diff --git a/Language/Haskell/GhcMod/Monad.hs b/Language/Haskell/GhcMod/Monad.hs
index 5df48c4..34f362a 100644
--- a/Language/Haskell/GhcMod/Monad.hs
+++ b/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