From df455a36182feea74a4fd949d49839b8f57ea63a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= Date: Wed, 23 Sep 2015 12:01:37 +0200 Subject: [PATCH] Fix missing autogen files when dist/setup-config already exists (Issue #621) --- Language/Haskell/GhcMod/CabalHelper.hs | 112 +++++++++++++---------- Language/Haskell/GhcMod/PathsAndFiles.hs | 11 ++- Language/Haskell/GhcMod/Target.hs | 2 +- 3 files changed, 75 insertions(+), 50 deletions(-) diff --git a/Language/Haskell/GhcMod/CabalHelper.hs b/Language/Haskell/GhcMod/CabalHelper.hs index b95258c..0c07cda 100644 --- a/Language/Haskell/GhcMod/CabalHelper.hs +++ b/Language/Haskell/GhcMod/CabalHelper.hs @@ -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)" diff --git a/Language/Haskell/GhcMod/PathsAndFiles.hs b/Language/Haskell/GhcMod/PathsAndFiles.hs index 7f0aadf..43ed020 100644 --- a/Language/Haskell/GhcMod/PathsAndFiles.hs +++ b/Language/Haskell/GhcMod/PathsAndFiles.hs @@ -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 diff --git a/Language/Haskell/GhcMod/Target.hs b/Language/Haskell/GhcMod/Target.hs index 11decbe..12f8b8a 100644 --- a/Language/Haskell/GhcMod/Target.hs +++ b/Language/Haskell/GhcMod/Target.hs @@ -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