Take sandbox cfg into account for caches

Language/Haskell/GhcMod/CabalHelper.hs

@@ -68,9 +68,10 @@ getCabalPackageDbStack = chCached $ \distdir -> Cached {
   cacheLens = Just (lGmcPackageDbStack . lGmCaches),
   cacheFile = pkgDbStackCacheFile distdir,
   cachedAction = \ _tcf (progs, rootdir, _) _ma -> do
+    crdl <- cradle
     readProc <- gmReadProcess
     dbs <- withCabal $ map chPkgToGhcPkg <$> runQuery'' readProc progs rootdir distdir packageDbStack
-    return ([setupConfigPath distdir, sandboxConfigFile], dbs)
+    return ([setupConfigFile crdl, sandboxConfigFile crdl], dbs)
  }
 
 chPkgToGhcPkg :: ChPkgDb -> GhcPkgDb
@@ -153,8 +154,9 @@ withCabal action = do
     let projdir = cradleRootDir crdl
         distdir = projdir </> cradleDistDir crdl
 
-    mCabalFile <- liftIO $ timeFile `traverse` cradleCabalFile crdl
+    mCabalFile          <- liftIO $ timeFile `traverse` cradleCabalFile crdl
-    mCabalConfig <- liftIO $ timeMaybe (setupConfigFile crdl)
+    mCabalConfig        <- liftIO $ timeMaybe (setupConfigFile crdl)
+    mCabalSandboxConfig <- liftIO $ timeMaybe (sandboxConfigFile crdl)
 
     mCusPkgDbStack <- getCustomPkgDbStack
 
@@ -173,11 +175,17 @@ withCabal action = do
 
     when (isSetupConfigOutOfDate mCabalFile mCabalConfig) $
       gmLog GmDebug "" $ strDoc $ "setup configuration is out of date, reconfiguring Cabal project."
+
+    when (isSetupConfigOutOfDate mCabalSandboxConfig mCabalConfig) $
+      gmLog GmDebug "" $ strDoc $ "sandbox configuration is out of date, reconfiguring Cabal project."
+
     when pkgDbStackOutOfSync $
       gmLog GmDebug "" $ strDoc $ "package-db stack out of sync with ghc-mod.package-db-stack, reconfiguring Cabal project."
 
-    when (isSetupConfigOutOfDate mCabalFile mCabalConfig || pkgDbStackOutOfSync) $
+    when ( isSetupConfigOutOfDate mCabalFile mCabalConfig
-        withDirectory_ (cradleRootDir crdl) $ do
+        || pkgDbStackOutOfSync
+        || isSetupConfigOutOfDate mCabalSandboxConfig mCabalConfig) $
+          withDirectory_ (cradleRootDir crdl) $ do
             let progOpts =
                     [ "--with-ghc=" ++ T.ghcProgram opts ]
                     -- Only pass ghc-pkg if it was actually set otherwise we
@@ -200,9 +208,9 @@ pkgDbArg (PackageDb p) = "--package-db=" ++ p
 --   @Nothing < Nothing = False@
 --   (since we don't need to @cabal configure@ when no cabal file exists.)
 --
--- * Cabal file doesn't exist (unlikely case) -> should return False
+-- * Cabal file doesn't exist (impossible since cabal-helper is only used with
+-- cabal projects) -> should return False
 --   @Just cc < Nothing = False@
---   TODO: should we delete dist/setup-config?
 --
 -- * dist/setup-config doesn't exist yet -> should return True:
 --   @Nothing < Just cf = True@
@@ -213,7 +221,6 @@ isSetupConfigOutOfDate :: Maybe TimedFile -> Maybe TimedFile -> Bool
 isSetupConfigOutOfDate worldCabalFile worldCabalConfig = do
   worldCabalConfig < worldCabalFile
 
