From bcc767f02abaedb875fd6a76beec31923d5f867f Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Mon, 31 Aug 2015 11:01:59 +0300 Subject: [PATCH] Share binary package buils between snapshots #878 --- ChangeLog.md | 1 + src/Stack/Build/Cache.hs | 78 ++++++++++++ src/Stack/Build/ConstructPlan.hs | 7 +- src/Stack/Build/Execute.hs | 197 ++++++++++++++++++++++--------- src/Stack/SDist.hs | 2 +- src/Stack/Types/Build.hs | 87 +++++++++++--- 6 files changed, 290 insertions(+), 82 deletions(-) diff --git a/ChangeLog.md b/ChangeLog.md index 93ceca7b74..f412df391a 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -4,6 +4,7 @@ Major changes: * You now have more control over how GHC versions are matched, e.g. "use exactly this version," "use the specified minor version, but allow patches," or "use the given minor version or any later minor in the given major release." The default has switched from allowing newer later minor versions to a specific minor version allowing patches. For more information, see [#736](https://github.com/commercialhaskell/stack/issues/736) and [#784](https://github.com/commercialhaskell/stack/pull/784). * Support added for compiling with GHCJS +* stack can now reuse prebuilt binaries between snapshots. That means that, if you build package foo in LTS-3.1, that binary version can be reused in LTS-3.2, assuming it uses the same dependencies and flags. [#878](https://github.com/commercialhaskell/stack/issues/878) Other enhancements: diff --git a/src/Stack/Build/Cache.hs b/src/Stack/Build/Cache.hs index 8086af54ac..a0ef507e88 100644 --- a/src/Stack/Build/Cache.hs +++ b/src/Stack/Build/Cache.hs @@ -26,6 +26,8 @@ module Stack.Build.Cache , setBenchBuilt , unsetBenchBuilt , checkBenchBuilt + , writePrecompiledCache + , readPrecompiledCache ) where import Control.Exception.Enclosed (handleIO) @@ -33,9 +35,17 @@ import Control.Monad.Catch (MonadThrow) import Control.Monad.IO.Class import Control.Monad.Logger (MonadLogger) import Control.Monad.Reader +import qualified Crypto.Hash.SHA256 as SHA256 +import qualified Data.Binary as Binary import Data.Binary.VersionTagged +import qualified Data.ByteString.Char8 as S8 +import qualified Data.ByteString.Base64 as B64 import Data.Map (Map) import Data.Maybe (fromMaybe, mapMaybe) +import Data.Set (Set) +import qualified Data.Set as Set +import Data.Text (Text) +import qualified Data.Text as T import GHC.Generics (Generic) import Path import Path.IO @@ -271,3 +281,71 @@ checkBenchBuilt dir = liftM (fromMaybe False) (tryGetCache benchBuiltFile dir) + +-------------------------------------- +-- Precompiled Cache +-- +-- Idea is simple: cache information about packages built in other snapshots, +-- and then for identical matches (same flags, config options, dependencies) +-- just copy over the executables and reregister the libraries. +-------------------------------------- + +-- | The file containing information on the given package/configuration +-- combination. The filename contains a hash of the non-directory configure +-- options for quick lookup if there's a match. +precompiledCacheFile :: (MonadThrow m, MonadReader env m, HasEnvConfig env) + => PackageIdentifier + -> ConfigureOpts + -> m (Path Abs File) +precompiledCacheFile pkgident copts = do + ec <- asks getEnvConfig + + compiler <- parseRelDir $ T.unpack $ compilerVersionName $ envConfigCompilerVersion ec + cabal <- parseRelDir $ versionString $ envConfigCabalVersion ec + pkg <- parseRelDir $ packageIdentifierString pkgident + + -- We only pay attention to non-directory options. We don't want to avoid a + -- cache hit just because it was installed in a different directory. + copts' <- parseRelFile $ S8.unpack $ B64.encode $ SHA256.hashlazy $ Binary.encode $ coNoDirs copts + + return $ getStackRoot ec + $(mkRelDir "precompiled") + compiler + cabal + pkg + copts' + +-- | Write out information about a newly built package +writePrecompiledCache :: (MonadThrow m, MonadReader env m, HasEnvConfig env, MonadIO m) + => BaseConfigOpts + -> PackageIdentifier + -> ConfigureOpts + -> Maybe GhcPkgId -- ^ library + -> Set Text -- ^ executables + -> m () +writePrecompiledCache baseConfigOpts pkgident copts mghcPkgId exes = do + file <- precompiledCacheFile pkgident copts + createTree $ parent file + mlibpath <- + case mghcPkgId of + Nothing -> return Nothing + Just ipid -> liftM Just $ do + ipid' <- parseRelFile $ ghcPkgIdString ipid ++ ".conf" + return $ toFilePath $ bcoSnapDB baseConfigOpts ipid' + exes' <- forM (Set.toList exes) $ \exe -> do + name <- parseRelFile $ T.unpack exe + return $ toFilePath $ bcoSnapInstallRoot baseConfigOpts bindirSuffix name + liftIO $ encodeFile (toFilePath file) PrecompiledCache + { pcLibrary = mlibpath + , pcExes = exes' + } + +-- | Check the cache for a precompiled package matching the given +-- configuration. +readPrecompiledCache :: (MonadThrow m, MonadReader env m, HasEnvConfig env, MonadIO m) + => PackageIdentifier -- ^ target package + -> ConfigureOpts + -> m (Maybe PrecompiledCache) +readPrecompiledCache pkgident copts = do + file <- precompiledCacheFile pkgident copts + decodeFileOrFailDeep $ toFilePath file diff --git a/src/Stack/Build/ConstructPlan.hs b/src/Stack/Build/ConstructPlan.hs index a0cf273761..e604028d03 100644 --- a/src/Stack/Build/ConstructPlan.hs +++ b/src/Stack/Build/ConstructPlan.hs @@ -28,7 +28,7 @@ import Data.Set (Set) import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T -import Data.Text.Encoding (encodeUtf8, decodeUtf8With) +import Data.Text.Encoding (decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) import Distribution.Package (Dependency (..)) import Distribution.Version (anyVersion) @@ -423,7 +423,7 @@ checkDirtiness ps installed package present wanted = do package buildOpts = bcoBuildOpts (baseConfigOpts ctx) wantConfigCache = ConfigCache - { configCacheOpts = map encodeUtf8 configOpts + { configCacheOpts = configOpts , configCacheDeps = present , configCacheComponents = case ps of @@ -474,7 +474,8 @@ describeConfigDiff old new ] userOpts = filter (not . isStackOpt) - . map (decodeUtf8With lenientDecode) + . map T.pack + . (\(ConfigureOpts x y) -> x ++ y) . configCacheOpts (oldOpts, newOpts) = removeMatching (userOpts old) (userOpts new) diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index 942fbe1f50..053bc4ef85 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -51,7 +51,6 @@ import qualified Data.Streaming.Process as Process import Data.Traversable (forM) import Data.Text (Text) import qualified Data.Text as T -import Data.Text.Encoding (encodeUtf8) import Data.Word8 (_colon) import Distribution.System (OS (Windows), Platform (Platform)) @@ -526,17 +525,44 @@ toActions installedMap runInBase ee (mbuild, mfinal) = topts = boptsTestOpts bopts beopts = boptsBenchmarkOpts bopts +-- | Generate the ConfigCache +getConfigCache :: MonadIO m + => ExecuteEnv -> Task -> [Text] + -> m ConfigCache +getConfigCache ExecuteEnv {..} Task {..} extra = do + idMap <- liftIO $ readTVarIO eeGhcPkgIds + let getMissing ident = + case Map.lookup ident idMap of + Nothing -> error "singleBuild: invariant violated, missing package ID missing" + Just (Library x) -> Just x + Just (Executable _) -> Nothing + missing' = Set.fromList $ mapMaybe getMissing $ Set.toList missing + TaskConfigOpts missing mkOpts = taskConfigOpts + opts = mkOpts missing' + allDeps = Set.union missing' taskPresent + return ConfigCache + { configCacheOpts = opts + { coNoDirs = coNoDirs opts ++ map T.unpack extra + } + , configCacheDeps = allDeps + , configCacheComponents = + case taskType of + TTLocal lp -> Set.map renderComponent $ lpComponents lp + TTUpstream _ _ -> Set.empty + , configCacheHaddock = + shouldHaddockPackage eeBuildOpts eeWanted (packageIdentifierName taskProvides) + } + -- | Ensure that the configuration for the package matches what is given ensureConfig :: M env m - => Path Abs Dir -- ^ package directory + => ConfigCache -- ^ newConfigCache + -> Path Abs Dir -- ^ package directory -> ExecuteEnv - -> Task -> m () -- ^ announce -> (Bool -> [String] -> m ()) -- ^ cabal -> Path Abs File -- ^ .cabal file - -> [Text] - -> m (ConfigCache, Bool) -ensureConfig pkgDir ExecuteEnv {..} Task {..} announce cabal cabalfp extra = do + -> m Bool +ensureConfig newConfigCache pkgDir ExecuteEnv {..} announce cabal cabalfp = do -- Determine the old and new configuration in the local directory, to -- determine if we need to reconfigure. mOldConfigCache <- tryGetConfigCache pkgDir @@ -544,37 +570,24 @@ ensureConfig pkgDir ExecuteEnv {..} Task {..} announce cabal cabalfp extra = do mOldCabalMod <- tryGetCabalMod pkgDir newCabalMod <- liftIO (fmap modTime (D.getModificationTime (toFilePath cabalfp))) - idMap <- liftIO $ readTVarIO eeGhcPkgIds - let getMissing ident = - case Map.lookup ident idMap of - Nothing -> error "singleBuild: invariant violated, missing package ID missing" - Just (Library x) -> Just x - Just (Executable _) -> Nothing - missing' = Set.fromList $ mapMaybe getMissing $ Set.toList missing - TaskConfigOpts missing mkOpts = taskConfigOpts - configOpts = mkOpts missing' ++ extra - allDeps = Set.union missing' taskPresent - newConfigCache = ConfigCache - { configCacheOpts = map encodeUtf8 configOpts - , configCacheDeps = allDeps - , configCacheComponents = - case taskType of - TTLocal lp -> Set.map renderComponent $ lpComponents lp - TTUpstream _ _ -> Set.empty - , configCacheHaddock = - shouldHaddockPackage eeBuildOpts eeWanted (packageIdentifierName taskProvides) - } - let needConfig = mOldConfigCache /= Just newConfigCache || mOldCabalMod /= Just newCabalMod + ConfigureOpts dirs nodirs = configCacheOpts newConfigCache when needConfig $ withMVar eeConfigureLock $ \_ -> do deleteCaches pkgDir announce - cabal False $ "configure" : map T.unpack configOpts + cabal False $ "configure" : dirs ++ nodirs writeConfigCache pkgDir newConfigCache writeCabalMod pkgDir newCabalMod - return (newConfigCache, needConfig) + return needConfig + +announceTask :: MonadLogger m => Task -> Text -> m () +announceTask task x = $logInfo $ T.concat + [ T.pack $ packageIdentifierString $ taskProvides task + , ": " + , x + ] withSingleContext :: M env m => (m () -> IO ()) @@ -597,11 +610,7 @@ withSingleContext runInBase ActionContext {..} ExecuteEnv {..} task@Task {..} ms withCabal package pkgDir mlogFile $ \cabal -> inner0 package cabalfp pkgDir cabal announce console mlogFile where - announce x = $logInfo $ T.concat - [ T.pack $ packageIdentifierString taskProvides - , ": " - , x - ] + announce = announceTask task wanted = case taskType of @@ -777,22 +786,90 @@ singleBuild :: M env m -> Task -> InstalledMap -> m () -singleBuild runInBase ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} installedMap = - withSingleContext runInBase ac ee task Nothing $ \package cabalfp pkgDir cabal announce console _mlogFile -> do - (cache, _neededConfig) <- ensureConfig pkgDir ee task (announce "configure") cabal cabalfp $ - -- We enable tests if the test suite dependencies are already - -- installed, so that we avoid unnecessary recompilation based on - -- cabal_macros.h changes when switching between 'stack build' and - -- 'stack test'. See: - -- https://github.com/commercialhaskell/stack/issues/805 - case taskType of - TTLocal lp -> concat - [ ["--enable-tests" | depsPresent installedMap $ lpTestDeps lp] - , ["--enable-benchmarks" | depsPresent installedMap $ lpBenchDeps lp] +singleBuild runInBase ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} installedMap = do + cache <- getCache + mprecompiled <- getPrecompiled cache + minstalled <- + case mprecompiled of + Just precompiled -> copyPreCompiled precompiled + Nothing -> realConfigAndBuild cache + case minstalled of + Nothing -> return () + Just installed -> do + writeFlagCache installed cache + liftIO $ atomically $ modifyTVar eeGhcPkgIds $ Map.insert taskProvides installed + where + pname = packageIdentifierName taskProvides + shouldHaddockPackage' = shouldHaddockPackage eeBuildOpts eeWanted pname + doHaddock package = shouldHaddockPackage' && + -- Works around haddock failing on bytestring-builder since it has no modules + -- when bytestring is new enough. + packageHasExposedModules package + + getCache = do + let extra = + -- We enable tests if the test suite dependencies are already + -- installed, so that we avoid unnecessary recompilation based on + -- cabal_macros.h changes when switching between 'stack build' and + -- 'stack test'. See: + -- https://github.com/commercialhaskell/stack/issues/805 + case taskType of + TTLocal lp -> concat + [ ["--enable-tests" | depsPresent installedMap $ lpTestDeps lp] + , ["--enable-benchmarks" | depsPresent installedMap $ lpBenchDeps lp] + ] + _ -> [] + getConfigCache ee task extra + + getPrecompiled cache = + case taskLocation task of + Snap | not shouldHaddockPackage' -> do + mpc <- readPrecompiledCache taskProvides $ configCacheOpts cache + case mpc of + Nothing -> return Nothing + Just pc -> do + let allM _ [] = return True + allM f (x:xs) = do + b <- f x + if b then allM f xs else return False + b <- liftIO $ allM D.doesFileExist $ maybe id (:) (pcLibrary pc) $ pcExes pc + return $ if b then Just pc else Nothing + _ -> return Nothing + + copyPreCompiled (PrecompiledCache mlib exes) = do + announceTask task "copying precompiled package" + forM_ mlib $ \libpath -> do + menv <- getMinimalEnvOverride + readProcessNull Nothing menv "ghc-pkg" + [ "register" + , "--no-user-package-db" + , "--package-db=" ++ toFilePath (bcoSnapDB eeBaseConfigOpts) + , "--force" + , libpath ] - _ -> [] + liftIO $ forM_ exes $ \exe -> D.copyFile exe bindir -- FIXME use hard links on Unix - unless (boptsOnlyConfigure eeBuildOpts) $ do + -- Find the package in the database + wc <- getWhichCompiler + let pkgDbs = [bcoSnapDB eeBaseConfigOpts] + mpkgid <- findGhcPkgId eeEnvOverride wc pkgDbs pname + + return $ Just $ + case mpkgid of + Nothing -> Executable taskProvides + Just pkgid -> Library pkgid + where + bindir = toFilePath $ bcoSnapInstallRoot eeBaseConfigOpts bindirSuffix + + realConfigAndBuild cache = withSingleContext runInBase ac ee task Nothing + $ \package cabalfp pkgDir cabal announce console _mlogFile -> do + _neededConfig <- ensureConfig cache pkgDir ee (announce "configure") cabal cabalfp + + if boptsOnlyConfigure eeBuildOpts + then return Nothing + else liftM Just $ realBuild cache package pkgDir cabal announce console + + realBuild cache package pkgDir cabal announce console = do wc <- getWhichCompiler markExeNotInstalled (taskLocation task) taskProvides @@ -800,7 +877,7 @@ singleBuild runInBase ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} in TTLocal lp -> writeBuildCache pkgDir $ lpNewBuildCache lp TTUpstream _ _ -> return () - announce "build" + () <- announce "build" config <- asks getConfig extraOpts <- extraBuildOptions cabal (console && configHideTHLoading config) $ @@ -817,11 +894,7 @@ singleBuild runInBase ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} in ] TTUpstream _ _ -> ["build"]) ++ extraOpts - let doHaddock = shouldHaddockPackage eeBuildOpts eeWanted (packageName package) && - -- Works around haddock failing on bytestring-builder since it has no modules - -- when bytestring is new enough. - packageHasExposedModules package - when doHaddock $ do + when (doHaddock package) $ do announce "haddock" hscolourExists <- doesExecutableExist eeEnvOverride "HsColour" unless hscolourExists $ $logWarn @@ -851,10 +924,8 @@ singleBuild runInBase ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} in (packageVersion package) (True, Nothing) -> throwM $ Couldn'tFindPkgId $ packageName package (True, Just pkgid) -> return $ Library pkgid - writeFlagCache mpkgid' cache - liftIO $ atomically $ modifyTVar eeGhcPkgIds $ Map.insert taskProvides mpkgid' - when (doHaddock && shouldHaddockDeps eeBuildOpts) $ + when (doHaddock package && shouldHaddockDeps eeBuildOpts) $ withMVar eeInstallLock $ \() -> copyDepHaddocks eeEnvOverride @@ -864,6 +935,12 @@ singleBuild runInBase ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} in (PackageIdentifier (packageName package) (packageVersion package)) Set.empty + case taskLocation task of + Snap -> writePrecompiledCache eeBaseConfigOpts taskProvides (configCacheOpts cache) mpkgid (packageExes package) + Local -> return () + + return mpkgid' + -- | Determine if all of the dependencies given are installed depsPresent :: InstalledMap -> Map PackageName VersionRange -> Bool depsPresent installedMap deps = all @@ -884,13 +961,14 @@ singleTest :: M env m -> m () singleTest runInBase topts lptb ac ee task installedMap = withSingleContext runInBase ac ee task (Just "test") $ \package cabalfp pkgDir cabal announce console mlogFile -> do - (_cache, neededConfig) <- ensureConfig pkgDir ee task (announce "configure (test)") cabal cabalfp $ + cache <- getConfigCache ee task $ case taskType task of TTLocal lp -> concat [ ["--enable-tests"] , ["--enable-benchmarks" | depsPresent installedMap $ lpBenchDeps lp] ] _ -> [] + neededConfig <- ensureConfig cache pkgDir ee (announce "configure (test)") cabal cabalfp config <- asks getConfig testBuilt <- checkTestBuilt pkgDir @@ -1034,13 +1112,14 @@ singleBench :: M env m -> m () singleBench runInBase beopts _lptb ac ee task installedMap = withSingleContext runInBase ac ee task (Just "bench") $ \_package cabalfp pkgDir cabal announce console _mlogFile -> do - (_cache, neededConfig) <- ensureConfig pkgDir ee task (announce "configure (benchmarks)") cabal cabalfp $ + cache <- getConfigCache ee task $ case taskType task of TTLocal lp -> concat [ ["--enable-tests" | depsPresent installedMap $ lpTestDeps lp] , ["--enable-benchmarks"] ] _ -> [] + neededConfig <- ensureConfig cache pkgDir ee (announce "configure (benchmarks)") cabal cabalfp benchBuilt <- checkBenchBuilt pkgDir diff --git a/src/Stack/SDist.hs b/src/Stack/SDist.hs index 5b1a0cf518..7c2f8cb749 100644 --- a/src/Stack/SDist.hs +++ b/src/Stack/SDist.hs @@ -126,7 +126,7 @@ getSDistFileList lp = , taskType = TTLocal lp , taskConfigOpts = TaskConfigOpts { tcoMissing = Set.empty - , tcoOpts = \_ -> [] + , tcoOpts = \_ -> ConfigureOpts [] [] } , taskPresent = Set.empty } diff --git a/src/Stack/Types/Build.hs b/src/Stack/Types/Build.hs index 344897a862..32c88712ce 100644 --- a/src/Stack/Types/Build.hs +++ b/src/Stack/Types/Build.hs @@ -35,7 +35,9 @@ module Stack.Types.Build ,configureOpts ,BadDependency(..) ,wantedLocalPackages - ,FileCacheInfo (..)) + ,FileCacheInfo (..) + ,ConfigureOpts (..) + ,PrecompiledCache (..)) where import Control.DeepSeq @@ -486,7 +488,7 @@ newtype PkgDepsOracle = -- | Stored on disk to know whether the flags have changed or any -- files have changed. data ConfigCache = ConfigCache - { configCacheOpts :: ![S.ByteString] + { configCacheOpts :: !ConfigureOpts -- ^ All options used for this package. , configCacheDeps :: !(Set GhcPkgId) -- ^ The GhcPkgIds of all of the dependencies. Since Cabal doesn't take @@ -518,7 +520,7 @@ data Task = Task data TaskConfigOpts = TaskConfigOpts { tcoMissing :: !(Set PackageIdentifier) -- ^ Dependencies for which we don't yet have an GhcPkgId - , tcoOpts :: !(Set GhcPkgId -> [Text]) + , tcoOpts :: !(Set GhcPkgId -> ConfigureOpts) -- ^ Produce the list of options given the missing @GhcPkgId@s } instance Show TaskConfigOpts where @@ -569,13 +571,21 @@ configureOpts :: EnvConfig -> Bool -- ^ wanted? -> InstallLocation -> Package - -> [Text] -configureOpts econfig bco deps wanted loc package = map T.pack $ concat + -> ConfigureOpts +configureOpts econfig bco deps wanted loc package = ConfigureOpts + { coDirs = configureOptsDirs bco loc package + , coNoDirs = configureOptsNoDir econfig bco deps wanted package + } + +configureOptsDirs :: BaseConfigOpts + -> InstallLocation + -> Package + -> [String] +configureOptsDirs bco loc package = concat [ ["--user", "--package-db=clear", "--package-db=global"] , map (("--package-db=" ++) . toFilePath) $ case loc of Snap -> [bcoSnapDB bco] Local -> [bcoSnapDB bco, bcoLocalDB bco] - , depOptions , [ "--libdir=" ++ toFilePathNoTrailingSlash (installRoot $(mkRelDir "lib")) , "--bindir=" ++ toFilePathNoTrailingSlash (installRoot bindirSuffix) , "--datadir=" ++ toFilePathNoTrailingSlash (installRoot $(mkRelDir "share")) @@ -584,6 +594,31 @@ configureOpts econfig bco deps wanted loc package = map T.pack $ concat , "--docdir=" ++ toFilePathNoTrailingSlash docDir , "--htmldir=" ++ toFilePathNoTrailingSlash docDir , "--haddockdir=" ++ toFilePathNoTrailingSlash docDir] + ] + where + toFilePathNoTrailingSlash = dropTrailingPathSeparator . toFilePath + installRoot = + case loc of + Snap -> bcoSnapInstallRoot bco + Local -> bcoLocalInstallRoot bco + docDir = + case pkgVerDir of + Nothing -> installRoot docDirSuffix + Just dir -> installRoot docDirSuffix dir + pkgVerDir = + parseRelDir (packageIdentifierString (PackageIdentifier (packageName package) + (packageVersion package)) ++ + [pathSeparator]) + +-- | Same as 'configureOpts', but does not include directory path options +configureOptsNoDir :: EnvConfig + -> BaseConfigOpts + -> Set GhcPkgId -- ^ dependencies + -> Bool -- ^ wanted? + -> Package + -> [String] +configureOptsNoDir econfig bco deps wanted package = concat + [ depOptions , ["--enable-library-profiling" | boptsLibProfile bopts || boptsExeProfile bopts] , ["--enable-executable-profiling" | boptsExeProfile bopts] , map (\(name,enabled) -> @@ -604,19 +639,6 @@ configureOpts econfig bco deps wanted loc package = map T.pack $ concat where config = getConfig econfig bopts = bcoBuildOpts bco - toFilePathNoTrailingSlash = dropTrailingPathSeparator . toFilePath - docDir = - case pkgVerDir of - Nothing -> installRoot docDirSuffix - Just dir -> installRoot docDirSuffix dir - installRoot = - case loc of - Snap -> bcoSnapInstallRoot bco - Local -> bcoLocalInstallRoot bco - pkgVerDir = - parseRelDir (packageIdentifierString (PackageIdentifier (packageName package) - (packageVersion package)) ++ - [pathSeparator]) depOptions = map toDepOption $ Set.toList deps where @@ -665,3 +687,30 @@ modTime x = data Installed = Library GhcPkgId | Executable PackageIdentifier deriving (Show, Eq, Ord) + +-- | Configure options to be sent to Setup.hs configure +data ConfigureOpts = ConfigureOpts + { coDirs :: ![String] + -- ^ Options related to various paths. We separate these out since they do + -- not have an impact on the contents of the compiled binary for checking + -- if we can use an existing precompiled cache. + , coNoDirs :: ![String] + } + deriving (Show, Eq, Generic) +instance Binary ConfigureOpts +instance NFData ConfigureOpts where + rnf = genericRnf + +-- | Information on a compiled package: the library conf file (if relevant), +-- and all of the executable paths. +data PrecompiledCache = PrecompiledCache + -- Use FilePath instead of Path Abs File for Binary instances + { pcLibrary :: !(Maybe FilePath) + -- ^ .conf file inside the package database + , pcExes :: ![FilePath] + -- ^ Full paths to executables + } + deriving (Show, Eq, Generic) +instance Binary PrecompiledCache +instance NFData PrecompiledCache where + rnf = genericRnf