supporting sandbox only (without cabal) to fix #164.

Language/Haskell/GhcMod/CabalApi.hs

@@ -40,15 +40,15 @@ import System.FilePath (dropExtension, takeFileName, (</>))
 -- | Getting necessary 'CompilerOptions' from three information sources.
 getCompilerOptions :: [GHCOption] -> Cradle -> PackageDescription -> IO CompilerOptions
 getCompilerOptions ghcopts cradle pkgDesc = do
-    gopts <- getGHCOptions ghcopts cradle cdir $ head buildInfos
+    gopts <- getGHCOptions ghcopts cradle rdir $ head buildInfos
     return $ CompilerOptions gopts idirs depPkgs
   where
     wdir       = cradleCurrentDir cradle
-    Just cdir  = cradleCabalDir   cradle
+    rdir       = cradleRootDir    cradle
     Just cfile = cradleCabalFile  cradle
     pkgs       = cradlePackages   cradle
     buildInfos = cabalAllBuildInfo pkgDesc
-    idirs      = includeDirectories cdir wdir $ cabalSourceDirs buildInfos
+    idirs      = includeDirectories rdir wdir $ cabalSourceDirs buildInfos
     depPkgs    = attachPackageIds pkgs $ removeThem problematicPackages $ removeMe cfile $ cabalDependPackages buildInfos
 
 ----------------------------------------------------------------
@@ -109,8 +109,8 @@ parseCabalFile file = do
 ----------------------------------------------------------------
 
 getGHCOptions :: [GHCOption] -> Cradle -> FilePath -> BuildInfo -> IO [GHCOption]
-getGHCOptions ghcopts cradle cdir binfo = do
+getGHCOptions ghcopts cradle rdir binfo = do
-    cabalCpp <- cabalCppOptions cdir
+    cabalCpp <- cabalCppOptions rdir
     let cpps = map ("-optP" ++) $ P.cppOptions binfo ++ cabalCpp
     return $ ghcopts ++ pkgDb ++ exts ++ [lang] ++ libs ++ libDirs ++ cpps
   where

Language/Haskell/GhcMod/Cradle.hs

@@ -7,11 +7,13 @@ module Language.Haskell.GhcMod.Cradle (
   , getPackageDbPackages
   , userPackageDbOptsForGhc
   , userPackageDbOptsForGhcPkg
+  , getSandboxDir
   ) where
 
 import Control.Applicative ((<$>))
 import Control.Exception (SomeException(..))
 import qualified Control.Exception as E
+import Control.Exception.IOChoice ((||>))
 import Control.Monad (filterM)
 import Data.Char (isSpace)
 import Data.List (isPrefixOf, isSuffixOf, tails)
@@ -28,29 +30,41 @@ import System.FilePath ((</>), takeDirectory, takeFileName)
 findCradle :: IO Cradle
 findCradle = do
     wdir <- getCurrentDirectory
