Fix missing autogen files when dist/setup-config already exists (Issue #621)
This commit is contained in:
parent
6f0eb46db9
commit
df455a3618
@ -21,6 +21,7 @@ module Language.Haskell.GhcMod.CabalHelper
|
||||
, getGhcMergedPkgOptions
|
||||
, getCabalPackageDbStack
|
||||
, prepareCabalHelper
|
||||
, withAutogen
|
||||
)
|
||||
#endif
|
||||
where
|
||||
@ -85,7 +86,7 @@ chPkgToGhcPkg (ChPkgSpecific f) = PackageDb f
|
||||
-- 'resolveGmComponents'.
|
||||
getComponents :: (Applicative m, IOish m, Gm m)
|
||||
=> m [GmComponent 'GMCRaw ChEntrypoint]
|
||||
getComponents = chCached$ \distdir -> Cached {
|
||||
getComponents = chCached $ \distdir -> Cached {
|
||||
cacheLens = Just (lGmcComponents . lGmCaches),
|
||||
cacheFile = cabalHelperCacheFile distdir,
|
||||
cachedAction = \ _tcf (_progs, _projdir, _ver) _ma -> do
|
||||
@ -138,55 +139,28 @@ prepareCabalHelper = do
|
||||
when (isCabalHelperProject $ cradleProject crdl) $
|
||||
withCabal $ liftIO $ prepare readProc projdir distdir
|
||||
|
||||
withCabal :: (IOish m, GmEnv m, GmOut m, GmLog m) => m a -> m a
|
||||
withCabal action = do
|
||||
withAutogen :: (IOish m, GmEnv m, GmOut m, GmLog m) => m a -> m a
|
||||
withAutogen action = do
|
||||
gmLog GmDebug "" $ strDoc $ "making sure autogen files exist"
|
||||
crdl <- cradle
|
||||
opts <- options
|
||||
readProc <- gmReadProcess
|
||||
|
||||
let projdir = cradleRootDir 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
|
||||
mCabalConfig <- liftIO $ timeMaybe (setupConfigFile crdl)
|
||||
mCabalSandboxConfig <- liftIO $ timeMaybe (sandboxConfigFile crdl)
|
||||
mCabalMacroHeader <- liftIO $ timeMaybe (distdir </> macrosHeaderPath)
|
||||
mCabalPathsModule <- liftIO $ timeMaybe (distdir </> autogenModulePath pkgName')
|
||||
|
||||
mCusPkgDbStack <- getCustomPkgDbStack
|
||||
|
||||
pkgDbStackOutOfSync <-
|
||||
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
|
||||
when (mCabalMacroHeader < mCabalFile || mCabalPathsModule < mCabalFile) $ do
|
||||
gmLog GmDebug "" $ strDoc $ "autogen files out of sync"
|
||||
writeAutogen projdir distdir
|
||||
|
||||
action
|
||||
|
||||
@ -197,7 +171,54 @@ withCabal action = do
|
||||
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
|
||||
cusPkgStack <- maybe [] ((PackageDb "clear"):) <$> getCustomPkgDbStack
|
||||
let progOpts =
|
||||
@ -209,19 +230,14 @@ withCabal action = do
|
||||
else []
|
||||
++ map pkgDbArg cusPkgStack
|
||||
liftIO $ void $ readProc (T.cabalProgram progs) ("configure":progOpts) ""
|
||||
writeAutogen projdir distdir
|
||||
|
||||
stackReconfigure crdl progs = do
|
||||
let projdir = cradleRootDir crdl
|
||||
distdir = projdir </> cradleDistDir crdl
|
||||
|
||||
withDirectory_ (cradleRootDir crdl) $ do
|
||||
supported <- haveStackSupport
|
||||
if supported
|
||||
then do
|
||||
spawn [T.stackProgram progs, "build", "--only-dependencies", "."]
|
||||
spawn [T.stackProgram progs, "build", "--only-configure", "."]
|
||||
writeAutogen projdir distdir
|
||||
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)"
|
||||
|
||||
|
@ -200,7 +200,16 @@ setupConfigPath dist = dist </> "setup-config"
|
||||
-- localBuildInfoFile defaultDistPref
|
||||
|
||||
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 buildPlatf = do
|
||||
|
@ -489,7 +489,7 @@ needsFallback = any $ \ms ->
|
||||
|
||||
cabalResolvedComponents :: (IOish m) =>
|
||||
GhcModT m (Map ChComponentName (GmComponent 'GMCResolved (Set ModulePath)))
|
||||
cabalResolvedComponents = do
|
||||
cabalResolvedComponents = withAutogen $ do
|
||||
crdl@(Cradle{..}) <- cradle
|
||||
comps <- mapM (resolveEntrypoint crdl) =<< getComponents
|
||||
cached cradleRootDir (resolvedComponentsCache cradleDistDir) comps
|
||||
|
Loading…
Reference in New Issue
Block a user