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), cacheLens = Just (lGmcPackageDbStack . lGmCaches),
cacheFile = pkgDbStackCacheFile distdir, cacheFile = pkgDbStackCacheFile distdir,
cachedAction = \ _tcf (progs, rootdir, _) _ma -> do cachedAction = \ _tcf (progs, rootdir, _) _ma -> do
crdl <- cradle
readProc <- gmReadProcess readProc <- gmReadProcess
dbs <- withCabal $ map chPkgToGhcPkg <$> runQuery'' readProc progs rootdir distdir packageDbStack dbs <- withCabal $ map chPkgToGhcPkg <$> runQuery'' readProc progs rootdir distdir packageDbStack
return ([setupConfigPath distdir, sandboxConfigFile], dbs) return ([setupConfigFile crdl, sandboxConfigFile crdl], dbs)
} }
chPkgToGhcPkg :: ChPkgDb -> GhcPkgDb chPkgToGhcPkg :: ChPkgDb -> GhcPkgDb
@ -155,6 +156,7 @@ withCabal action = do
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 mCusPkgDbStack <- getCustomPkgDbStack
@ -173,10 +175,16 @@ withCabal action = do
when (isSetupConfigOutOfDate mCabalFile mCabalConfig) $ when (isSetupConfigOutOfDate mCabalFile mCabalConfig) $
gmLog GmDebug "" $ strDoc $ "setup configuration is out of date, reconfiguring Cabal project." 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 $ when pkgDbStackOutOfSync $
gmLog GmDebug "" $ strDoc $ "package-db stack out of sync with ghc-mod.package-db-stack, reconfiguring Cabal project." 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 withDirectory_ (cradleRootDir crdl) $ do
let progOpts = let progOpts =
[ "--with-ghc=" ++ T.ghcProgram opts ] [ "--with-ghc=" ++ T.ghcProgram opts ]
@ -200,9 +208,9 @@ pkgDbArg (PackageDb p) = "--package-db=" ++ p
-- @Nothing < Nothing = False@ -- @Nothing < Nothing = False@
-- (since we don't need to @cabal configure@ when no cabal file exists.) -- (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@ -- @Just cc < Nothing = False@
-- TODO: should we delete dist/setup-config?
-- --
-- * dist/setup-config doesn't exist yet -> should return True: -- * dist/setup-config doesn't exist yet -> should return True:
-- @Nothing < Just cf = True@ -- @Nothing < Just cf = True@
@ -213,7 +221,6 @@ isSetupConfigOutOfDate :: Maybe TimedFile -> Maybe TimedFile -> Bool
isSetupConfigOutOfDate worldCabalFile worldCabalConfig = do isSetupConfigOutOfDate worldCabalFile worldCabalConfig = do
worldCabalConfig < worldCabalFile worldCabalConfig < worldCabalFile
helperProgs :: Options -> Programs helperProgs :: Options -> Programs
helperProgs opts = Programs { helperProgs opts = Programs {
cabalProgram = T.cabalProgram opts, 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
, findCradle' , findCradle'
, findSpecCradle , findSpecCradle
, cleanupCradle , cleanupCradle
) where )
#endif
where
import Language.Haskell.GhcMod.PathsAndFiles import Language.Haskell.GhcMod.PathsAndFiles
import Language.Haskell.GhcMod.Monad.Types import Language.Haskell.GhcMod.Monad.Types

View File

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

View File

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

View File

@ -280,19 +280,15 @@ stackOpts crdl = do
-- also works for plain projects! -- also works for plain projects!
sandboxOpts :: MonadIO m => Cradle -> m [String] sandboxOpts :: MonadIO m => Cradle -> m [String]
sandboxOpts crdl = do sandboxOpts crdl = do
pkgDbStack <- liftIO $ getSandboxPackageDbStack $ cradleRootDir crdl pkgDbStack <- liftIO $ getSandboxPackageDbStack
let pkgOpts = ghcDbStackOpts pkgDbStack let pkgOpts = ghcDbStackOpts pkgDbStack
return $ ["-i" ++ d | d <- [wdir,rdir]] ++ pkgOpts ++ ["-Wall"] return $ ["-i" ++ d | d <- [wdir,rdir]] ++ pkgOpts ++ ["-Wall"]
where where
(wdir, rdir) = (cradleCurrentDir crdl, cradleRootDir crdl) (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) resolveGmComponent :: (IOish m, GmLog m, GmEnv m, GmState m)
=> Maybe [CompilationUnit] -- ^ Updated modules => Maybe [CompilationUnit] -- ^ Updated modules

View File

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

View File

@ -1,7 +1,10 @@
module PathsAndFilesSpec where 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.Directory
import System.FilePath import System.FilePath
import Test.Hspec import Test.Hspec
@ -12,11 +15,13 @@ spec = do
describe "getSandboxDb" $ do describe "getSandboxDb" $ do
it "can parse a config file and extract the sandbox package-db" $ do it "can parse a config file and extract the sandbox package-db" $ do
cwd <- getCurrentDirectory 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") db `shouldSatisfy` isPkgDbAt (cwd </> "test/data/cabal-project/.cabal-sandbox")
it "returns Nothing if the sandbox config file is broken" $ do 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 describe "findCabalFile" $ do
it "works" $ do it "works" $ do