diff --git a/Language/Haskell/GhcMod/CabalHelper.hs b/Language/Haskell/GhcMod/CabalHelper.hs index 2b77ec6..78e1d7c 100644 --- a/Language/Haskell/GhcMod/CabalHelper.hs +++ b/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 - mCabalConfig <- liftIO $ timeMaybe (setupConfigFile crdl) + mCabalFile <- liftIO $ timeFile `traverse` cradleCabalFile 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) $ - withDirectory_ (cradleRootDir crdl) $ do + when ( isSetupConfigOutOfDate mCabalFile mCabalConfig + || 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, diff --git a/Language/Haskell/GhcMod/Cradle.hs b/Language/Haskell/GhcMod/Cradle.hs index e514e5b..c68ce21 100644 --- a/Language/Haskell/GhcMod/Cradle.hs +++ b/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 diff --git a/Language/Haskell/GhcMod/GhcPkg.hs b/Language/Haskell/GhcMod/GhcPkg.hs index 86255fc..df2bce2 100644 --- a/Language/Haskell/GhcMod/GhcPkg.hs +++ b/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 diff --git a/Language/Haskell/GhcMod/PathsAndFiles.hs b/Language/Haskell/GhcMod/PathsAndFiles.hs index f596ccd..0639e24 100644 --- a/Language/Haskell/GhcMod/PathsAndFiles.hs +++ b/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 - -- ^ Path to the cabal package root directory (containing the - -- @cabal.sandbox.config@ file) - -> IO (Maybe GhcPkgDb) -getSandboxDb d = do - mConf <- traverse readFile =<< mightExist (d "cabal.sandbox.config") +getSandboxDb :: Cradle -> IO (Maybe GhcPkgDb) +getSandboxDb crdl = do + mConf <-traverse readFile =<< mightExist (sandboxConfigFile crdl) 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 = "cabal.sandbox.config" +sandboxConfigFile :: Cradle -> FilePath +sandboxConfigFile crdl = cradleRootDir crdl sandboxConfigFileName + +sandboxConfigFileName :: String +sandboxConfigFileName = "cabal.sandbox.config" -- | Path to 'LocalBuildInfo' file, usually @dist/setup-config@ setupConfigPath :: FilePath -> FilePath diff --git a/Language/Haskell/GhcMod/Target.hs b/Language/Haskell/GhcMod/Target.hs index 7fe9697..be5433e 100644 --- a/Language/Haskell/GhcMod/Target.hs +++ b/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 - :: FilePath - -- ^ Project Directory (where the cabal.sandbox.config file would be if - -- it exists) - -> IO [GhcPkgDb] - getSandboxPackageDbStack cdir = - ([GlobalDb] ++) . maybe [UserDb] return <$> getSandboxDb cdir + getSandboxPackageDbStack :: IO [GhcPkgDb] + getSandboxPackageDbStack = + ([GlobalDb] ++) . maybe [UserDb] return <$> getSandboxDb crdl resolveGmComponent :: (IOish m, GmLog m, GmEnv m, GmState m) => Maybe [CompilationUnit] -- ^ Updated modules diff --git a/Language/Haskell/GhcMod/World.hs b/Language/Haskell/GhcMod/World.hs index e887990..0d413e5 100644 --- a/Language/Haskell/GhcMod/World.hs +++ b/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 } diff --git a/test/PathsAndFilesSpec.hs b/test/PathsAndFilesSpec.hs index 1e15b1d..cb34aa4 100644 --- a/test/PathsAndFilesSpec.hs +++ b/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