Commit e8742a5c authored by Mikhail Glushenkov's avatar Mikhail Glushenkov

Make newly-added add-source deps override previously installed versions.

Fixes #1197.

This patch is a bit large because it includes several related changes:

1) Remove 'installUseSandbox' from 'InstallFlags' and pass 'useSandbox' as an
additional argument instead.

2) Instead of calling 'reinstallAddSourceDeps' from 'installAction', always pass
'SandboxPackageInfo' to 'install'.

3) Set the timestamps of newly-added add-source deps to 0 in the timestamp file.

4) Move the timestamp file update to 'postInstallActions' from
'withModifiedDeps'. This way, the timestamps are updated even when the user runs
'install --only-dependencies' or 'install some-add-source-dep-package-id'.
parent 3b5a5160
......@@ -325,7 +325,7 @@ applySandboxInstallPolicy :: SandboxPackageInfo
-> DepResolverParams
-> DepResolverParams
applySandboxInstallPolicy
(SandboxPackageInfo modifiedDeps otherDeps allSandboxPkgs)
(SandboxPackageInfo modifiedDeps otherDeps allSandboxPkgs _allDeps)
params
= addPreferences [ PackageInstalledPreference n PreferInstalled
......
......@@ -29,6 +29,7 @@ module Distribution.Client.Install (
import Data.List
( unfoldr, nub, sort, (\\) )
import qualified Data.Set as S
import Data.Maybe
( isJust, fromMaybe, maybeToList )
import Control.Exception as Exception
......@@ -66,7 +67,10 @@ import Distribution.Client.Setup
, ConfigExFlags(..), InstallFlags(..) )
import Distribution.Client.Config
( defaultCabalDir )
import Distribution.Client.Sandbox.Types ( SandboxPackageInfo(..), isUseSandbox )
import Distribution.Client.Sandbox.Timestamp
( withUpdateTimestamps )
import Distribution.Client.Sandbox.Types
( SandboxPackageInfo(..), UseSandbox(..), isUseSandbox )
import Distribution.Client.Tar (extractTarGzFile)
import Distribution.Client.Types as Source
import Distribution.Client.BuildReports.Types
......@@ -120,7 +124,8 @@ import Distribution.Version
import Distribution.Simple.Utils as Utils
( notice, info, warn, debugNoWrap, die, intercalate, withTempDirectory )
import Distribution.Client.Utils
( numberOfProcessors, inDir, mergeBy, MergeResult(..) )
( numberOfProcessors, inDir, mergeBy, MergeResult(..)
, tryCanonicalizePath )
import Distribution.System
( Platform, OS(Windows), buildOS )
import Distribution.Text
......@@ -154,6 +159,7 @@ install
-> Compiler
-> Platform
-> ProgramConfiguration
-> UseSandbox
-> Maybe SandboxPackageInfo
-> GlobalFlags
-> ConfigFlags
......@@ -162,7 +168,7 @@ install
-> HaddockFlags
-> [UserTarget]
-> IO ()
install verbosity packageDBs repos comp platform conf mSandboxPkgInfo
install verbosity packageDBs repos comp platform conf useSandbox mSandboxPkgInfo
globalFlags configFlags configExFlags installFlags haddockFlags
userTargets0 = do
......@@ -173,7 +179,7 @@ install verbosity packageDBs repos comp platform conf mSandboxPkgInfo
processInstallPlan verbosity args installContext installPlan
where
args :: InstallArgs
args = (packageDBs, repos, comp, platform, conf, mSandboxPkgInfo,
args = (packageDBs, repos, comp, platform, conf, useSandbox, mSandboxPkgInfo,
globalFlags, configFlags, configExFlags, installFlags,
haddockFlags)
......@@ -192,6 +198,7 @@ type InstallArgs = ( PackageDBStack
, Compiler
, Platform
, ProgramConfiguration
, UseSandbox
, Maybe SandboxPackageInfo
, GlobalFlags
, ConfigFlags
......@@ -203,7 +210,7 @@ type InstallArgs = ( PackageDBStack
makeInstallContext :: Verbosity -> InstallArgs -> Maybe [UserTarget]
-> IO InstallContext
makeInstallContext verbosity
(packageDBs, repos, comp, _, conf,_,
(packageDBs, repos, comp, _, conf,_,_,
globalFlags, _, _, _, _) mUserTargets = do
installedPkgIndex <- getInstalledPackages verbosity comp packageDBs conf
......@@ -233,7 +240,7 @@ makeInstallContext verbosity
makeInstallPlan :: Verbosity -> InstallArgs -> InstallContext
-> IO (Progress String String InstallPlan)
makeInstallPlan verbosity
(_, _, comp, platform, _, mSandboxPkgInfo,
(_, _, comp, platform, _, _, mSandboxPkgInfo,
_, configFlags, configExFlags, installFlags,
_)
(installedPkgIndex, sourcePkgDb,
......@@ -251,7 +258,7 @@ processInstallPlan :: Verbosity -> InstallArgs -> InstallContext
-> InstallPlan
-> IO ()
processInstallPlan verbosity
args@(_,_, _, _, _, _, _, _, _, installFlags, _)
args@(_,_, _, _, _, _, _, _, _, _, installFlags, _)
(installedPkgIndex, sourcePkgDb,
userTargets, pkgSpecifiers) installPlan = do
checkPrintPlan verbosity installedPkgIndex installPlan sourcePkgDb
......@@ -618,8 +625,8 @@ postInstallActions :: Verbosity
-> InstallPlan
-> IO ()
postInstallActions verbosity
(packageDBs, _, comp, platform, conf, _, globalFlags, configFlags
, _, installFlags, _)
(packageDBs, _, comp, platform, conf, useSandbox, mSandboxPkgInfo
,globalFlags, configFlags, _, installFlags, _)
targets installPlan = do
unless oneShot $
......@@ -643,6 +650,9 @@ postInstallActions verbosity
printBuildFailures installPlan
updateSandboxTimestampsFile useSandbox mSandboxPkgInfo
comp platform installPlan
where
reportingLevel = fromFlag (installBuildReports installFlags)
logsDir = fromFlag (globalLogsDir globalFlags)
......@@ -795,6 +805,24 @@ printBuildFailures plan =
InstallFailed e -> " failed during the final install step."
++ " The exception was:\n " ++ show e
-- | If we're working inside a sandbox and some add-source deps were installed,
-- update the timestamps of those deps.
updateSandboxTimestampsFile :: UseSandbox -> Maybe SandboxPackageInfo
-> Compiler -> Platform -> InstallPlan
-> IO ()
updateSandboxTimestampsFile (UseSandbox sandboxDir)
(Just (SandboxPackageInfo _ _ _ allAddSourceDeps))
comp platform installPlan =
withUpdateTimestamps sandboxDir (compilerId comp) platform $ \_ -> do
let allInstalled = [ pkg | InstallPlan.Installed pkg _
<- InstallPlan.toList installPlan ]
allSrcPkgs = [ pkg | ConfiguredPackage pkg _ _ _ <- allInstalled ]
allPaths = [ pth | LocalUnpackedPackage pth
<- map packageSource allSrcPkgs]
allPathsCanonical <- mapM tryCanonicalizePath allPaths
return $! filter (`S.member` allAddSourceDeps) allPathsCanonical
updateSandboxTimestampsFile _ _ _ _ _ = return ()
-- ------------------------------------------------------------
-- * Actually do the installations
......@@ -815,7 +843,7 @@ performInstallations :: Verbosity
-> InstallPlan
-> IO InstallPlan
performInstallations verbosity
(packageDBs, _, comp, _, conf,_,
(packageDBs, _, comp, _, conf, useSandbox, _,
globalFlags, configFlags, configExFlags, installFlags, haddockFlags)
installedPkgIndex installPlan = do
......@@ -921,7 +949,7 @@ performInstallations verbosity
miscOptions = InstallMisc {
rootCmd = if fromFlag (configUserInstall configFlags)
|| isUseSandbox (installUseSandbox installFlags)
|| (isUseSandbox useSandbox)
then Nothing -- ignore --root-cmd if --user
-- or working inside a sandbox.
else flagToMaybe (installRootCmd installFlags),
......
......@@ -27,6 +27,9 @@ module Distribution.Client.Sandbox (
maybeReinstallAddSourceDeps,
maybeUpdateSandboxConfig,
SandboxPackageInfo(..),
maybeWithSandboxPackageInfo,
tryGetIndexFilePath,
sandboxBuildDir,
getInstalledPackagesInSandbox,
......@@ -39,10 +42,10 @@ import Distribution.Client.Setup
( SandboxFlags(..), ConfigFlags(..), ConfigExFlags(..), InstallFlags(..)
, GlobalFlags(..), defaultConfigExFlags, defaultInstallFlags
, defaultSandboxLocation, globalRepos )
import Distribution.Client.Sandbox.Timestamp ( maybeAddCompilerTimestampRecord
import Distribution.Client.Sandbox.Timestamp ( listModifiedDeps
, maybeAddCompilerTimestampRecord
, withAddTimestamps
, withRemoveTimestamps
, withModifiedDeps )
, withRemoveTimestamps )
import Distribution.Client.Config ( SavedConfig(..), loadConfig )
import Distribution.Client.Dependency ( foldProgress )
import Distribution.Client.IndexUtils ( BuildTreeRefType(..) )
......@@ -90,12 +93,13 @@ import qualified Distribution.Client.Sandbox.Index as Index
import qualified Distribution.Simple.PackageIndex as InstalledPackageIndex
import qualified Distribution.Simple.Register as Register
import qualified Data.Map as M
import qualified Data.Set as S
import Control.Exception ( assert, bracket_ )
import Control.Monad ( forM, liftM2, unless, when )
import Data.Bits ( shiftL, shiftR, xor )
import Data.Char ( ord )
import Data.IORef ( newIORef, writeIORef, readIORef )
import Data.List ( (\\), delete, foldl' )
import Data.List ( delete, foldl' )
import Data.Monoid ( mempty, mappend )
import Data.Word ( Word32 )
import Numeric ( showHex )
......@@ -167,8 +171,13 @@ tryLoadSandboxConfig verbosity configFileFlag = do
-- | Return the name of the package index file for this package environment.
tryGetIndexFilePath :: SavedConfig -> IO FilePath
tryGetIndexFilePath config = do
let paths = globalLocalRepos . savedGlobalFlags $ config
tryGetIndexFilePath config = tryGetIndexFilePath' (savedGlobalFlags config)
-- | The same as 'tryGetIndexFilePath', but takes 'GlobalFlags' instead of
-- 'SavedConfig'.
tryGetIndexFilePath' :: GlobalFlags -> IO FilePath
tryGetIndexFilePath' globalFlags = do
let paths = globalLocalRepos globalFlags
case paths of
[] -> die $ "Distribution.Client.Sandbox.tryGetIndexFilePath: " ++
"no local repos found. " ++ checkConfiguration
......@@ -461,55 +470,42 @@ data WereDepsReinstalled = ReinstalledSomeDeps | NoDepsReinstalled
-- | Reinstall those add-source dependencies that have been modified since
-- we've last installed them. Assumes that we're working inside a sandbox.
reinstallAddSourceDeps :: Verbosity
-> SavedConfig
-> ConfigFlags -> ConfigExFlags
-> InstallFlags -> GlobalFlags
-> FilePath
-> IO WereDepsReinstalled
reinstallAddSourceDeps verbosity config configFlags' configExFlags
reinstallAddSourceDeps verbosity configFlags' configExFlags
installFlags globalFlags sandboxDir = topHandler' $ do
let sandboxDistPref = sandboxBuildDir sandboxDir
configFlags = configFlags'
{ configDistPref = Flag sandboxDistPref }
haddockFlags = mempty
{ haddockDistPref = Flag sandboxDistPref }
indexFile <- tryGetIndexFilePath config
buildTreeRefs <- Index.listBuildTreeRefs verbosity
Index.DontListIgnored Index.OnlyLinks indexFile
retVal <- newIORef NoDepsReinstalled
unless (null buildTreeRefs) $ do
(comp, platform, conf) <- configCompilerAux' configFlags
let compId = compilerId comp
withModifiedDeps verbosity sandboxDir compId platform $ \modifiedDeps -> do
assert (null $ modifiedDeps \\ buildTreeRefs) (return ())
unless (null modifiedDeps) $ do
sandboxPkgInfo <- makeSandboxPackageInfo verbosity configFlags
comp conf buildTreeRefs modifiedDeps
let modifiedAndInstalledDeps = modifiedAddSourceDependencies
sandboxPkgInfo
unless (null modifiedAndInstalledDeps) $ do
notice verbosity "Installing add-source dependencies..."
let args :: InstallArgs
args = ((configPackageDB' configFlags)
,(globalRepos globalFlags)
,comp, platform, conf, Just sandboxPkgInfo
,globalFlags, configFlags, configExFlags, installFlags
,haddockFlags)
-- This can actually be replaced by a call to 'install', but we use a
-- lower-level API because of layer separation reasons. Additionally,
-- we might want to extend this in the future.
withSandboxBinDirOnSearchPath sandboxDir $ do
installContext <- makeInstallContext verbosity args Nothing
installPlan <- foldProgress logMsg die return =<<
makeInstallPlan verbosity args installContext
processInstallPlan verbosity args installContext installPlan
writeIORef retVal ReinstalledSomeDeps
let sandboxDistPref = sandboxBuildDir sandboxDir
configFlags = configFlags'
{ configDistPref = Flag sandboxDistPref }
haddockFlags = mempty
{ haddockDistPref = Flag sandboxDistPref }
(comp, platform, conf) <- configCompilerAux' configFlags
retVal <- newIORef NoDepsReinstalled
withSandboxPackageInfo verbosity configFlags globalFlags
comp platform conf sandboxDir $ \sandboxPkgInfo ->
unless (null $ modifiedAddSourceDependencies sandboxPkgInfo) $ do
let args :: InstallArgs
args = ((configPackageDB' configFlags)
,(globalRepos globalFlags)
,comp, platform, conf
,UseSandbox sandboxDir, Just sandboxPkgInfo
,globalFlags, configFlags, configExFlags, installFlags
,haddockFlags)
-- This can actually be replaced by a call to 'install', but we use a
-- lower-level API because of layer separation reasons. Additionally, we
-- might want to use some lower-level features this in the future.
withSandboxBinDirOnSearchPath sandboxDir $ do
installContext <- makeInstallContext verbosity args Nothing
installPlan <- foldProgress logMsg die return =<<
makeInstallPlan verbosity args installContext
processInstallPlan verbosity args installContext installPlan
writeIORef retVal ReinstalledSomeDeps
readIORef retVal
......@@ -522,24 +518,34 @@ reinstallAddSourceDeps verbosity config configFlags' configExFlags
-- to be conservative.
return ReinstalledSomeDeps
-- | Given a list of all add-source deps and a list of modified add-source deps,
-- produce a 'SandboxPackageInfo'.
makeSandboxPackageInfo :: Verbosity -> ConfigFlags
-> Compiler -> ProgramConfiguration
-> [FilePath] -> [FilePath]
-> IO SandboxPackageInfo
makeSandboxPackageInfo verbosity configFlags comp conf
allAddSourceDeps modifiedAddSourceDeps = do
-- | Produce a 'SandboxPackageInfo' and feed it to the given action. Note that
-- we don't update the timestamp file here - this is done in
-- 'postInstallActions'.
withSandboxPackageInfo :: Verbosity -> ConfigFlags -> GlobalFlags
-> Compiler -> Platform -> ProgramConfiguration
-> FilePath
-> (SandboxPackageInfo -> IO ())
-> IO ()
withSandboxPackageInfo verbosity configFlags globalFlags
comp platform conf sandboxDir cont = do
-- List all add-source deps.
indexFile <- tryGetIndexFilePath' globalFlags
buildTreeRefs <- Index.listBuildTreeRefs verbosity
Index.DontListIgnored Index.OnlyLinks indexFile
let allAddSourceDepsSet = S.fromList buildTreeRefs
-- List all packages installed in the sandbox.
installedPkgIndex <- getInstalledPackagesInSandbox verbosity
configFlags comp conf
-- Get the package descriptions of all add-source deps.
depsCabalFiles <- mapM findPackageDesc allAddSourceDeps
-- Get the package descriptions for all add-source deps.
depsCabalFiles <- mapM findPackageDesc buildTreeRefs
depsPkgDescs <- mapM (readPackageDescription verbosity) depsCabalFiles
let depsMap = M.fromList (zip allAddSourceDeps depsPkgDescs)
let depsMap = M.fromList (zip buildTreeRefs depsPkgDescs)
-- Get the package ids of modified (and installed) add-source deps.
modifiedAddSourceDeps <- listModifiedDeps verbosity sandboxDir
(compilerId comp) platform
let isInstalled pkgid = not . null
. InstalledPackageIndex.lookupSourcePackageId installedPkgIndex $ pkgid
isModified path = path `elem` modifiedAddSourceDeps
......@@ -548,16 +554,38 @@ makeSandboxPackageInfo verbosity configFlags comp conf
depsMap
modifiedDeps = M.assocs modifiedDepsMap
assert (all (`S.member` allAddSourceDepsSet) modifiedAddSourceDeps) (return ())
unless (null modifiedDeps) $
notice verbosity $ "Some add-source dependencies have been modified. "
++ "They will be reinstalled..."
-- Get the package ids of the remaining add-source deps (some are possibly not
-- installed).
let otherDeps = M.assocs (depsMap `M.difference` modifiedDepsMap)
let otherDeps = M.assocs (depsMap `M.difference` modifiedDepsMap)
return $ SandboxPackageInfo (map toSourcePackage modifiedDeps)
(map toSourcePackage otherDeps) installedPkgIndex
-- Finally, assemble a 'SandboxPackageInfo'.
cont $ SandboxPackageInfo (map toSourcePackage modifiedDeps)
(map toSourcePackage otherDeps) installedPkgIndex allAddSourceDepsSet
where
toSourcePackage (path, pkgDesc) = SourcePackage
(packageId pkgDesc) pkgDesc (LocalUnpackedPackage path) Nothing
where
toSourcePackage (path, pkgDesc) = SourcePackage
(packageId pkgDesc) pkgDesc (LocalUnpackedPackage path) Nothing
-- | Same as 'withSandboxPackageInfo' if we're inside a sandbox and a no-op
-- otherwise.
maybeWithSandboxPackageInfo :: Verbosity -> ConfigFlags -> GlobalFlags
-> Compiler -> Platform -> ProgramConfiguration
-> UseSandbox
-> (Maybe SandboxPackageInfo -> IO ())
-> IO ()
maybeWithSandboxPackageInfo verbosity configFlags globalFlags
comp platform conf useSandbox cont =
case useSandbox of
NoSandbox -> cont Nothing
UseSandbox sandboxDir -> withSandboxPackageInfo verbosity
configFlags globalFlags
comp platform conf sandboxDir
(\spi -> cont (Just spi))
-- | Check if a sandbox is present and call @reinstallAddSourceDeps@ in that
-- case.
......@@ -598,8 +626,7 @@ maybeReinstallAddSourceDeps verbosity numJobsFlag configFlags' globalFlags' = do
`mappend` savedInstallFlags config
installFlags = installFlags' {
installNumJobs = installNumJobs installFlags'
`mappend` numJobsFlag,
installUseSandbox = useSandbox
`mappend` numJobsFlag
}
globalFlags = savedGlobalFlags config
-- This makes it possible to override things like
......@@ -608,7 +635,7 @@ maybeReinstallAddSourceDeps verbosity numJobsFlag configFlags' globalFlags' = do
-- fine.
`mappend` globalFlags'
depsReinstalled <- reinstallAddSourceDeps verbosity config
depsReinstalled <- reinstallAddSourceDeps verbosity
configFlags configExFlags installFlags globalFlags
sandboxDir
return (useSandbox, depsReinstalled)
......
......@@ -14,7 +14,7 @@ module Distribution.Client.Sandbox.Timestamp (
withUpdateTimestamps,
maybeAddCompilerTimestampRecord,
isDepModified,
withModifiedDeps,
listModifiedDeps,
) where
import Control.Exception (finally)
......@@ -73,13 +73,16 @@ timestampRecordKey compId platform = display platform ++ "-" ++ display compId
timestampFileName :: FilePath
timestampFileName = "add-source-timestamps"
-- | Read the timestamp file. Returns an empty list if the file doesn't exist.
readTimestampFile :: FilePath -> IO (Maybe [TimestampFileRecord])
-- | Read the timestamp file. Exits with error if the timestamp file is
-- corrupted. Returns an empty list if the file doesn't exist.
readTimestampFile :: FilePath -> IO [TimestampFileRecord]
readTimestampFile timestampFile = do
timestampString <- readFile timestampFile `catchIO` \_ -> return "[]"
case reads timestampString of
[(timestamps, s)] | all isSpace s -> return (Just timestamps)
_ -> return Nothing
[(timestamps, s)] | all isSpace s -> return timestamps
_ ->
die $ "The timestamps file is corrupted. "
++ "Please delete & recreate the sandbox."
-- | Write the timestamp file, atomically.
writeTimestampFile :: FilePath -> [TimestampFileRecord] -> IO ()
......@@ -94,25 +97,21 @@ withTimestampFile :: FilePath
-> ([TimestampFileRecord] -> IO [TimestampFileRecord])
-> IO ()
withTimestampFile sandboxDir process = do
let timestampFile = sandboxDir </> timestampFileName
mTimestampRecords <- readTimestampFile timestampFile
case mTimestampRecords of
Nothing -> die $ "The timestamps file is corrupted. "
++ "Please delete & recreate the sandbox."
Just timestampRecords -> do
timestampRecords' <- process timestampRecords
writeTimestampFile timestampFile timestampRecords'
let timestampFile = sandboxDir </> timestampFileName
timestampRecords <- readTimestampFile timestampFile >>= process
writeTimestampFile timestampFile timestampRecords
-- | Given a list of 'AddSourceTimestamp's, a list of paths to add-source deps
-- we've added and the current time, add an 'AddSourceTimestamp' to the list for
-- each path that isn't already included.
-- we've added and an initial timestamp, add an 'AddSourceTimestamp' to the list
-- for each path. If a timestamp for a given path already exists in the list,
-- update it.
addTimestamps :: EpochTime -> [AddSourceTimestamp] -> [FilePath]
-> [AddSourceTimestamp]
addTimestamps now timestamps paths =
map (\p -> (p, now)) newPaths ++ timestamps
addTimestamps initial timestamps newPaths =
[ (p, initial) | p <- newPaths ] ++ oldTimestamps
where
oldPaths = map fst timestamps
(_, newPaths) = partition (flip elem oldPaths) paths
(oldTimestamps, _toBeUpdated) =
partition (\(path, _) -> path `notElem` newPaths) timestamps
-- | Given a list of 'AddSourceTimestamp's, a list of paths to add-source deps
-- we've reinstalled and a new timestamp value, update the timestamp value for
......@@ -156,8 +155,8 @@ maybeAddCompilerTimestampRecord verbosity sandboxDir indexFile
-- build tree refs to the timestamps file (for all compilers).
withAddTimestamps :: FilePath -> IO [FilePath] -> IO ()
withAddTimestamps sandboxDir act = do
now <- getCurTime
withActionOnAllTimestamps (addTimestamps now) sandboxDir act
let initialTimestamp = 0
withActionOnAllTimestamps (addTimestamps initialTimestamp) sandboxDir act
-- | Given an IO action that returns a list of build tree refs, remove those
-- build tree refs from the timestamps file (for all compilers).
......@@ -256,14 +255,19 @@ isDepModified verbosity now (packageDir, timestamp) = do
return True
else go rest
-- | Given an IO action, feed to it the list of modified add-source deps and
-- set their timestamps to the current time in the timestamps file.
withModifiedDeps :: Verbosity -> FilePath -> CompilerId -> Platform
-> ([FilePath] -> IO ()) -> IO ()
withModifiedDeps verbosity sandboxDir compId platform act = do
withUpdateTimestamps sandboxDir compId platform $ \timestamps -> do
now <- getCurTime
modified <- fmap (map fst) . filterM (isDepModified verbosity now)
$ timestamps
act modified
return modified
-- | List all modified dependencies.
listModifiedDeps :: Verbosity -> FilePath -> CompilerId -> Platform
-> IO [FilePath]
listModifiedDeps verbosity sandboxDir compId platform = do
timestampRecords <- readTimestampFile (sandboxDir </> timestampFileName)
let needle = timestampRecordKey compId platform
timestamps <- maybe noTimestampRecord return
(lookup needle timestampRecords)
now <- getCurTime
fmap (map fst) . filterM (isDepModified verbosity now) $ timestamps
where
noTimestampRecord = die $ "Сouldn't find a timestamp record for the given "
++ "compiler/platform pair. "
++ "Please report this on the Cabal bug tracker: "
++ "https://github.com/haskell/cabal/issues/new ."
......@@ -16,6 +16,7 @@ import qualified Distribution.Simple.PackageIndex as InstalledPackageIndex
import Distribution.Client.Types (SourcePackage)
import Data.Monoid
import qualified Data.Set as S
-- | Are we using a sandbox?
data UseSandbox = UseSandbox FilePath | NoSandbox
......@@ -50,8 +51,11 @@ data SandboxPackageInfo = SandboxPackageInfo {
-- ^ Remaining add-source deps. Some of these may be not installed in the
-- sandbox.
otherInstalledSandboxPackages :: InstalledPackageIndex.PackageIndex
otherInstalledSandboxPackages :: InstalledPackageIndex.PackageIndex,
-- ^ All packages installed in the sandbox. Intersection with
-- 'modifiedAddSourceDependencies' and/or 'otherAddSourceDependencies' can be
-- non-empty.
allAddSourceDependencies :: S.Set FilePath
-- ^ A set of paths to all add-source dependencies, for convenience.
}
......@@ -45,8 +45,6 @@ import Distribution.Client.BuildReports.Types
( ReportLevel(..) )
import Distribution.Client.Dependency.Types
( PreSolver(..) )
import Distribution.Client.Sandbox.Types
( UseSandbox(..) )
import qualified Distribution.Client.Init.Types as IT
( InitFlags(..), PackageType(..) )
import Distribution.Client.Targets
......@@ -778,8 +776,7 @@ data InstallFlags = InstallFlags {
installBuildReports :: Flag ReportLevel,
installSymlinkBinDir :: Flag FilePath,
installOneShot :: Flag Bool,
installNumJobs :: Flag (Maybe Int),
installUseSandbox :: UseSandbox
installNumJobs :: Flag (Maybe Int)
}
defaultInstallFlags :: InstallFlags
......@@ -803,8 +800,7 @@ defaultInstallFlags = InstallFlags {
installBuildReports = Flag NoReports,
installSymlinkBinDir = mempty,
installOneShot = Flag False,
installNumJobs = mempty,
installUseSandbox = mempty
installNumJobs = mempty
}
where
docIndexFile = toPathTemplate ("$datadir" </> "doc" </> "index.html")
......@@ -996,8 +992,7 @@ instance Monoid InstallFlags where
installBuildReports = mempty,
installSymlinkBinDir = mempty,
installOneShot = mempty,
installNumJobs = mempty,
installUseSandbox = mempty
installNumJobs = mempty
}
mappend a b = InstallFlags {
installDocumentation = combine installDocumentation,
......@@ -1019,8 +1014,7 @@ instance Monoid InstallFlags where
installBuildReports = combine installBuildReports,
installSymlinkBinDir = combine installSymlinkBinDir,
installOneShot = combine installOneShot,
installNumJobs = combine installNumJobs,
installUseSandbox = combine installUseSandbox
installNumJobs = combine installNumJobs
}
where combine field = field a `mappend` field b
......
......@@ -77,9 +77,9 @@ import Distribution.Client.Sandbox (sandboxInit
,loadConfigOrSandboxConfig
,initPackageDBIfNeeded
,maybeWithSandboxDirOnSearchPath
,maybeWithSandboxPackageInfo
,WereDepsReinstalled(..)
,maybeReinstallAddSourceDeps
,reinstallAddSourceDeps
,maybeUpdateSandboxConfig
,tryGetIndexFilePath
,sandboxBuildDir
......@@ -471,7 +471,6 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags)
savedConfigureExFlags config `mappend` configExFlags
installFlags' = defaultInstallFlags `mappend`
savedInstallFlags config `mappend` installFlags
{ installUseSandbox = useSandbox }
globalFlags' = savedGlobalFlags config `mappend` globalFlags
haddockFlags' = haddockFlags { haddockDistPref = sandboxDistPref }
(comp, platform, conf) <- configCompilerAux' configFlags'
......@@ -493,26 +492,32 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags)
maybeAddCompilerTimestampRecord ve