From 8b0ed6631d931c747d16a69ef3265e3209218c45 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Thu, 28 May 2015 07:18:00 +0300 Subject: [PATCH] Write logs to central directory (fixes #49) --- src/Stack/Build.hs | 17 +++++++++++------ src/Stack/Package.hs | 18 +++++++++++++----- 2 files changed, 24 insertions(+), 11 deletions(-) diff --git a/src/Stack/Build.hs b/src/Stack/Build.hs index 7b6f13219e..e1d2f06a20 100644 --- a/src/Stack/Build.hs +++ b/src/Stack/Build.hs @@ -650,7 +650,8 @@ configurePackage :: (MonadAction m) -> FinalAction -> m () configurePackage cabalPkgVer bconfig setuphs buildType package gconfig setupAction = - do liftIO (void (try (removeFile (FL.toFilePath (buildLogPath package))) :: IO (Either IOException ()))) + do logPath <- liftIO $ runReaderT (buildLogPath package) bconfig + liftIO (void (try (removeFile (FL.toFilePath logPath)) :: IO (Either IOException ()))) pkgDbs <- getPackageDatabases bconfig buildType installRoot <- getInstallRoot bconfig buildType let runhaskell' = runhaskell False @@ -695,7 +696,8 @@ buildPackage :: MonadAction m -> Path Abs Dir -> m () buildPackage cabalPkgVer bopts bconfig setuphs buildType _packages package gconfig setupAction installResource _docLoc = - do liftIO (void (try (removeFile (FL.toFilePath (buildLogPath package))) :: IO (Either IOException ()))) + do logPath <- liftIO $ runReaderT (buildLogPath package) bconfig + liftIO (void (try (removeFile (FL.toFilePath logPath)) :: IO (Either IOException ()))) let runhaskell' live = runhaskell live cabalPkgVer package setuphs bconfig buildType singularBuild = S.size (bcPackages bconfig) == 1 && packageType package == PTUser runhaskell' @@ -754,7 +756,7 @@ buildPackage cabalPkgVer bopts bconfig setuphs buildType _packages package gconf --} -- | Run the Haskell command for the given package. -runhaskell :: (HasConfig config,HasBuildConfig config,MonadAction m) +runhaskell :: (HasBuildConfig config,MonadAction m) => Bool -> PackageIdentifier -> Package @@ -797,9 +799,12 @@ runhaskell liveOutput cabalPkgVer package setuphs config' buildType args = (do $logError "Stderr was:" $logError (T.decodeUtf8 errs)) liftIO (throwIO e) - withSink inner = - withBinaryFile (FL.toFilePath (buildLogPath package)) AppendMode - $ \h -> inner (stdoutToo $= sinkHandle h) + withSink inner = do + logPath <- liftIO $ runReaderT (buildLogPath package) config' + liftIO $ createDirectoryIfMissing True $ FL.toFilePath + $ parent logPath + withBinaryFile (FL.toFilePath logPath) AppendMode + $ \h -> inner (stdoutToo $= sinkHandle h) where stdoutToo = CL.mapM_ (if liveOutput then S8.putStr else (const (return ()))) logFrom src sink ref = diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs index 23a4617f7b..665bc78f94 100644 --- a/src/Stack/Package.hs +++ b/src/Stack/Package.hs @@ -460,11 +460,19 @@ getCabalFileName pkgDir = do _:_ -> throwM $ PackageMultipleCabalFilesFound pkgDir files where hasExtension fp x = FilePath.takeExtensions fp == "." ++ x --- | Path for the project's build log. -buildLogPath :: Package -> Path Abs File -buildLogPath package' = - stackageBuildDir package' - $(mkRelFile "build-log") +-- | Path for the package's build log. +buildLogPath :: (MonadReader env m, HasBuildConfig env, MonadThrow m) + => Package -> m (Path Abs File) +buildLogPath package' = do + env <- ask + let stack = configProjectWorkDir env + fp <- parseRelFile $ concat + [ packageNameString $ packageName package' + , "-" + , versionString $ packageVersion package' + , ".log" + ] + return $ stack $(mkRelDir "logs") fp -- | Path for the project's configure log. configureLogPath :: Package -> Path Abs File