diff --git a/src/Stack/Build.hs b/src/Stack/Build.hs index 2be10ceb06..eca44f3611 100644 --- a/src/Stack/Build.hs +++ b/src/Stack/Build.hs @@ -84,9 +84,11 @@ import System.Posix.Files (createSymbolicLink,removeLink) build :: (MonadIO m,MonadReader env m,HasHttpManager env,HasBuildConfig env,MonadLogger m,MonadBaseControl IO m,MonadCatch m,MonadMask m,HasLogLevel env) => BuildOpts -> m () build bopts = do + cabalPkgVer <- getMinimalEnvOverride >>= getCabalPkgVer + -- FIXME currently this will install all dependencies for the entire -- project even if just building a subset of the project - locals <- determineLocals bopts + locals <- determineLocals cabalPkgVer bopts localsWanted <- checkWanted locals bopts ranges <- getDependencyRanges locals dependencies <- getDependencies locals $ @@ -96,7 +98,7 @@ build bopts = do Left _ -> M.empty Right names -> M.fromList $ map (, M.empty) names) - installDependencies bopts dependencies + installDependencies cabalPkgVer bopts dependencies toRemove <- getPackagesToRemove (Set.map packageIdentifier (S.fromList locals)) buildLocals bopts localsWanted toRemove @@ -173,14 +175,16 @@ getPackagesToRemove toInstall = do -- include any dependencies. determineLocals :: (MonadIO m,MonadReader env m,HasHttpManager env,HasBuildConfig env,MonadLogger m,MonadBaseControl IO m,MonadCatch m,MonadMask m) - => BuildOpts + => PackageIdentifier -- ^ Cabal version + -> BuildOpts -> m [Package] -determineLocals bopts = do +determineLocals cabalPkgVer bopts = do bconfig <- asks getBuildConfig $logDebug "Unpacking packages as necessary" menv <- getMinimalEnvOverride - paths2 <- unpackPackageIdents menv (configLocalUnpackDir bconfig) + mdist <- liftM Just $ distRelativeDir cabalPkgVer + paths2 <- unpackPackageIdents menv (configLocalUnpackDir bconfig) mdist $ Set.fromList $ map fromTuple $ M.toList @@ -343,10 +347,11 @@ getDependencies locals ranges = do -- | Install the given set of dependencies into the dependency database, if missing. installDependencies :: (MonadIO m,MonadReader env m,HasLogLevel env,HasHttpManager env,HasBuildConfig env,MonadLogger m,MonadBaseControl IO m,MonadCatch m,MonadMask m) - => BuildOpts + => PackageIdentifier -- ^ Cabal version + -> BuildOpts -> Map PackageName (Version, Map FlagName Bool) -> m () -installDependencies bopts deps' = do +installDependencies cabalPkgVer bopts deps' = do bconfig <- asks getBuildConfig mgr <- asks getHttpManager logLevel <- asks getLogLevel @@ -354,7 +359,6 @@ installDependencies bopts deps' = do menv <- getMinimalEnvOverride installed <- liftM toIdents $ getPackageVersionMapWithGlobalDb menv Nothing pkgDbs - cabalPkgVer <- getCabalPkgVer menv let toInstall' = M.difference deps installed -- Get rid of non-library dependencies which are already installed @@ -376,7 +380,7 @@ installDependencies bopts deps' = do then dryRunPrint "dependencies" mempty (S.fromList (M.keys toInstall)) else do $logInfo $ "Installing dependencies: " <> T.intercalate ", " (map packageIdentifierText (M.keys toInstall)) - withTempUnpacked (M.keys toInstall) $ \newPkgDirs -> do + withTempUnpacked cabalPkgVer (M.keys toInstall) $ \newPkgDirs -> do $logInfo "All dependencies unpacked" packages <- liftM S.fromList $ forM newPkgDirs $ \dir -> do cabalfp <- getCabalFileName dir @@ -1303,13 +1307,15 @@ newConfig gconfig bopts package = -- | Fetch and unpack the package. withTempUnpacked :: (MonadIO m,MonadThrow m,MonadLogger m,MonadMask m,MonadReader env m,HasHttpManager env,HasConfig env,MonadBaseControl IO m) - => [PackageIdentifier] + => PackageIdentifier -- ^ Cabal version + -> [PackageIdentifier] -> ([Path Abs Dir] -> m a) -> m a -withTempUnpacked pkgs inner = withSystemTempDirectory "stack-unpack" $ \tmp -> do +withTempUnpacked cabalPkgVer pkgs inner = withSystemTempDirectory "stack-unpack" $ \tmp -> do dest <- parseAbsDir tmp menv <- getMinimalEnvOverride - m <- unpackPackageIdents menv dest $ Set.fromList pkgs + mdist <- liftM Just $ distRelativeDir cabalPkgVer + m <- unpackPackageIdents menv dest mdist $ Set.fromList pkgs inner $ M.elems m -------------------------------------------------------------------------------- diff --git a/src/Stack/Fetch.hs b/src/Stack/Fetch.hs index 2887490640..d6ad208272 100644 --- a/src/Stack/Fetch.hs +++ b/src/Stack/Fetch.hs @@ -29,8 +29,7 @@ import Control.Concurrent.STM (TVar, atomically, modifyTVar, readTVarIO, writeTVar) import Control.Exception (Exception, SomeException, throwIO, toException) -import Control.Monad (liftM) -import Control.Monad (join, unless) +import Control.Monad (liftM, when, join, unless) import Control.Monad.Catch (MonadThrow, throwM) import Control.Monad.IO.Class import Control.Monad.Logger @@ -65,7 +64,8 @@ import Path import System.Directory (canonicalizePath, createDirectoryIfMissing, doesDirectoryExist, - doesFileExist, renameFile) + doesFileExist, renameFile, + renameDirectory) import System.FilePath (takeDirectory, (<.>)) import qualified System.FilePath as FP import System.IO (IOMode (ReadMode, WriteMode), @@ -108,7 +108,7 @@ unpackPackages menv dest input = do ToFetchResult toFetch alreadyUnpacked <- getToFetch dest' resolved unless (Map.null alreadyUnpacked) $ throwM $ UnpackDirectoryAlreadyExists $ Set.fromList $ map toFilePath $ Map.elems alreadyUnpacked - unpacked <- fetchPackages toFetch + unpacked <- fetchPackages Nothing toFetch F.forM_ (Map.toList unpacked) $ \(ident, dest'') -> $logInfo $ T.pack $ concat [ "Unpacked " , packageIdentifierString ident @@ -131,12 +131,13 @@ unpackPackageIdents :: (MonadBaseControl IO m, MonadIO m, MonadReader env m, HasHttpManager env, HasConfig env, MonadThrow m, MonadLogger m) => EnvOverride -> Path Abs Dir -- ^ unpack directory + -> Maybe (Path Rel Dir) -- ^ the dist rename directory, see: https://github.com/fpco/stack/issues/157 -> Set PackageIdentifier -> m (Map PackageIdentifier (Path Abs Dir)) -unpackPackageIdents menv unpackDir idents = do +unpackPackageIdents menv unpackDir mdistDir idents = do resolved <- resolvePackages menv idents Set.empty ToFetchResult toFetch alreadyUnpacked <- getToFetch unpackDir resolved - nowUnpacked <- fetchPackages toFetch + nowUnpacked <- fetchPackages mdistDir toFetch return $ alreadyUnpacked <> nowUnpacked data ResolvedPackage = ResolvedPackage @@ -269,9 +270,10 @@ getToFetch dest resolvedAll = do -- -- Since 0.1.0.0 fetchPackages :: (MonadIO m,MonadReader env m,HasHttpManager env,HasConfig env,MonadLogger m,MonadThrow m,MonadBaseControl IO m) - => Map PackageIdentifier ToFetch + => Maybe (Path Rel Dir) -- ^ the dist rename directory, see: https://github.com/fpco/stack/issues/157 + -> Map PackageIdentifier ToFetch -> m (Map PackageIdentifier (Path Abs Dir)) -fetchPackages toFetchAll = do +fetchPackages mdistDir toFetchAll = do env <- ask let man = getHttpManager env config = getConfig env @@ -341,12 +343,25 @@ fetchPackages toFetchAll = do -- resources lbs <- L.hGetContents h let entries = fmap (either wrap wrap) - $ Tar.checkTarbomb (packageIdentifierString ident) + $ Tar.checkTarbomb identStr $ Tar.read $ decompress lbs wrap :: Exception e => e -> FetchException wrap = Couldn'tReadPackageTarball fp . toException + identStr = packageIdentifierString ident Tar.unpack dest entries + case mdistDir of + Nothing -> return () + -- See: https://github.com/fpco/stack/issues/157 + Just distDir -> do + let inner = dest FP. identStr + oldDist = inner FP. "dist" + newDist = inner FP. toFilePath distDir + exists <- doesDirectoryExist oldDist + when exists $ do + createDirectoryIfMissing True $ FP.takeDirectory newDist + renameDirectory oldDist newDist + let cabalFP = innerDest FP. packageNameString (packageIdentifierName ident)