Fix missing autogen files when dist/setup-config already exists (Issue #621)

This commit is contained in:
Daniel Gröber 2015-09-23 12:01:37 +02:00
parent 6f0eb46db9
commit df455a3618
3 changed files with 75 additions and 50 deletions

View File

@ -21,6 +21,7 @@ module Language.Haskell.GhcMod.CabalHelper
, getGhcMergedPkgOptions , getGhcMergedPkgOptions
, getCabalPackageDbStack , getCabalPackageDbStack
, prepareCabalHelper , prepareCabalHelper
, withAutogen
) )
#endif #endif
where where
@ -85,7 +86,7 @@ chPkgToGhcPkg (ChPkgSpecific f) = PackageDb f
-- 'resolveGmComponents'. -- 'resolveGmComponents'.
getComponents :: (Applicative m, IOish m, Gm m) getComponents :: (Applicative m, IOish m, Gm m)
=> m [GmComponent 'GMCRaw ChEntrypoint] => m [GmComponent 'GMCRaw ChEntrypoint]
getComponents = chCached$ \distdir -> Cached { getComponents = chCached $ \distdir -> Cached {
cacheLens = Just (lGmcComponents . lGmCaches), cacheLens = Just (lGmcComponents . lGmCaches),
cacheFile = cabalHelperCacheFile distdir, cacheFile = cabalHelperCacheFile distdir,
cachedAction = \ _tcf (_progs, _projdir, _ver) _ma -> do cachedAction = \ _tcf (_progs, _projdir, _ver) _ma -> do
@ -138,55 +139,28 @@ prepareCabalHelper = do
when (isCabalHelperProject $ cradleProject crdl) $ when (isCabalHelperProject $ cradleProject crdl) $
withCabal $ liftIO $ prepare readProc projdir distdir withCabal $ liftIO $ prepare readProc projdir distdir
withCabal :: (IOish m, GmEnv m, GmOut m, GmLog m) => m a -> m a withAutogen :: (IOish m, GmEnv m, GmOut m, GmLog m) => m a -> m a
withCabal action = do withAutogen action = do
gmLog GmDebug "" $ strDoc $ "making sure autogen files exist"
crdl <- cradle crdl <- cradle
opts <- options opts <- options
readProc <- gmReadProcess readProc <- gmReadProcess
let projdir = cradleRootDir crdl let projdir = cradleRootDir crdl
distdir = projdir </> cradleDistDir crdl distdir = projdir </> cradleDistDir crdl
let qe = (defaultQueryEnv projdir distdir) {
qeReadProcess = readProc
, qePrograms = helperProgs $ optPrograms opts
}
(pkgName', _) <- runQuery qe packageId
mCabalFile <- liftIO $ timeFile `traverse` cradleCabalFile crdl mCabalFile <- liftIO $ timeFile `traverse` cradleCabalFile crdl
mCabalConfig <- liftIO $ timeMaybe (setupConfigFile crdl) mCabalMacroHeader <- liftIO $ timeMaybe (distdir </> macrosHeaderPath)
mCabalSandboxConfig <- liftIO $ timeMaybe (sandboxConfigFile crdl) mCabalPathsModule <- liftIO $ timeMaybe (distdir </> autogenModulePath pkgName')
mCusPkgDbStack <- getCustomPkgDbStack when (mCabalMacroHeader < mCabalFile || mCabalPathsModule < mCabalFile) $ do
gmLog GmDebug "" $ strDoc $ "autogen files out of sync"
pkgDbStackOutOfSync <- writeAutogen projdir distdir
case mCusPkgDbStack of
Just cusPkgDbStack -> do
let qe = (defaultQueryEnv projdir distdir) {
qeReadProcess = readProc
, qePrograms = helperProgs $ optPrograms opts
}
pkgDb <- runQuery qe $ map chPkgToGhcPkg <$> packageDbStack
return $ pkgDb /= cusPkgDbStack
Nothing -> return False
proj <- cradleProject <$> cradle
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
|| isSetupConfigOutOfDate mCabalSandboxConfig mCabalConfig) $
case proj of
CabalProject ->
cabalReconfigure readProc (optPrograms opts) crdl projdir distdir
StackProject {} ->
stackReconfigure crdl (optPrograms opts)
_ ->
error $ "withCabal: unsupported project type: " ++ show proj
action action
@ -197,7 +171,54 @@ withCabal action = do
liftIO $ writeAutogenFiles readProc projdir distdir liftIO $ writeAutogenFiles readProc projdir distdir
cabalReconfigure readProc progs crdl projdir distdir = do withCabal :: (IOish m, GmEnv m, GmOut m, GmLog m) => m a -> m a
withCabal action = do
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
mCabalConfig <- liftIO $ timeMaybe (setupConfigFile crdl)
mCabalSandboxConfig <- liftIO $ timeMaybe (sandboxConfigFile crdl)
pkgDbStackOutOfSync <- fromMaybe False . (fmap (pkgDb /=)) <$> getCustomPkgDbStack
when (isSetupConfigOutOfDate mCabalFile mCabalConfig) $
gmLog GmDebug "" $ strDoc $ "setup configuration is out of date"
when (isSetupConfigOutOfDate mCabalSandboxConfig mCabalConfig) $
gmLog GmDebug "" $ strDoc $ "sandbox configuration is out of date"
when pkgDbStackOutOfSync $
gmLog GmDebug "" $ strDoc $ "package-db stack out of sync with ghc-mod.package-db-stack"
when ( isSetupConfigOutOfDate mCabalFile mCabalConfig
|| pkgDbStackOutOfSync
|| isSetupConfigOutOfDate mCabalSandboxConfig mCabalConfig) $
case proj of
CabalProject -> do
gmLog GmDebug "" $ strDoc "reconfiguring Cabal project"
cabalReconfigure readProc (optPrograms opts) crdl
StackProject {} -> do
gmLog GmDebug "" $ strDoc "reconfiguring Stack project"
stackReconfigure crdl (optPrograms opts)
_ ->
error $ "withCabal: unsupported project type: " ++ show proj
action
where
cabalReconfigure readProc progs crdl = do
withDirectory_ (cradleRootDir crdl) $ do withDirectory_ (cradleRootDir crdl) $ do
cusPkgStack <- maybe [] ((PackageDb "clear"):) <$> getCustomPkgDbStack cusPkgStack <- maybe [] ((PackageDb "clear"):) <$> getCustomPkgDbStack
let progOpts = let progOpts =
@ -209,19 +230,14 @@ withCabal action = do
else [] else []
++ map pkgDbArg cusPkgStack ++ map pkgDbArg cusPkgStack
liftIO $ void $ readProc (T.cabalProgram progs) ("configure":progOpts) "" liftIO $ void $ readProc (T.cabalProgram progs) ("configure":progOpts) ""
writeAutogen projdir distdir
stackReconfigure crdl progs = do stackReconfigure crdl progs = do
let projdir = cradleRootDir crdl
distdir = projdir </> cradleDistDir crdl
withDirectory_ (cradleRootDir crdl) $ do withDirectory_ (cradleRootDir crdl) $ do
supported <- haveStackSupport supported <- haveStackSupport
if supported if supported
then do then do
spawn [T.stackProgram progs, "build", "--only-dependencies", "."] spawn [T.stackProgram progs, "build", "--only-dependencies", "."]
spawn [T.stackProgram progs, "build", "--only-configure", "."] spawn [T.stackProgram progs, "build", "--only-configure", "."]
writeAutogen projdir distdir
else else
gmLog GmWarning "" $ strDoc $ "Stack project configuration is out of date, please reconfigure manually using 'stack build' as your stack version is too old (need at least 0.1.4.0)" gmLog GmWarning "" $ strDoc $ "Stack project configuration is out of date, please reconfigure manually using 'stack build' as your stack version is too old (need at least 0.1.4.0)"

View File

@ -200,7 +200,16 @@ setupConfigPath dist = dist </> "setup-config"
-- localBuildInfoFile defaultDistPref -- localBuildInfoFile defaultDistPref
macrosHeaderPath :: FilePath macrosHeaderPath :: FilePath
macrosHeaderPath = "build/autogen/cabal_macros.h" macrosHeaderPath = autogenModulesDir </> "cabal_macros.h"
autogenModulePath :: String -> String
autogenModulePath pkg_name =
autogenModulesDir </> ("Paths_" ++ map fixchar pkg_name) <.> ".hs"
where fixchar '-' = '_'
fixchar c = c
autogenModulesDir :: FilePath
autogenModulesDir = "build" </> "autogen"
ghcSandboxPkgDbDir :: String -> String ghcSandboxPkgDbDir :: String -> String
ghcSandboxPkgDbDir buildPlatf = do ghcSandboxPkgDbDir buildPlatf = do

View File

@ -489,7 +489,7 @@ 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 = do cabalResolvedComponents = withAutogen $ do
crdl@(Cradle{..}) <- cradle crdl@(Cradle{..}) <- cradle
comps <- mapM (resolveEntrypoint crdl) =<< getComponents comps <- mapM (resolveEntrypoint crdl) =<< getComponents
cached cradleRootDir (resolvedComponentsCache cradleDistDir) comps cached cradleRootDir (resolvedComponentsCache cradleDistDir) comps