hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

Browse Source
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
Download Patch File Download Diff File Expand all files Collapse all files

112
Language/Haskell/GhcMod/CabalHelper.hs
View File

@@ -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)"