Move dist dir post-unpack #157

Ugly reasoning here: happy hard-codes that dist will be used by
generating files and including them in the sdist tarball. We don't build
in dist, which causes errors if happy isn't present. This fixes it. See
the issue for more discussion
(#157).

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,18 +347,18 @@ 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
     pkgDbs <- getPackageDatabases bconfig BTDeps
     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
 
 --------------------------------------------------------------------------------

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)