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
|
, 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)"
|
||||||
|
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user