From 55f278853ab1699060770d5bfdc3790add562144 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= <dxld@darkboxed.org>
Date: Mon, 14 Sep 2015 07:11:45 +0200
Subject: [PATCH] Fix tests more

---
 Language/Haskell/GhcMod/Cradle.hs | 15 ++++++++++++++-
 Language/Haskell/GhcMod/Monad.hs  | 11 ++++++++---
 2 files changed, 22 insertions(+), 4 deletions(-)

diff --git a/Language/Haskell/GhcMod/Cradle.hs b/Language/Haskell/GhcMod/Cradle.hs
index 5bd5c99..c294d11 100644
--- a/Language/Haskell/GhcMod/Cradle.hs
+++ b/Language/Haskell/GhcMod/Cradle.hs
@@ -43,7 +43,7 @@ findCradle' dir = run $
 
 findSpecCradle :: (IOish m, GmOut m) => FilePath -> m Cradle
 findSpecCradle dir = do
-    let cfs = [stackCradle, cabalCradle, sandboxCradle]
+    let cfs = [stackCradleSpec, cabalCradle, sandboxCradle]
     cs <- catMaybes <$> mapM (runMaybeT . ($ dir)) cfs
     gcs <- filterM isNotGmCradle cs
     fillTempDir =<< case gcs of
@@ -99,6 +99,19 @@ stackCradle wdir = do
       , cradleDistDir    = seDistDir senv
       }
 
+stackCradleSpec :: (IOish m, GmOut m) => FilePath -> MaybeT m Cradle
+stackCradleSpec wdir = do
+  crdl <- stackCradle wdir
+  case crdl of
+    Cradle { cradleProject = StackProject StackEnv { seDistDir } } -> do
+      b <- isGmDistDir seDistDir
+      when b mzero
+      return crdl
+    _ -> error "stackCradleSpec"
+ where
+   isGmDistDir dir =
+       liftIO $ not <$> doesFileExist (dir </> ".." </> "ghc-mod.cabal")
+
 sandboxCradle :: IOish m => FilePath -> MaybeT m Cradle
 sandboxCradle wdir = do
     sbDir <- MaybeT $ liftIO $ findCabalSandboxDir wdir
diff --git a/Language/Haskell/GhcMod/Monad.hs b/Language/Haskell/GhcMod/Monad.hs
index 7fe5a33..62f872c 100644
--- a/Language/Haskell/GhcMod/Monad.hs
+++ b/Language/Haskell/GhcMod/Monad.hs
@@ -69,9 +69,14 @@ withGhcModEnv' withCradle dir opts f =
        c <- gmoChan <$> gmoAsk
        gbracket_ (liftIO $ forkIO $ stdoutGateway c) (liftIO . killThread) a
 
-   withCradleRootDir (cradleRootDir -> projdir) =
-       gbracket_ (liftIO $ setCurrentDirectory projdir >> getCurrentDirectory)
-                 (liftIO . setCurrentDirectory)
+   withCradleRootDir (cradleRootDir -> projdir) a =
+       gbracket_ (liftIO $ swapCurrentDirectory projdir)
+                 (liftIO . setCurrentDirectory) a
+
+   swapCurrentDirectory ndir = do
+     odir <- canonicalizePath =<< getCurrentDirectory
+     setCurrentDirectory ndir
+     return odir
 
    gbracket_ ma mb mc = gbracket ma mb (const mc)