Use existence of cabal/stack as cradle indicator

Also add some more "info" logging for which cradle was picked.

Language/Haskell/GhcMod/Cradle.hs

@@ -34,24 +34,29 @@ import Control.Monad.Trans.Journal (runJournalT)
 --   Find a cabal file by tracing ancestor directories.
 --   Find a sandbox according to a cabal sandbox config
 --   in a cabal directory.
-findCradle :: (GmLog m, IOish m, GmOut m) => m Cradle
-findCradle = findCradle' =<< liftIO getCurrentDirectory
+findCradle :: (GmLog m, IOish m, GmOut m) => Programs -> m Cradle
+findCradle progs = findCradle' progs =<< liftIO getCurrentDirectory
 
-findCradleNoLog  :: forall m. (IOish m, GmOut m) => m Cradle
-findCradleNoLog = fst <$> (runJournalT findCradle :: m (Cradle, GhcModLog))
+findCradleNoLog  :: forall m. (IOish m, GmOut m) => Programs -> m Cradle
+findCradleNoLog progs =
+    fst <$> (runJournalT (findCradle progs) :: m (Cradle, GhcModLog))
 
-findCradle' :: (GmLog m, IOish m, GmOut m) => FilePath -> m Cradle
-findCradle' dir = run $
-    msum [ stackCradle dir
-         , cabalCradle dir
+findCradle' :: (GmLog m, IOish m, GmOut m) => Programs -> FilePath -> m Cradle
+findCradle' Programs { stackProgram, cabalProgram } dir = run $
+    msum [ stackCradle stackProgram dir
+         , cabalCradle cabalProgram dir
          , sandboxCradle dir
          , plainCradle dir
          ]
  where run a = fillTempDir =<< (fromJustNote "findCradle'" <$> runMaybeT a)
 
-findSpecCradle :: (GmLog m, IOish m, GmOut m) => FilePath -> m Cradle
-findSpecCradle dir = do
-    let cfs = [stackCradleSpec, cabalCradle, sandboxCradle]
+findSpecCradle ::
+    (GmLog m, IOish m, GmOut m) => Programs -> FilePath -> m Cradle
+findSpecCradle Programs { stackProgram, cabalProgram } dir = do
+    let cfs = [ stackCradleSpec stackProgram
+              , cabalCradle cabalProgram
+              , sandboxCradle
+              ]
     cs <- catMaybes <$> mapM (runMaybeT . ($ dir)) cfs
     gcs <- filterM isNotGmCradle cs
     fillTempDir =<< case gcs of
@@ -69,16 +74,18 @@ fillTempDir crdl = do
   tmpDir <- liftIO $ newTempDir (cradleRootDir crdl)
   return crdl { cradleTempDir = tmpDir }
 
-cabalCradle :: (IOish m, GmLog m, GmOut m) => FilePath -> MaybeT m Cradle
-cabalCradle wdir = do
-    cabalFile <- MaybeT $ liftIO $ findCabalFile wdir
-    let cabalDir = takeDirectory cabalFile
-
+cabalCradle ::
+    (IOish m, GmLog m, GmOut m) => FilePath -> FilePath -> MaybeT m Cradle
+cabalCradle cabalProg wdir = do
     -- If cabal doesn't exist the user probably wants to use something else
-    whenM ((==Nothing) <$> liftIO (findExecutable "cabal")) $ do
+    whenM ((==Nothing) <$> liftIO (findExecutable cabalProg)) $ do
       gmLog GmInfo "" $ text "'dist/setup-config' exists but 'cabal' executable wasn't found"
       mzero
 
+    cabalFile <- MaybeT $ liftIO $ findCabalFile wdir
+    let cabalDir = takeDirectory cabalFile
+
+    gmLog GmInfo "" $ text "found Cabal project at" <+>: text cabalDir
     return Cradle {
         cradleProject    = CabalProject
       , cradleCurrentDir = wdir
@@ -88,12 +95,19 @@ cabalCradle wdir = do
       , cradleDistDir    = "dist"
       }
 
-stackCradle :: (GmLog m, IOish m, GmOut m) => FilePath -> MaybeT m Cradle
-stackCradle wdir = do
+stackCradle ::
+    (IOish m, GmLog m, GmOut m) => FilePath -> FilePath -> MaybeT m Cradle
+stackCradle stackProg wdir = do
 #if !MIN_VERSION_ghc(7,8,0)
     -- GHC < 7.8 is not supported by stack
     mzero
 #endif
+
+    -- If cabal doesn't exist the user probably wants to use something else
+    whenM ((==Nothing) <$> liftIO (findExecutable stackProg)) $ do
+      gmLog GmInfo "" $ text "'dist/setup-config' exists but 'cabal' executable wasn't found"
+      mzero
+
     cabalFile <- MaybeT $ liftIO $ findCabalFile wdir
 
     let cabalDir = takeDirectory cabalFile
@@ -103,11 +117,12 @@ stackCradle wdir = do
     -- If dist/setup-config already exists the user probably wants to use cabal
     -- rather than stack, or maybe that's just me ;)
     whenM (liftIO $ doesFileExist $ cabalDir </> setupConfigPath "dist") $ do
-      gmLog GmWarning "" $ text "'dist/setup-config' exists, ignoring Stack and using cabal-install instead."
+      gmLog GmWarning "" $ text "'dist/setup-config' exists, ignoring Stack and using cabal-install instead"
       mzero
 
     senv <- MaybeT $ getStackEnv cabalDir
 
+    gmLog GmInfo "" $ text "found Stack project at" <+>: text cabalDir
     return Cradle {
         cradleProject    = StackProject senv
       , cradleCurrentDir = wdir
@@ -117,9 +132,10 @@ stackCradle wdir = do
       , cradleDistDir    = seDistDir senv
       }
 
-stackCradleSpec :: (GmLog m, IOish m, GmOut m) => FilePath -> MaybeT m Cradle
-stackCradleSpec wdir = do
-  crdl <- stackCradle wdir
+stackCradleSpec ::
+    (IOish m, GmLog m, GmOut m) => FilePath -> FilePath -> MaybeT m Cradle
+stackCradleSpec stackProg wdir = do
+  crdl <- stackCradle stackProg wdir
   case crdl of
     Cradle { cradleProject = StackProject StackEnv { seDistDir } } -> do
       b <- isGmDistDir seDistDir
@@ -130,9 +146,10 @@ stackCradleSpec wdir = do
    isGmDistDir dir =
        liftIO $ not <$> doesFileExist (dir </> ".." </> "ghc-mod.cabal")
 
-sandboxCradle :: IOish m => FilePath -> MaybeT m Cradle
+sandboxCradle :: (IOish m, GmLog m, GmOut m) => FilePath -> MaybeT m Cradle
 sandboxCradle wdir = do
     sbDir <- MaybeT $ liftIO $ findCabalSandboxDir wdir
+    gmLog GmInfo "" $ text "Found sandbox project at" <+>: text sbDir
     return Cradle {
         cradleProject    = SandboxProject
       , cradleCurrentDir = wdir
@@ -142,8 +159,9 @@ sandboxCradle wdir = do
       , cradleDistDir    = "dist"
       }
 
-plainCradle :: IOish m => FilePath -> MaybeT m Cradle
+plainCradle :: (IOish m, GmLog m, GmOut m) => FilePath -> MaybeT m Cradle
 plainCradle wdir = do
+    gmLog GmInfo "" $ text "Found no other project type, falling back to plain GHC project"
     return $ Cradle {
         cradleProject    = PlainProject
       , cradleCurrentDir = wdir

Language/Haskell/GhcMod/Debug.hs

@@ -3,7 +3,6 @@ module Language.Haskell.GhcMod.Debug (debugInfo, rootInfo, componentInfo) where
 import Control.Arrow (first)
 import Control.Applicative
 import Control.Monad
-import Control.Monad.Trans.Journal
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 import Data.Char
@@ -167,5 +166,7 @@ mapDoc kd ad m = vcat $
 ----------------------------------------------------------------
 
 -- | Obtaining root information.
-rootInfo :: forall m. (IOish m, GmOut m) => m String
-rootInfo = (++"\n") . cradleRootDir <$> fst `liftM` (runJournalT findCradle :: m (Cradle, GhcModLog))
+rootInfo :: forall m. (IOish m, GmOut m, GmEnv m) => m String
+rootInfo = do
+    crdl <- findCradleNoLog =<< (optPrograms <$> options)
+    return $ cradleRootDir crdl ++ "\n"

Language/Haskell/GhcMod/Monad.hs

@@ -53,11 +53,17 @@ import System.Directory
 import System.IO.Unsafe
 import Prelude
 
-withGhcModEnv :: (IOish m, GmOut m) => FilePath -> Options -> ((GhcModEnv, GhcModLog)  -> m a) -> m a
-withGhcModEnv = withGhcModEnv' withCradle
+withGhcModEnv :: (IOish m, GmOut m) => FilePath -> Options -> ((GhcModEnv, GhcModLog) -> m a) -> m a
+withGhcModEnv dir opts f = withGhcModEnv' withCradle dir opts f
  where
-   withCradle dir =
-       gbracket (runJournalT $ findCradle' dir) (liftIO . cleanupCradle . fst)
+   withCradle dir' =
+       gbracket
+         (runJournalT $ do
+            gmSetLogLevel $ ooptLogLevel $ optOutput opts
+            findCradle' (optPrograms opts) dir')
+         (liftIO . cleanupCradle . fst)
+
+
 
 cwdLock :: MVar ThreadId
 cwdLock = unsafePerformIO $ newEmptyMVar