-
 helperProgs :: Options -> Programs
 helperProgs opts = Programs {
                             cabalProgram  = T.cabalProgram opts,

Language/Haskell/GhcMod/Cradle.hs

@@ -1,9 +1,14 @@
-module Language.Haskell.GhcMod.Cradle (
+{-# LANGUAGE CPP #-}
+module Language.Haskell.GhcMod.Cradle
+#ifndef SPEC
+  (
     findCradle
   , findCradle'
   , findSpecCradle
   , cleanupCradle
-  ) where
+  )
+#endif
+  where
 
 import Language.Haskell.GhcMod.PathsAndFiles
 import Language.Haskell.GhcMod.Monad.Types

Language/Haskell/GhcMod/GhcPkg.hs

@@ -67,7 +67,7 @@ getPackageDbStack = do
     PlainProject ->
         return [GlobalDb, UserDb]
     SandboxProject -> do
-        Just db <- liftIO $ getSandboxDb $ cradleRootDir crdl
+        Just db <- liftIO $ getSandboxDb crdl
         return $ [GlobalDb, db]
     CabalProject ->
         getCabalPackageDbStack

Language/Haskell/GhcMod/PathsAndFiles.hs

@@ -81,12 +81,9 @@ getStackDistDir dir = U.withDirectory_ dir $ runMaybeT $ do
     liftIO $ takeWhile (/='\n') <$> readProcess stack ["path", "--dist-dir"] ""
 
 -- | Get path to sandbox config file
-getSandboxDb :: FilePath
+getSandboxDb :: Cradle -> IO (Maybe GhcPkgDb)
-             -- ^ Path to the cabal package root directory (containing the
+getSandboxDb crdl = do
-             -- @cabal.sandbox.config@ file)
+  mConf <-traverse readFile =<< mightExist (sandboxConfigFile crdl)
-             -> IO (Maybe GhcPkgDb)
-getSandboxDb d = do
-  mConf <- traverse readFile =<< mightExist (d </> "cabal.sandbox.config")
   bp <- buildPlatform readProcess
   return $ PackageDb . fixPkgDbVer bp <$> (extractSandboxDbDir =<< mConf)
 
@@ -154,7 +151,7 @@ findCabalSandboxDir dir = do
              _ -> Nothing
 
  where
-   isSandboxConfig = (==sandboxConfigFile)
+   isSandboxConfig = (==sandboxConfigFileName)
 
 zipMapM :: Monad m => (a -> m c) -> [a] -> m [(a,c)]
 zipMapM f as = mapM (\a -> liftM ((,) a) $ f a) as
@@ -191,8 +188,11 @@ setupConfigFile :: Cradle -> FilePath
 setupConfigFile crdl =
     cradleRootDir crdl </> setupConfigPath (cradleDistDir crdl)
 
-sandboxConfigFile :: FilePath
+sandboxConfigFile :: Cradle -> FilePath
-sandboxConfigFile = "cabal.sandbox.config"
+sandboxConfigFile crdl = cradleRootDir crdl </> sandboxConfigFileName
+
+sandboxConfigFileName :: String
+sandboxConfigFileName = "cabal.sandbox.config"
 
 -- | Path to 'LocalBuildInfo' file, usually @dist/setup-config@
 setupConfigPath :: FilePath -> FilePath

Language/Haskell/GhcMod/Target.hs

@@ -280,19 +280,15 @@ stackOpts crdl = do
 -- also works for plain projects!
 sandboxOpts :: MonadIO m => Cradle -> m [String]
 sandboxOpts crdl = do
-    pkgDbStack <- liftIO $ getSandboxPackageDbStack $ cradleRootDir crdl
+    pkgDbStack <- liftIO $ getSandboxPackageDbStack
     let pkgOpts = ghcDbStackOpts pkgDbStack
     return $ ["-i" ++ d | d <- [wdir,rdir]] ++ pkgOpts ++ ["-Wall"]
   where
     (wdir, rdir) = (cradleCurrentDir crdl, cradleRootDir crdl)
 
-    getSandboxPackageDbStack
+    getSandboxPackageDbStack :: IO [GhcPkgDb]
-        :: FilePath
+    getSandboxPackageDbStack =
-        -- ^ Project Directory (where the cabal.sandbox.config file would be if
+        ([GlobalDb] ++) . maybe [UserDb] return <$> getSandboxDb crdl
-        -- it exists)
-        -> IO [GhcPkgDb]
-    getSandboxPackageDbStack cdir =
-        ([GlobalDb] ++) . maybe [UserDb] return <$> getSandboxDb cdir
 
 resolveGmComponent :: (IOish m, GmLog m, GmEnv m, GmState m)
     => Maybe [CompilationUnit] -- ^ Updated modules

Language/Haskell/GhcMod/World.hs

@@ -18,6 +18,7 @@ data World = World {
     worldPackageCaches :: [TimedFile]
   , worldCabalFile     :: Maybe TimedFile
   , worldCabalConfig   :: Maybe TimedFile
+  , worldCabalSandboxConfig :: Maybe TimedFile
   , worldSymbolCache   :: Maybe TimedFile
   } deriving (Eq, Show)
 
@@ -33,12 +34,14 @@ getCurrentWorld = do
     pkgCaches    <- timedPackageCaches
     mCabalFile   <- liftIO $ timeFile `traverse` cradleCabalFile crdl
     mCabalConfig <- liftIO $ timeMaybe (setupConfigFile crdl)
+    mCabalSandboxConfig <- liftIO $ timeMaybe (sandboxConfigFile crdl)
     mSymbolCache <- liftIO $ timeMaybe (symbolCache crdl)
 
     return World {
         worldPackageCaches = pkgCaches
       , worldCabalFile     = mCabalFile
       , worldCabalConfig   = mCabalConfig
+      , worldCabalSandboxConfig = mCabalSandboxConfig
       , worldSymbolCache   = mSymbolCache
       }
 

test/PathsAndFilesSpec.hs

@@ -1,7 +1,10 @@
 module PathsAndFilesSpec where
 
-import Language.Haskell.GhcMod.PathsAndFiles
 
+import Language.Haskell.GhcMod.PathsAndFiles
+import Language.Haskell.GhcMod.Cradle
+
+import Control.Monad.Trans.Maybe
 import System.Directory
 import System.FilePath
 import Test.Hspec
@@ -12,11 +15,13 @@ spec = do
     describe "getSandboxDb" $ do
         it "can parse a config file and extract the sandbox package-db" $ do
             cwd <- getCurrentDirectory
-            Just db <- getSandboxDb "test/data/cabal-project"
+            Just crdl <- runMaybeT $ plainCradle "test/data/cabal-project"
+            Just db <- getSandboxDb crdl
             db `shouldSatisfy` isPkgDbAt (cwd </> "test/data/cabal-project/.cabal-sandbox")
 
         it "returns Nothing if the sandbox config file is broken" $ do
-            getSandboxDb "test/data/broken-sandbox" `shouldReturn` Nothing
+            Just crdl <- runMaybeT $ plainCradle "test/data/broken-sandbox"
+            getSandboxDb crdl  `shouldReturn` Nothing
 
     describe "findCabalFile" $ do
         it "works" $ do