Write logs to central directory (fixes #49)

commercialhaskell · May 28, 2015 · 8b0ed66 · 8b0ed66
1 parent 7bb65fb
commit 8b0ed66
Show file tree

Hide file tree

Showing 2 changed files with 24 additions and 11 deletions.
diff --git 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
@@ -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