Merge remote-tracking branch 'prezi/master'

Conflicts:
	Language/Haskell/GhcMod/CabalHelper.hs

Language/Haskell/GhcMod/CabalHelper.hs

@@ -102,13 +102,20 @@ withCabal action = do
     opts <- options
     liftIO $ whenM (isSetupConfigOutOfDate <$> getCurrentWorld crdl) $
         withDirectory_ (cradleRootDir crdl) $ do
-            let progOpts =
+            let pkgDbArgs = "--package-db=clear" : map pkgDbArg (cradlePkgDbStack crdl)
+                progOpts =
                     [ "--with-ghc=" ++ T.ghcProgram opts ]
                     -- Only pass ghc-pkg if it was actually set otherwise we
                     -- might break cabal's guessing logic
                     ++ if T.ghcPkgProgram opts /= T.ghcPkgProgram defaultOptions
                          then [ "--with-ghc-pkg=" ++ T.ghcPkgProgram opts ]
                          else []
+                    ++ pkgDbArgs
             void $ readProcess (T.cabalProgram opts) ("configure":progOpts) ""
             writeAutogenFiles $ cradleRootDir crdl </> "dist"
     action
+
+pkgDbArg :: GhcPkgDb -> String
+pkgDbArg GlobalDb      = "--package-db=global"
+pkgDbArg UserDb        = "--package-db=user"
+pkgDbArg (PackageDb p) = "--package-db=" ++ p

Language/Haskell/GhcMod/Cradle.hs

@@ -28,7 +28,7 @@ findCradle = findCradle' =<< getCurrentDirectory
 
 findCradle' :: FilePath -> IO Cradle
 findCradle' dir = run $ do
-    (cabalCradle dir `mplus`  sandboxCradle dir `mplus` plainCradle dir)
+    (customCradle dir `mplus` cabalCradle dir `mplus`  sandboxCradle dir `mplus` plainCradle dir)
  where run a = fillTempDir =<< (fromJust <$> runMaybeT a)
 
 findSpecCradle :: FilePath -> IO Cradle
@@ -52,6 +52,21 @@ fillTempDir crdl = do
   tmpDir <- liftIO $ newTempDir (cradleRootDir crdl)
   return crdl { cradleTempDir = tmpDir }
 
+customCradle :: FilePath -> MaybeT IO Cradle
+customCradle wdir = do
+    cabalFile <- MaybeT $ findCabalFile wdir
+    let cabalDir = takeDirectory cabalFile
+    cradleFile <- MaybeT $ findCradleFile cabalDir
+    tmpDir <- liftIO $ newTempDir cabalDir
+    pkgDbStack <- liftIO $ parseCradle cradleFile
+    return Cradle {
+        cradleCurrentDir = wdir
+      , cradleRootDir    = cabalDir
+      , cradleTempDir    = tmpDir
+      , cradleCabalFile  = Just cabalFile
+      , cradlePkgDbStack = pkgDbStack
+      }
+
 cabalCradle :: FilePath -> MaybeT IO Cradle
 cabalCradle wdir = do
     cabalFile <- MaybeT $ findCabalFile wdir
@@ -95,3 +110,14 @@ getPackageDbStack :: FilePath -- ^ Project Directory (where the
                   -> IO [GhcPkgDb]
 getPackageDbStack cdir =
     ([GlobalDb] ++) . maybe [UserDb] return <$> getSandboxDb cdir
+
+parseCradle :: FilePath -> IO [GhcPkgDb]
+parseCradle path = do
+    source <- readFile path
+    return $ parseCradle' source
+  where
+    parseCradle' source = map parsePkgDb $ filter (not . null) $ lines source
+
+    parsePkgDb "global" = GlobalDb
+    parsePkgDb "user" = UserDb
+    parsePkgDb s = PackageDb s

Language/Haskell/GhcMod/PathsAndFiles.hs

@@ -35,6 +35,7 @@ import Language.Haskell.GhcMod.Types
 import Language.Haskell.GhcMod.Error
 import Language.Haskell.GhcMod.Caching
 import qualified Language.Haskell.GhcMod.Utils as U
+import Utils (mightExist)
 
 -- | Guaranteed to be a path to a directory with no trailing slash.
 type DirPath = FilePath
@@ -193,7 +194,6 @@ cabalBuildPlatform = unsafePerformIO $ buildPlatform
 packageCache :: String
 packageCache = "package.cache"
 
-
 -- | Filename of the symbol table cache file.
 symbolCache :: Cradle -> FilePath
 symbolCache crdl = cradleTempDir crdl </> symbolCacheFile
@@ -206,3 +206,10 @@ resolvedComponentsCacheFile = setupConfigPath <.> "ghc-mod.resolved-components"
 
 cabalHelperCacheFile :: String
 cabalHelperCacheFile = setupConfigPath <.> "ghc-mod.cabal-helper"
+
+-- | @findCradleFile dir@. Searches for a @.ghc-mod.cradle@ file in @dir@.
+-- If it exists in the given directory it is returned otherwise @findCradleFile@ returns @Nothing@
+findCradleFile :: FilePath -> IO (Maybe FilePath)
+findCradleFile directory = do
+    let path = directory </> "ghc-mod.cradle"
+    mightExist path