From e34bfe297699d7a8337f47f9b372440211c5fe5e Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Mon, 18 Mar 2019 10:04:12 +0200 Subject: [PATCH] Add --global-hints flag for dot and ls dependencies This flag allows us to bypass the need for an installation of GHC for these commands, at the cost of not getting completely accurate information on packages that ship with GHC. * Fixes #4390 * Closes #4405 --- ChangeLog.md | 3 + src/Stack/Build.hs | 2 +- src/Stack/Build/ConstructPlan.hs | 13 ++-- src/Stack/Build/Execute.hs | 4 +- src/Stack/Build/Source.hs | 25 ++++---- src/Stack/Dot.hs | 107 +++++++++++++++++++++++++++---- src/Stack/Options/DotParser.hs | 4 ++ src/Stack/Package.hs | 13 ++-- src/Stack/SourceMap.hs | 1 + src/Stack/Types/Config.hs | 12 +++- src/Stack/Types/Package.hs | 40 ++++++++++-- 11 files changed, 180 insertions(+), 44 deletions(-) diff --git a/ChangeLog.md b/ChangeLog.md index 5a3ed39874..009af2e1cf 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -120,6 +120,9 @@ Other enhancements: [#4480](https://github.com/commercialhaskell/stack/issues/4480). * Add `stack purge` as a shortcut for `stack clean --full`. See [#3863](https://github.com/commercialhaskell/stack/issues/3863). +* Both `stack dot` and `stack ls dependencies` accept a + `--global-hints` flag to bypass the need for an installed GHC. See + [#4390](https://github.com/commercialhaskell/stack/issues/4390). Bug fixes: diff --git a/src/Stack/Build.hs b/src/Stack/Build.hs index db7b2f6b85..bbedb3361f 100644 --- a/src/Stack/Build.hs +++ b/src/Stack/Build.hs @@ -252,7 +252,7 @@ mkBaseConfigOpts boptsCli = do -- | Provide a function for loading package information from the package index loadPackage - :: HasEnvConfig env + :: (HasBuildConfig env, HasSourceMap env) => PackageLocationImmutable -> Map FlagName Bool -> [Text] diff --git a/src/Stack/Build/ConstructPlan.hs b/src/Stack/Build/ConstructPlan.hs index 503fb5acc2..9be0614122 100644 --- a/src/Stack/Build/ConstructPlan.hs +++ b/src/Stack/Build/ConstructPlan.hs @@ -145,6 +145,8 @@ instance HasPantryConfig Ctx where instance HasProcessContext Ctx where processContextL = configL.processContextL instance HasBuildConfig Ctx +instance HasSourceMap Ctx where + sourceMapL = envConfigL.sourceMapL instance HasEnvConfig Ctx where envConfigL = lens ctxEnvConfig (\x y -> x { ctxEnvConfig = y }) @@ -246,7 +248,7 @@ constructPlan baseConfigOpts0 localDumpPkgs loadPackage0 sourceMap installedMap getSources = do pPackages <- for (smProject sourceMap) $ \pp -> do - lp <- loadLocalPackage sourceMap pp + lp <- loadLocalPackage pp return $ PSFilePath lp bopts <- view $ configL.to configBuild deps <- for (smDeps sourceMap) $ \dp -> @@ -255,7 +257,7 @@ constructPlan baseConfigOpts0 localDumpPkgs loadPackage0 sourceMap installedMap return $ PSRemote loc (getPLIVersion loc) (dpFromSnapshot dp) (dpCommon dp) PLMutable dir -> do pp <- mkProjectPackage YesPrintWarnings dir (shouldHaddockDeps bopts) - lp <- loadLocalPackage sourceMap pp + lp <- loadLocalPackage pp return $ PSFilePath lp return $ pPackages <> deps @@ -871,8 +873,11 @@ psForceDirty :: PackageSource -> Bool psForceDirty (PSFilePath lp) = lpForceDirty lp psForceDirty PSRemote{} = False -psDirty :: MonadIO m => PackageSource -> m (Maybe (Set FilePath)) -psDirty (PSFilePath lp) = runMemoized $ lpDirtyFiles lp +psDirty + :: (MonadIO m, HasEnvConfig env, MonadReader env m) + => PackageSource + -> m (Maybe (Set FilePath)) +psDirty (PSFilePath lp) = runMemoizedWith $ lpDirtyFiles lp psDirty PSRemote {} = pure Nothing -- files never change in a remote package psLocal :: PackageSource -> Bool diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index e7decbab43..eb8f5ed944 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -1480,7 +1480,7 @@ singleBuild ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} installedMap case taskType of TTLocalMutable lp -> do when enableTests $ unsetTestSuccess pkgDir - caches <- runMemoized $ lpNewBuildCaches lp + caches <- runMemoizedWith $ lpNewBuildCaches lp mapM_ (uncurry (writeBuildCache pkgDir)) (Map.toList caches) TTRemotePackage{} -> return () @@ -1722,7 +1722,7 @@ checkExeStatus compiler platform distDir name = do -- | Check if any unlisted files have been found, and add them to the build cache. checkForUnlistedFiles :: HasEnvConfig env => TaskType -> CTime -> Path Abs Dir -> RIO env [PackageWarning] checkForUnlistedFiles (TTLocalMutable lp) preBuildTime pkgDir = do - caches <- runMemoized $ lpNewBuildCaches lp + caches <- runMemoizedWith $ lpNewBuildCaches lp (addBuildCache,warnings) <- addUnlistedToBuildCache preBuildTime diff --git a/src/Stack/Build/Source.hs b/src/Stack/Build/Source.hs index c1aac1abbc..6bf84fefa7 100644 --- a/src/Stack/Build/Source.hs +++ b/src/Stack/Build/Source.hs @@ -51,7 +51,7 @@ projectLocalPackages :: HasEnvConfig env => RIO env [LocalPackage] projectLocalPackages = do sm <- view $ envConfigL.to envConfigSourceMap - for (toList $ smProject sm) $ loadLocalPackage sm + for (toList $ smProject sm) loadLocalPackage -- | loads all local dependencies - project packages and local extra-deps localDependencies :: HasEnvConfig env => RIO env [LocalPackage] @@ -62,7 +62,7 @@ localDependencies = do case dpLocation dp of PLMutable dir -> do pp <- mkProjectPackage YesPrintWarnings dir (shouldHaddockDeps bopts) - Just <$> loadLocalPackage sourceMap pp + Just <$> loadLocalPackage pp _ -> return Nothing -- | Given the parsed targets and buld command line options constructs @@ -236,7 +236,7 @@ splitComponents = go a b c (CBench x:xs) = go a b (c . (x:)) xs loadCommonPackage :: - forall env. HasEnvConfig env + forall env. (HasBuildConfig env, HasSourceMap env) => CommonPackage -> RIO env Package loadCommonPackage common = do @@ -247,11 +247,11 @@ loadCommonPackage common = do -- | Upgrade the initial project package info to a full-blown @LocalPackage@ -- based on the selected components loadLocalPackage :: - forall env. HasEnvConfig env - => SourceMap - -> ProjectPackage + forall env. (HasBuildConfig env, HasSourceMap env) + => ProjectPackage -> RIO env LocalPackage -loadLocalPackage sm pp = do +loadLocalPackage pp = do + sm <- view sourceMapL let common = ppCommon pp bopts <- view buildOptsL mcurator <- view $ buildConfigL.to bcCurator @@ -338,10 +338,10 @@ loadLocalPackage sm pp = do testpkg = resolvePackage testconfig gpkg benchpkg = resolvePackage benchconfig gpkg - componentFiles <- memoizeRef $ fst <$> getPackageFilesForTargets pkg (ppCabalFP pp) nonLibComponents + componentFiles <- memoizeRefWith $ fst <$> getPackageFilesForTargets pkg (ppCabalFP pp) nonLibComponents - checkCacheResults <- memoizeRef $ do - componentFiles' <- runMemoized componentFiles + checkCacheResults <- memoizeRefWith $ do + componentFiles' <- runMemoizedWith componentFiles forM (Map.toList componentFiles') $ \(component, files) -> do mbuildCache <- tryGetBuildCache (ppRoot pp) component checkCacheResult <- checkBuildCache @@ -503,10 +503,11 @@ calcFci modTime' fp = liftIO $ } -- | Get 'PackageConfig' for package given its name. -getPackageConfig :: (MonadReader env m, HasEnvConfig env) +getPackageConfig + :: (HasBuildConfig env, HasSourceMap env) => Map FlagName Bool -> [Text] - -> m PackageConfig + -> RIO env PackageConfig getPackageConfig flags ghcOptions = do platform <- view platformL compilerVersion <- view actualCompilerVersionL diff --git a/src/Stack/Dot.hs b/src/Stack/Dot.hs index 750949ee99..3cf5d53cc1 100644 --- a/src/Stack/Dot.hs +++ b/src/Stack/Dot.hs @@ -26,6 +26,8 @@ import qualified Distribution.PackageDescription as PD import qualified Distribution.SPDX.License as SPDX import Distribution.License (License(BSD3), licenseFromSPDX) import Distribution.Types.PackageName (mkPackageName) +import RIO.PrettyPrint (HasTerm (..), HasStylesUpdate (..)) +import RIO.Process (HasProcessContext (..)) import Stack.Build (loadPackage) import Stack.Build.Installed (getInstalled, toInstallMap) import Stack.Build.Source @@ -37,10 +39,11 @@ import qualified Stack.Prelude (pkgName) import Stack.Runners import Stack.SourceMap import Stack.Types.Build +import Stack.Types.Compiler (wantedToActual) import Stack.Types.Config import Stack.Types.GhcPkgId import Stack.Types.SourceMap -import Stack.Build.Target(NeedTargets(..)) +import Stack.Build.Target(NeedTargets(..), parseTargets) -- | Options record for @stack dot@ data DotOpts = DotOpts @@ -60,6 +63,8 @@ data DotOpts = DotOpts -- ^ Like the "--test" flag for build, affects the meaning of 'dotTargets'. , dotBenchTargets :: Bool -- ^ Like the "--bench" flag for build, affects the meaning of 'dotTargets'. + , dotGlobalHints :: Bool + -- ^ Use global hints instead of relying on an actual GHC installation. } data ListDepsOpts = ListDepsOpts @@ -94,7 +99,7 @@ createPrunedDependencyGraph :: DotOpts -> RIO Runner (Set PackageName, Map PackageName (Set PackageName, DotPayload)) -createPrunedDependencyGraph dotOpts = withConfig $ withEnvConfigDot dotOpts $ do +createPrunedDependencyGraph dotOpts = withConfig $ withDotConfig dotOpts $ do localNames <- view $ buildConfigL.to (Map.keysSet . smwProject . bcSMWanted) resultGraph <- createDependencyGraph dotOpts let pkgsToPrune = if dotIncludeBase dotOpts @@ -109,13 +114,12 @@ createPrunedDependencyGraph dotOpts = withConfig $ withEnvConfigDot dotOpts $ do -- @resolveDependencies@. createDependencyGraph :: DotOpts - -> RIO EnvConfig (Map PackageName (Set PackageName, DotPayload)) + -> RIO DotConfig (Map PackageName (Set PackageName, DotPayload)) createDependencyGraph dotOpts = do - sourceMap <- view $ envConfigL.to envConfigSourceMap - locals <- projectLocalPackages + sourceMap <- view sourceMapL + locals <- for (toList $ smProject sourceMap) loadLocalPackage let graph = Map.fromList $ projectPackageDependencies dotOpts (filter lpWanted locals) - installMap <- toInstallMap sourceMap - (_, globalDump, _, _) <- getInstalled installMap + globalDump <- view $ to dcGlobalDump -- TODO: Can there be multiple entries for wired-in-packages? If so, -- this will choose one arbitrarily.. let globalDumpMap = Map.fromList $ map (\dp -> (Stack.Prelude.pkgName (dpPackageIdent dp), dp)) globalDump @@ -249,9 +253,9 @@ createDepLoader :: SourceMap -> Map PackageName DumpPackage -> Map GhcPkgId PackageIdentifier -> (PackageName -> Version -> PackageLocationImmutable -> - Map FlagName Bool -> [Text] -> RIO EnvConfig (Set PackageName, DotPayload)) + Map FlagName Bool -> [Text] -> RIO DotConfig (Set PackageName, DotPayload)) -> PackageName - -> RIO EnvConfig (Set PackageName, DotPayload) + -> RIO DotConfig (Set PackageName, DotPayload) createDepLoader sourceMap globalDumpMap globalIdMap loadPackageDeps pkgName = do fromMaybe noDepsErr (projectPackageDeps <|> dependencyDeps <|> globalDeps) @@ -374,14 +378,65 @@ localPackageToPackage lp = fromMaybe (lpPackage lp) (lpTestBench lp) -- Plumbing for --test and --bench flags -withEnvConfigDot +withDotConfig :: DotOpts - -> RIO EnvConfig a + -> RIO DotConfig a -> RIO Config a -withEnvConfigDot opts f = +withDotConfig opts inner = local (over globalOptsL modifyGO) $ - withEnvConfig NeedTargets boptsCLI f + if dotGlobalHints opts + then withBuildConfig withGlobalHints + else withReal where + withGlobalHints = do + bconfig <- view buildConfigL + globals <- globalsFromHints $ smwCompiler $ bcSMWanted bconfig + fakeGhcPkgId <- parseGhcPkgId "ignored" + let smActual = SMActual + { smaCompiler = wantedToActual $ smwCompiler $ bcSMWanted bconfig + , smaProject = smwProject $ bcSMWanted bconfig + , smaDeps = smwDeps $ bcSMWanted bconfig + , smaGlobal = Map.mapWithKey toDump globals + } + toDump :: PackageName -> Version -> DumpPackage + toDump name version = DumpPackage + { dpGhcPkgId = fakeGhcPkgId + , dpPackageIdent = PackageIdentifier name version + , dpParentLibIdent = Nothing + , dpLicense = Nothing + , dpLibDirs = [] + , dpLibraries = [] + , dpHasExposedModules = True + , dpExposedModules = mempty + , dpDepends = [] + , dpHaddockInterfaces = [] + , dpHaddockHtml = Nothing + , dpIsExposed = True + } + actualPkgs = Map.keysSet (smaDeps smActual) <> + Map.keysSet (smaProject smActual) + prunedActual = smActual { smaGlobal = pruneGlobals (smaGlobal smActual) actualPkgs } + targets <- parseTargets NeedTargets False boptsCLI prunedActual + sourceMap <- loadSourceMap targets boptsCLI smActual + let dc = DotConfig + { dcBuildConfig = bconfig + , dcSourceMap = sourceMap + , dcGlobalDump = toList $ smaGlobal smActual + } + runRIO dc inner + + withReal = withEnvConfig NeedTargets boptsCLI $ do + envConfig <- ask + let sourceMap = envConfigSourceMap envConfig + installMap <- toInstallMap sourceMap + (_, globalDump, _, _) <- getInstalled installMap + let dc = DotConfig + { dcBuildConfig = envConfigBuildConfig envConfig + , dcSourceMap = sourceMap + , dcGlobalDump = globalDump + } + runRIO dc inner + boptsCLI = defaultBuildOptsCLI { boptsCLITargets = dotTargets opts , boptsCLIFlags = dotFlags opts @@ -389,3 +444,29 @@ withEnvConfigDot opts f = modifyGO = (if dotTestTargets opts then set (globalOptsBuildOptsMonoidL.buildOptsMonoidTestsL) (Just True) else id) . (if dotBenchTargets opts then set (globalOptsBuildOptsMonoidL.buildOptsMonoidBenchmarksL) (Just True) else id) + +data DotConfig = DotConfig + { dcBuildConfig :: !BuildConfig + , dcSourceMap :: !SourceMap + , dcGlobalDump :: ![DumpPackage] + } +instance HasLogFunc DotConfig where + logFuncL = runnerL.logFuncL +instance HasPantryConfig DotConfig where + pantryConfigL = configL.pantryConfigL +instance HasTerm DotConfig where + useColorL = runnerL.useColorL + termWidthL = runnerL.termWidthL +instance HasStylesUpdate DotConfig where + stylesUpdateL = runnerL.stylesUpdateL +instance HasGHCVariant DotConfig +instance HasPlatform DotConfig +instance HasRunner DotConfig where + runnerL = configL.runnerL +instance HasProcessContext DotConfig where + processContextL = runnerL.processContextL +instance HasConfig DotConfig +instance HasBuildConfig DotConfig where + buildConfigL = lens dcBuildConfig (\x y -> x { dcBuildConfig = y }) +instance HasSourceMap DotConfig where + sourceMapL = lens dcSourceMap (\x y -> x { dcSourceMap = y }) diff --git a/src/Stack/Options/DotParser.hs b/src/Stack/Options/DotParser.hs index ac22d81626..8af0eb8ce5 100644 --- a/src/Stack/Options/DotParser.hs +++ b/src/Stack/Options/DotParser.hs @@ -24,6 +24,7 @@ dotOptsParser externalDefault = <*> flagsParser <*> testTargets <*> benchTargets + <*> globalHints where includeExternal = boolFlags externalDefault "external" "inclusion of external dependencies" @@ -52,6 +53,9 @@ dotOptsParser externalDefault = splitNames :: String -> [String] splitNames = map (takeWhile (not . isSpace) . dropWhile isSpace) . splitOn "," + globalHints = switch (long "global-hints" <> + help "Do not require an install GHC; instead, use a hints file for global packages") + -- | Parser for arguments to `stack list-dependencies`. listDepsOptsParser :: Parser ListDepsOpts listDepsOptsParser = ListDepsOpts diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs index 8d7659acd4..4bc7c32c0d 100644 --- a/src/Stack/Package.hs +++ b/src/Stack/Package.hs @@ -77,7 +77,7 @@ import qualified RIO.PrettyPrint as PP (Style (Module)) data Ctx = Ctx { ctxFile :: !(Path Abs File) , ctxDistDir :: !(Path Abs Dir) - , ctxEnvConfig :: !EnvConfig + , ctxBuildConfig :: !BuildConfig } instance HasPlatform Ctx @@ -96,9 +96,14 @@ instance HasPantryConfig Ctx where pantryConfigL = configL.pantryConfigL instance HasProcessContext Ctx where processContextL = configL.processContextL -instance HasBuildConfig Ctx +instance HasBuildConfig Ctx where + buildConfigL = lens ctxBuildConfig (\x y -> x { ctxBuildConfig = y }) + {- +instance HasSourceMap Ctx where + sourceMapL = envConfigL.sourceMapL instance HasEnvConfig Ctx where envConfigL = lens ctxEnvConfig (\x y -> x { ctxEnvConfig = y }) + -} -- | Read @.buildinfo@ ancillary files produced by some Setup.hs hooks. -- The file includes Cabal file syntax to be merged into the package description @@ -213,10 +218,10 @@ packageFromPackageDescription packageConfig pkgFlags (PackageDescriptionPair pkg \cabalfp -> debugBracket ("getPackageFiles" <+> pretty cabalfp) $ do let pkgDir = parent cabalfp distDir <- distDirFromDir pkgDir - env <- view envConfigL + bc <- view buildConfigL (componentModules,componentFiles,dataFiles',warnings) <- runRIO - (Ctx cabalfp distDir env) + (Ctx cabalfp distDir bc) (packageDescModulesAndFiles pkg) setupFiles <- if buildType pkg == Custom diff --git a/src/Stack/SourceMap.hs b/src/Stack/SourceMap.hs index d920ddf4e1..785d7ece58 100644 --- a/src/Stack/SourceMap.hs +++ b/src/Stack/SourceMap.hs @@ -14,6 +14,7 @@ module Stack.SourceMap , checkFlagsUsedThrowing , globalCondCheck , pruneGlobals + , globalsFromHints ) where import qualified Data.Conduit.List as CL diff --git a/src/Stack/Types/Config.hs b/src/Stack/Types/Config.hs index 45f29827c7..e2c1bab160 100644 --- a/src/Stack/Types/Config.hs +++ b/src/Stack/Types/Config.hs @@ -59,6 +59,7 @@ module Stack.Types.Config ,globalHintsFile -- ** EnvConfig & HasEnvConfig ,EnvConfig(..) + ,HasSourceMap(..) ,HasEnvConfig(..) ,getCompilerPath -- * Details @@ -1822,7 +1823,7 @@ class HasConfig env => HasBuildConfig env where envConfigBuildConfig (\x y -> x { envConfigBuildConfig = y }) -class HasBuildConfig env => HasEnvConfig env where +class (HasBuildConfig env, HasSourceMap env) => HasEnvConfig env where envConfigL :: Lens' env EnvConfig ----------------------------------- @@ -1919,11 +1920,16 @@ stackRootL = configL.lens configStackRoot (\x y -> x { configStackRoot = y }) wantedCompilerVersionL :: HasBuildConfig s => Getting r s WantedCompiler wantedCompilerVersionL = buildConfigL.to (smwCompiler . bcSMWanted) +class HasSourceMap env where + sourceMapL :: Lens' env SourceMap +instance HasSourceMap EnvConfig where + sourceMapL = lens envConfigSourceMap (\x y -> x { envConfigSourceMap = y }) + -- | The version of the compiler which will actually be used. May be -- different than that specified in the 'SnapshotDef' and returned -- by 'wantedCompilerVersionL'. -actualCompilerVersionL :: HasEnvConfig s => SimpleGetter s ActualCompiler -actualCompilerVersionL = envConfigL.to (smCompiler . envConfigSourceMap) +actualCompilerVersionL :: HasSourceMap env => SimpleGetter env ActualCompiler +actualCompilerVersionL = sourceMapL.to smCompiler buildOptsL :: HasConfig s => Lens' s BuildOpts buildOptsL = configL.lens diff --git a/src/Stack/Types/Package.hs b/src/Stack/Types/Package.hs index f1d803e58c..40bb4be351 100644 --- a/src/Stack/Types/Package.hs +++ b/src/Stack/Types/Package.hs @@ -1,6 +1,8 @@ {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE FlexibleContexts #-} @@ -270,19 +272,47 @@ data LocalPackage = LocalPackage -- ^ The .cabal file , lpBuildHaddocks :: !Bool , lpForceDirty :: !Bool - , lpDirtyFiles :: !(Memoized (Maybe (Set FilePath))) + , lpDirtyFiles :: !(MemoizedWith EnvConfig (Maybe (Set FilePath))) -- ^ Nothing == not dirty, Just == dirty. Note that the Set may be empty if -- we forced the build to treat packages as dirty. Also, the Set may not -- include all modified files. - , lpNewBuildCaches :: !(Memoized (Map NamedComponent (Map FilePath FileCacheInfo))) + , lpNewBuildCaches :: !(MemoizedWith EnvConfig (Map NamedComponent (Map FilePath FileCacheInfo))) -- ^ current state of the files - , lpComponentFiles :: !(Memoized (Map NamedComponent (Set (Path Abs File)))) + , lpComponentFiles :: !(MemoizedWith EnvConfig (Map NamedComponent (Set (Path Abs File)))) -- ^ all files used by this package } deriving Show -lpFiles :: MonadIO m => LocalPackage -> m (Set.Set (Path Abs File)) -lpFiles = runMemoized . fmap (Set.unions . M.elems) . lpComponentFiles +newtype MemoizedWith env a = MemoizedWith { unMemoizedWith :: RIO env a } + deriving (Functor, Applicative, Monad) + +memoizeRefWith :: MonadIO m => RIO env a -> m (MemoizedWith env a) +memoizeRefWith action = do + ref <- newIORef Nothing + pure $ MemoizedWith $ do + mres <- readIORef ref + res <- + case mres of + Just res -> pure res + Nothing -> do + res <- tryAny action + writeIORef ref $ Just res + pure res + either throwIO pure res + +runMemoizedWith + :: (HasEnvConfig env, MonadReader env m, MonadIO m) + => MemoizedWith EnvConfig a + -> m a +runMemoizedWith (MemoizedWith action) = do + envConfig <- view envConfigL + runRIO envConfig action + +instance Show (MemoizedWith env a) where + show _ = "<>" + +lpFiles :: HasEnvConfig env => LocalPackage -> RIO env (Set.Set (Path Abs File)) +lpFiles lp = runMemoizedWith $ fmap (Set.unions . M.elems) $ lpComponentFiles lp -- | A location to install a package into, either snapshot or local data InstallLocation = Snap | Local