Fix yesterday's fix

we were invoking cabal-helper too early
This commit is contained in:
Daniel Gröber 2015-09-24 04:49:49 +02:00
parent 6710503648
commit 2549bba7b8
3 changed files with 18 additions and 27 deletions

View File

@ -143,16 +143,10 @@ withAutogen :: (IOish m, GmEnv m, GmOut m, GmLog m) => m a -> m a
withAutogen action = do withAutogen action = do
gmLog GmDebug "" $ strDoc $ "making sure autogen files exist" gmLog GmDebug "" $ strDoc $ "making sure autogen files exist"
crdl <- cradle crdl <- cradle
opts <- options
readProc <- gmReadProcess
let projdir = cradleRootDir crdl let projdir = cradleRootDir crdl
distdir = projdir </> cradleDistDir crdl distdir = projdir </> cradleDistDir crdl
let qe = (defaultQueryEnv projdir distdir) { (pkgName', _) <- runCHQuery packageId
qeReadProcess = readProc
, qePrograms = helperProgs $ optPrograms opts
}
(pkgName', _) <- runQuery qe packageId
mCabalFile <- liftIO $ timeFile `traverse` cradleCabalFile crdl mCabalFile <- liftIO $ timeFile `traverse` cradleCabalFile crdl
mCabalMacroHeader <- liftIO $ timeMaybe (distdir </> macrosHeaderPath) mCabalMacroHeader <- liftIO $ timeMaybe (distdir </> macrosHeaderPath)
@ -174,24 +168,17 @@ withAutogen action = do
withCabal :: (IOish m, GmEnv m, GmOut m, GmLog m) => m a -> m a withCabal :: (IOish m, GmEnv m, GmOut m, GmLog m) => m a -> m a
withCabal action = do withCabal action = do
crdl <- cradle crdl <- cradle
opts <- options
readProc <- gmReadProcess
proj <- cradleProject <$> cradle
let projdir = cradleRootDir crdl
distdir = projdir </> cradleDistDir crdl
let qe = (defaultQueryEnv projdir distdir) {
qeReadProcess = readProc
, qePrograms = helperProgs $ optPrograms opts
}
pkgDb <- runQuery qe $ map chPkgToGhcPkg <$> packageDbStack
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) mCabalSandboxConfig <- liftIO $ timeMaybe (sandboxConfigFile crdl)
pkgDbStackOutOfSync <- fromMaybe False . (fmap (pkgDb /=)) <$> getCustomPkgDbStack cusPkgDb <- getCustomPkgDbStack
pkgDbStackOutOfSync <- do
if isJust mCabalConfig
then runCHQuery $ do
pkgDb <- map chPkgToGhcPkg <$> packageDbStack
return $ fromMaybe False $ (pkgDb /=) <$> cusPkgDb
else return False
when (isSetupConfigOutOfDate mCabalFile mCabalConfig) $ when (isSetupConfigOutOfDate mCabalFile mCabalConfig) $
gmLog GmDebug "" $ strDoc $ "setup configuration is out of date" gmLog GmDebug "" $ strDoc $ "setup configuration is out of date"
@ -204,11 +191,13 @@ withCabal action = do
when ( isSetupConfigOutOfDate mCabalFile mCabalConfig when ( isSetupConfigOutOfDate mCabalFile mCabalConfig
|| pkgDbStackOutOfSync || pkgDbStackOutOfSync
|| isSetupConfigOutOfDate mCabalSandboxConfig mCabalConfig) $ || isSetupConfigOutOfDate mCabalSandboxConfig mCabalConfig) $ do
proj <- cradleProject <$> cradle
opts <- options
case proj of case proj of
CabalProject -> do CabalProject -> do
gmLog GmDebug "" $ strDoc "reconfiguring Cabal project" gmLog GmDebug "" $ strDoc "reconfiguring Cabal project"
cabalReconfigure readProc (optPrograms opts) crdl cabalReconfigure (optPrograms opts) crdl
StackProject {} -> do StackProject {} -> do
gmLog GmDebug "" $ strDoc "reconfiguring Stack project" gmLog GmDebug "" $ strDoc "reconfiguring Stack project"
stackReconfigure crdl (optPrograms opts) stackReconfigure crdl (optPrograms opts)
@ -218,7 +207,8 @@ withCabal action = do
action action
where where
cabalReconfigure readProc progs crdl = do cabalReconfigure progs crdl = do
readProc <- gmReadProcess
withDirectory_ (cradleRootDir crdl) $ do withDirectory_ (cradleRootDir crdl) $ do
cusPkgStack <- maybe [] ((PackageDb "clear"):) <$> getCustomPkgDbStack cusPkgStack <- maybe [] ((PackageDb "clear"):) <$> getCustomPkgDbStack
let progOpts = let progOpts =

View File

@ -19,7 +19,7 @@ parseCustomPackageDb src = map parsePkgDb $ filter (not . null) $ lines src
parsePkgDb "user" = UserDb parsePkgDb "user" = UserDb
parsePkgDb s = PackageDb s parsePkgDb s = PackageDb s
getCustomPkgDbStack :: (IOish m, GmEnv m) => m (Maybe [GhcPkgDb]) getCustomPkgDbStack :: (MonadIO m, GmEnv m) => m (Maybe [GhcPkgDb])
getCustomPkgDbStack = do getCustomPkgDbStack = do
mCusPkgDbFile <- liftIO . (traverse readFile <=< findCustomPackageDbFile) . cradleRootDir =<< cradle mCusPkgDbFile <- liftIO . (traverse readFile <=< findCustomPackageDbFile) . cradleRootDir =<< cradle
return $ parseCustomPackageDb <$> mCusPkgDbFile return $ parseCustomPackageDb <$> mCusPkgDbFile

View File

@ -489,7 +489,8 @@ needsFallback = any $ \ms ->
cabalResolvedComponents :: (IOish m) => cabalResolvedComponents :: (IOish m) =>
GhcModT m (Map ChComponentName (GmComponent 'GMCResolved (Set ModulePath))) GhcModT m (Map ChComponentName (GmComponent 'GMCResolved (Set ModulePath)))
cabalResolvedComponents = withAutogen $ do cabalResolvedComponents = do
crdl@(Cradle{..}) <- cradle crdl@(Cradle{..}) <- cradle
comps <- mapM (resolveEntrypoint crdl) =<< getComponents comps <- mapM (resolveEntrypoint crdl) =<< getComponents
cached cradleRootDir (resolvedComponentsCache cradleDistDir) comps withAutogen $
cached cradleRootDir (resolvedComponentsCache cradleDistDir) comps