Take sandbox cfg into account for caches

This commit is contained in:
Daniel Gröber 2015-08-19 08:46:56 +02:00
parent 78bdf86a95
commit 18a8c67d39
7 changed files with 47 additions and 31 deletions

View File

@ -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
@ -155,6 +156,7 @@ withCabal action = do
mCabalFile <- liftIO $ timeFile `traverse` cradleCabalFile crdl
mCabalConfig <- liftIO $ timeMaybe (setupConfigFile crdl)
mCabalSandboxConfig <- liftIO $ timeMaybe (sandboxConfigFile crdl)
mCusPkgDbStack <- getCustomPkgDbStack
@ -173,10 +175,16 @@ 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
|| pkgDbStackOutOfSync
|| isSetupConfigOutOfDate mCabalSandboxConfig mCabalConfig) $
withDirectory_ (cradleRootDir crdl) $ do
let progOpts =
[ "--with-ghc=" ++ T.ghcProgram opts ]
@ -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,

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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
}

View File

@ -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