-    findCradle' wdir `E.catch` handler wdir
+    cabalCradle wdir ||> sandboxCradle wdir ||> plainCradle wdir
-  where
+
-    handler :: FilePath -> SomeException -> IO Cradle
+cabalCradle :: FilePath -> IO Cradle
-    handler wdir _ = return Cradle {
+cabalCradle wdir = do
+    (rdir,cfile) <- cabalDir wdir
+    pkgDbOpts <- getPackageDb rdir
+    return Cradle {
         cradleCurrentDir = wdir
-      , cradleCabalDir   = Nothing
+      , cradleRootDir    = rdir
-      , cradleCabalFile  = Nothing
+      , cradleCabalFile  = Just cfile
-      , cradlePackageDb  = Nothing
+      , cradlePackageDb  = pkgDbOpts
       , cradlePackages   = []
       }
 
-findCradle' :: FilePath -> IO Cradle
+sandboxCradle :: FilePath -> IO Cradle
-findCradle' wdir = do
+sandboxCradle wdir = do
-    (cdir,cfile) <- cabalDir wdir
+    rdir <- getSandboxDir wdir
-    pkgDbOpts <- getPackageDb cdir
+    pkgDbOpts <- getPackageDb rdir
     return Cradle {
         cradleCurrentDir = wdir
-      , cradleCabalDir   = Just cdir
+      , cradleRootDir    = rdir
-      , cradleCabalFile  = Just cfile
+      , cradleCabalFile  = Nothing
       , cradlePackageDb  = pkgDbOpts
       , cradlePackages   = []
       }
 
+plainCradle :: FilePath -> IO Cradle
+plainCradle wdir = return Cradle {
+        cradleCurrentDir = wdir
+      , cradleRootDir    = wdir
+      , cradleCabalFile  = Nothing
+      , cradlePackageDb  = Nothing
+      , cradlePackages   = []
+      }
+
 -- Just for testing
 findCradleWithoutSandbox :: IO Cradle
 findCradleWithoutSandbox = do
@@ -203,3 +217,16 @@ nameKeyLength = length nameKey
 
 idKeyLength :: Int
 idKeyLength = length idKey
+
+getSandboxDir :: FilePath -> IO FilePath
+getSandboxDir dir = do
+    exist <- doesFileExist sfile
+    if exist then
+        return dir
+      else if dir == dir' then
+        E.throwIO $ userError "sandbox not found"
+      else
+        getSandboxDir dir'
+  where
+    sfile = dir </> configFile
+    dir' = takeDirectory dir

Language/Haskell/GhcMod/Debug.hs

@@ -44,8 +44,7 @@ debug opt cradle fileName = do
   where
     currentDir = cradleCurrentDir cradle
     mCabalFile = cradleCabalFile cradle
-    mCabalDir = cradleCabalDir cradle
+    rootDir    = cradleRootDir cradle
-    rootDir = fromMaybe currentDir mCabalDir
     cabal = isJust mCabalFile
     cabalFile = fromMaybe "" mCabalFile
     origGopts = ghcOpts opt
@@ -68,8 +67,4 @@ root :: Options
       -> Cradle
       -> FilePath     -- ^ A target file.
       -> Ghc String
-root _ cradle _ = return $ rootDir ++ "\n"
+root _ cradle _ = return $ cradleRootDir cradle ++ "\n"
-  where
-    currentDir = cradleCurrentDir cradle
-    mCabalDir = cradleCabalDir cradle
-    rootDir = fromMaybe currentDir mCabalDir

Language/Haskell/GhcMod/GHCApi.hs

@@ -21,6 +21,7 @@ import Exception (ghandle, SomeException(..))
 import GHC (Ghc, GhcMonad, DynFlags(..), GhcLink(..), HscTarget(..))
 import qualified GHC as G
 import Language.Haskell.GhcMod.CabalApi
+import Language.Haskell.GhcMod.Cradle (userPackageDbOptsForGhc)
 import Language.Haskell.GhcMod.ErrMsg
 import Language.Haskell.GhcMod.GHCChoice
 import qualified Language.Haskell.GhcMod.Gap as Gap
@@ -74,8 +75,8 @@ data Build = CabalPkg | SingleFile deriving Eq
 -- provided.
 initializeFlagsWithCradle :: GhcMonad m =>  Options -> Cradle -> [GHCOption] -> Bool -> m (LogReader, Maybe PackageDescription)
 initializeFlagsWithCradle opt cradle ghcopts logging
-  | cabal     = withCabal |||> withoutCabal
+  | cabal     = withCabal |||> withSandbox
-  | otherwise = withoutCabal
+  | otherwise = withSandbox
   where
     mCradleFile = cradleCabalFile cradle
     cabal = isJust mCradleFile
@@ -84,11 +85,16 @@ initializeFlagsWithCradle opt cradle ghcopts logging
         compOpts <- liftIO $ getCompilerOptions ghcopts cradle pkgDesc
         logger <- initSession CabalPkg opt compOpts logging
         return (logger, Just pkgDesc)
-    withoutCabal = do
+    withSandbox = do
         logger <- initSession SingleFile opt compOpts logging
         return (logger, Nothing)
       where
-        compOpts = CompilerOptions ghcopts importDirs []
+        pkgDb = userPackageDbOptsForGhc $ cradlePackageDb cradle
+        compOpts
+          | pkgDb == [] = CompilerOptions ghcopts importDirs []
+          | otherwise   = CompilerOptions (ghcopts ++ pkgDb) [wdir,rdir] []
+        wdir = cradleCurrentDir cradle
+        rdir = cradleRootDir    cradle
 
 ----------------------------------------------------------------
 

Language/Haskell/GhcMod/Types.hs

@@ -83,15 +83,15 @@ addNewLine = (++ "\n")
 -- | The environment where this library is used.
 data Cradle = Cradle {
   -- | The directory where this library is executed.
-    cradleCurrentDir  :: FilePath
+    cradleCurrentDir :: FilePath
-  -- | The directory where a cabal file is found.
+  -- | The project root directory.
-  , cradleCabalDir    :: Maybe FilePath
+  , cradleRootDir    :: FilePath
   -- | The file name of the found cabal file.
-  , cradleCabalFile   :: Maybe FilePath
+  , cradleCabalFile  :: Maybe FilePath
   -- | User package db. (\"\/foo\/bar\/i386-osx-ghc-7.6.3-packages.conf.d\")
-  , cradlePackageDb :: Maybe FilePath
+  , cradlePackageDb  :: Maybe FilePath
   -- | Dependent packages.
-  , cradlePackages :: [Package]
+  , cradlePackages   :: [Package]
   } deriving (Eq, Show)
 
 ----------------------------------------------------------------

test/CradleSpec.hs

@@ -19,7 +19,7 @@ spec = do
                 res <- findCradle
                 res `shouldBe` Cradle {
                     cradleCurrentDir = curDir
-                  , cradleCabalDir   = Nothing
+                  , cradleRootDir    = curDir
                   , cradleCabalFile  = Nothing
                   , cradlePackageDb  = Nothing
                   , cradlePackages   = []
@@ -29,7 +29,7 @@ spec = do
                 res <- relativeCradle dir <$> findCradle
                 res `shouldBe` Cradle {
                     cradleCurrentDir = "test" </> "data" </> "subdir1" </> "subdir2"
-                  , cradleCabalDir   = Just ("test" </> "data")
+                  , cradleRootDir    = "test" </> "data"
                   , cradleCabalFile  = Just ("test" </> "data" </> "cabalapi.cabal")
                   , cradlePackageDb  = Just ("test" </> "data" </> ".cabal-sandbox" </> "/home/me/work/ghc-mod/test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d")
                   , cradlePackages   = []
@@ -39,7 +39,7 @@ spec = do
                 res <- relativeCradle dir <$> findCradle
                 res `shouldBe` Cradle {
                     cradleCurrentDir = "test" </> "data" </> "broken-sandbox"
-                  , cradleCabalDir   = Just ("test" </> "data" </> "broken-sandbox")
+                  , cradleRootDir    = "test" </> "data" </> "broken-sandbox"
                   , cradleCabalFile  = Just ("test" </> "data" </> "broken-sandbox" </> "dummy.cabal")
                   , cradlePackageDb  = Nothing
                   , cradlePackages   = []
@@ -60,9 +60,9 @@ spec = do
 
 relativeCradle :: FilePath -> Cradle -> Cradle
 relativeCradle dir cradle = cradle {
-    cradleCurrentDir    = toRelativeDir dir  $  cradleCurrentDir    cradle
+    cradleCurrentDir    = toRelativeDir dir  $  cradleCurrentDir cradle
-  , cradleCabalDir      = toRelativeDir dir <$> cradleCabalDir      cradle
+  , cradleRootDir       = toRelativeDir dir  $  cradleRootDir    cradle
-  , cradleCabalFile     = toRelativeDir dir <$> cradleCabalFile     cradle
+  , cradleCabalFile     = toRelativeDir dir <$> cradleCabalFile  cradle
   }
 
 -- Work around GHC 7.2.2 where `canonicalizePath "/"` returns "/.".