diff --git a/ChangeLog.md b/ChangeLog.md index 0c90f8395e..9bfe73bd94 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -17,6 +17,9 @@ Other enhancements: Bug fixes: +* Show absolute paths in error messages in multi-package builds + [#1348](https://github.com/commercialhaskell/stack/issues/1348) + ## 0.1.8.0 Major changes: diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index 786a627885..551fa6e39b 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -821,19 +821,22 @@ withSingleContext runInBase ActionContext {..} ExecuteEnv {..} task@Task {..} md case ec of ExitSuccess -> return () _ -> do - bs <- liftIO $ + bss <- case mlogFile of - Nothing -> return "" + Nothing -> return [] Just (logFile, h) -> do - hClose h - S.readFile $ toFilePath logFile + liftIO $ hClose h + runResourceT + $ CB.sourceFile (toFilePath logFile) + $$ mungeBuildOutput stripTHLoading makeAbsolute pkgDir + =$ CL.consume throwM $ CabalExitedUnsuccessfully ec taskProvides exeName fullArgs (fmap fst mlogFile) - bs + bss where cp0 = proc (toFilePath exeName) fullArgs cp = cp0 @@ -1018,14 +1021,14 @@ singleBuild runInBase ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} in bindir = toFilePath $ bcoSnapInstallRoot eeBaseConfigOpts bindirSuffix realConfigAndBuild cache allDepsMap = withSingleContext runInBase ac ee task (Just allDepsMap) Nothing - $ \package cabalfp pkgDir cabal announce console _mlogFile -> do + $ \package cabalfp pkgDir cabal announce _console _mlogFile -> do _neededConfig <- ensureConfig cache pkgDir ee (announce ("configure" <> annSuffix)) cabal cabalfp if boptsOnlyConfigure eeBuildOpts then return Nothing - else liftM Just $ realBuild cache package pkgDir cabal announce console + else liftM Just $ realBuild cache package pkgDir cabal announce - realBuild cache package pkgDir cabal announce console = do + realBuild cache package pkgDir cabal announce = do wc <- getWhichCompiler markExeNotInstalled (taskLocation task) taskProvides @@ -1039,7 +1042,7 @@ singleBuild runInBase ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} in config <- asks getConfig extraOpts <- extraBuildOptions eeBuildOpts preBuildTime <- modTime <$> liftIO getCurrentTime - cabal (console && configHideTHLoading config) $ ("build" :) $ (++ extraOpts) $ + cabal (configHideTHLoading config) $ ("build" :) $ (++ extraOpts) $ case (taskType, taskAllInOne, isFinalBuild) of (_, True, True) -> fail "Invariant violated: cannot have an all-in-one build that also has a final build step." (TTLocal lp, False, False) -> primaryComponentOptions lp @@ -1280,21 +1283,32 @@ singleBench runInBase beopts benchesToRun ac ee task installedMap = do announce "benchmarks" cabal False ("bench" : args) --- | Grab all output from the given @Handle@ and print it to stdout, stripping --- Template Haskell "Loading package" lines. Does work in a separate thread. +-- | Grab all output from the given @Handle@ and log it, stripping +-- Template Haskell "Loading package" lines and making paths absolute. +-- thread. printBuildOutput :: (MonadIO m, MonadBaseControl IO m, MonadLogger m) => Bool -- ^ exclude TH loading? -> Bool -- ^ convert paths to absolute? -> Path Abs Dir -- ^ package's root directory -> LogLevel - -> Handle -> m () + -> Handle + -> m () printBuildOutput excludeTHLoading makeAbsolute pkgDir level outH = void $ CB.sourceHandle outH - $$ CB.lines + $$ mungeBuildOutput excludeTHLoading makeAbsolute pkgDir + =$ CL.mapM_ (monadLoggerLog $(TH.location >>= liftLoc) "" level) + +-- | Strip Template Haskell "Loading package" lines and making paths absolute. +mungeBuildOutput :: MonadIO m + => Bool -- ^ exclude TH loading? + -> Bool -- ^ convert paths to absolute? + -> Path Abs Dir -- ^ package's root directory + -> ConduitM ByteString ByteString m () +mungeBuildOutput excludeTHLoading makeAbsolute pkgDir = void $ + CB.lines =$ CL.map stripCarriageReturn =$ CL.filter (not . isTHLoading) =$ CL.mapM toAbsolutePath - =$ CL.mapM_ (monadLoggerLog $(TH.location >>= liftLoc) "" level) where -- | Is this line a Template Haskell "Loading package" line -- ByteString diff --git a/src/Stack/Types/Build.hs b/src/Stack/Types/Build.hs index 0bb9537603..0c048a51da 100644 --- a/src/Stack/Types/Build.hs +++ b/src/Stack/Types/Build.hs @@ -108,7 +108,7 @@ data StackBuildException (Path Abs File) -- cabal Executable [String] -- cabal arguments (Maybe (Path Abs File)) -- logfiles location - S.ByteString -- log contents + [S.ByteString] -- log contents | ExecutionFailure [SomeException] | LocalPackageDoesn'tMatchTarget PackageName @@ -238,7 +238,7 @@ instance Show StackBuildException where Map.singleton name version go _ = Map.empty -- Supressing duplicate output - show (CabalExitedUnsuccessfully exitCode taskProvides' execName fullArgs logFiles bs) = + show (CabalExitedUnsuccessfully exitCode taskProvides' execName fullArgs logFiles bss) = let fullCmd = unwords $ dropQuotes (toFilePath execName) : map (T.unpack . showProcessArgDebug) fullArgs @@ -250,14 +250,12 @@ instance Show StackBuildException where then " (THIS MAY INDICATE OUT OF MEMORY)" else "") ++ logLocations ++ - (if S.null bs + (if null bss then "" - else "\n\n" ++ doubleIndent (T.unpack $ decodeUtf8With lenientDecode bs)) + else "\n\n" ++ doubleIndent (map (T.unpack . decodeUtf8With lenientDecode) bss)) where - -- appendLines = foldr (\pName-> (++) ("\n" ++ show pName)) "" - indent = dropWhileEnd isSpace . unlines . fmap (\line -> " " ++ line) . lines + doubleIndent = dropWhileEnd isSpace . unlines . fmap (\line -> " " ++ line) dropQuotes = filter ('\"' /=) - doubleIndent = indent . indent show (ExecutionFailure es) = intercalate "\n\n" $ map show es show (LocalPackageDoesn'tMatchTarget name localV requestedV) = concat [ "Version for local package "