Take sandbox cfg into account for caches
This commit is contained in:
parent
78bdf86a95
commit
18a8c67d39
@ -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,
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user