Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Improve filtering of ghc messages #3127

Merged
merged 4 commits into from
Jun 6, 2017
Merged

Improve filtering of ghc messages #3127

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
9f01ebc
Use enums instead of naked booleans
sergv Apr 14, 2017
536461a
Filter out linker warnings on ghc 7.8
sergv Apr 14, 2017
fa69941
Add more signatures for local functions
sergv Apr 23, 2017
dce9840
Filter linker warnings only for ghc 7.8
sergv Apr 23, 2017
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
157 changes: 110 additions & 47 deletions src/Stack/Build/Execute.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -17,6 +17,7 @@ module Stack.Build.Execute
, ExecuteEnv
, withExecuteEnv
, withSingleContext
, ExcludeTHLoading(..)
) where

import Control.Applicative
Expand Down Expand Up @@ -329,7 +330,7 @@ getSetupExe setupHs setupShimHs tmpdir = do
return $ Just exePath

-- | Execute a function that takes an 'ExecuteEnv'.
withExecuteEnv :: (StackM env m, HasEnvConfig env)
withExecuteEnv :: forall env m a. (StackM env m, HasEnvConfig env)
=> EnvOverride
-> BuildOpts
-> BuildOptsCLI
Expand Down Expand Up @@ -404,6 +405,7 @@ withExecuteEnv menv bopts boptsCli baseConfigOpts locals globalPackages snapshot
where
toDumpPackagesByGhcPkgId = Map.fromList . map (\dp -> (dpGhcPkgId dp, dp))

dumpLogs :: TChan (Path Abs Dir, Path Abs File) -> Int -> m ()
dumpLogs chan totalWanted = do
allLogs <- fmap reverse $ liftIO $ atomically drainChan
case allLogs of
Expand All @@ -424,6 +426,7 @@ withExecuteEnv menv bopts boptsCli baseConfigOpts locals globalPackages snapshot
$logInfo $ T.pack $ "Log files have been written to: "
++ toFilePath (parent (snd firstLog))
where
drainChan :: STM [(Path Abs Dir, Path Abs File)]
drainChan = do
mx <- tryReadTChan chan
case mx of
Expand All @@ -432,6 +435,7 @@ withExecuteEnv menv bopts boptsCli baseConfigOpts locals globalPackages snapshot
xs <- drainChan
return $ x:xs

dumpLogIfWarning :: (Path Abs Dir, Path Abs File) -> m ()
dumpLogIfWarning (pkgDir, filepath) = do
firstWarning <- runResourceT
$ CB.sourceFile (toFilePath filepath)
Expand All @@ -442,15 +446,18 @@ withExecuteEnv menv bopts boptsCli baseConfigOpts locals globalPackages snapshot
=$ CL.take 1
unless (null firstWarning) $ dumpLog " due to warnings" (pkgDir, filepath)

isWarning :: Text -> Bool
isWarning t = ": Warning:" `T.isSuffixOf` t -- prior to GHC 8
|| ": warning:" `T.isInfixOf` t -- GHC 8 is slightly different

dumpLog :: String -> (Path Abs Dir, Path Abs File) -> m ()
dumpLog msgSuffix (pkgDir, filepath) = do
$logInfo $ T.pack $ concat ["\n-- Dumping log file", msgSuffix, ": ", toFilePath filepath, "\n"]
compilerVer <- view actualCompilerVersionL
runResourceT
$ CB.sourceFile (toFilePath filepath)
$$ CT.decodeUtf8Lenient
=$ mungeBuildOutput True True pkgDir
=$ mungeBuildOutput ExcludeTHLoading ConvertPathsToAbsolute pkgDir compilerVer
=$ CL.mapM_ $logInfo
$logInfo $ T.pack $ "\n-- End of log file: " ++ toFilePath filepath ++ "\n"

Expand Down Expand Up @@ -808,7 +815,7 @@ ensureConfig :: (StackM env m, HasEnvConfig env)
-> Path Abs Dir -- ^ package directory
-> ExecuteEnv m
-> m () -- ^ announce
-> (Bool -> [String] -> m ()) -- ^ cabal
-> (ExcludeTHLoading -> [String] -> m ()) -- ^ cabal
-> Path Abs File -- ^ .cabal file
-> m Bool
ensureConfig newConfigCache pkgDir ExecuteEnv {..} announce cabal cabalfp = do
Expand Down Expand Up @@ -847,7 +854,7 @@ ensureConfig newConfigCache pkgDir ExecuteEnv {..} announce cabal cabalfp = do
Just x -> return $ concat ["--with-", name, "=", toFilePath x]
-- Configure cabal with arguments determined by
-- Stack.Types.Build.configureOpts
cabal False $ "configure" : concat
cabal KeepTHLoading $ "configure" : concat
[ concat exes
, dirs
, nodirs
Expand Down Expand Up @@ -875,7 +882,7 @@ announceTask task x = $logInfo $ T.concat
-- custom setup is built.
--
-- * Provides the user a function with which run the Cabal process.
withSingleContext :: (StackM env m, HasEnvConfig env)
withSingleContext :: forall env m a. (StackM env m, HasEnvConfig env)
=> (m () -> IO ())
-> ActionContext
-> ExecuteEnv m
Expand All @@ -885,14 +892,13 @@ withSingleContext :: (StackM env m, HasEnvConfig env)
-- Nothing, just provide global and snapshot package
-- databases.
-> Maybe String
-> ( Package -- Package info
-> Path Abs File -- Cabal file path
-> Path Abs Dir -- Package root directory file path
-> (Bool -> [String] -> m ()) -- Function to run Cabal with args
-- The Bool indicates if it's a build step, so strip TH stuff
-> (Text -> m ()) -- An 'announce' function, for different build phases
-> Bool -- Whether output should be directed to the console
-> Maybe (Path Abs File, Handle) -- Log file
-> ( Package -- Package info
-> Path Abs File -- Cabal file path
-> Path Abs Dir -- Package root directory file path
-> (ExcludeTHLoading -> [String] -> m ()) -- Function to run Cabal with args
-> (Text -> m ()) -- An 'announce' function, for different build phases
-> Bool -- Whether output should be directed to the console
-> Maybe (Path Abs File, Handle) -- Log file
-> m a)
-> m a
withSingleContext runInBase ActionContext {..} ExecuteEnv {..} task@Task {..} mdeps msuffix inner0 =
Expand Down Expand Up @@ -946,6 +952,12 @@ withSingleContext runInBase ActionContext {..} ExecuteEnv {..} task@Task {..} md
(liftIO . hClose)
$ \h -> inner (Just (logPath, h))

withCabal
:: Package
-> Path Abs Dir
-> Maybe (Path Abs File, Handle)
-> ((ExcludeTHLoading -> [String] -> m ()) -> m a)
-> m a
withCabal package pkgDir mlogFile inner = do
config <- view configL

Expand Down Expand Up @@ -987,6 +999,7 @@ withSingleContext runInBase ActionContext {..} ExecuteEnv {..} task@Task {..} md
: ["-hide-all-packages"]
)

warnCustomNoDeps :: m ()
warnCustomNoDeps =
case (taskType, packageBuildType package) of
(TTLocal{}, Just C.Custom) -> do
Expand All @@ -999,6 +1012,7 @@ withSingleContext runInBase ActionContext {..} ExecuteEnv {..} task@Task {..} md
$logWarn "Strongly recommend fixing the package's cabal file"
_ -> return ()

getPackageArgs :: Path Abs Dir -> m [String]
getPackageArgs setupDir =
case (packageSetupDeps package, mdeps) of
-- The package is using the Cabal custom-setup
Expand Down Expand Up @@ -1078,8 +1092,11 @@ withSingleContext runInBase ActionContext {..} ExecuteEnv {..} task@Task {..} md
++ ["-package-db=" ++ toFilePathNoTrailingSep (bcoSnapDB eeBaseConfigOpts)])

setupArgs = ("--builddir=" ++ toFilePathNoTrailingSep distRelativeDir') : args
runExe exeName fullArgs =
runAndOutput `catch` \(ProcessExitedUnsuccessfully _ ec) -> do

runExe :: Path Abs File -> [String] -> m ()
runExe exeName fullArgs = do
compilerVer <- view actualCompilerVersionL
runAndOutput compilerVer `catch` \(ProcessExitedUnsuccessfully _ ec) -> do
bss <-
case mlogFile of
Nothing -> return []
Expand All @@ -1088,7 +1105,7 @@ withSingleContext runInBase ActionContext {..} ExecuteEnv {..} task@Task {..} md
runResourceT
$ CB.sourceFile (toFilePath logFile)
=$= CT.decodeUtf8Lenient
$$ mungeBuildOutput stripTHLoading makeAbsolute pkgDir
$$ mungeBuildOutput stripTHLoading makeAbsolute pkgDir compilerVer
=$ CL.consume
throwM $ CabalExitedUnsuccessfully
ec
Expand All @@ -1098,19 +1115,28 @@ withSingleContext runInBase ActionContext {..} ExecuteEnv {..} task@Task {..} md
(fmap fst mlogFile)
bss
where
runAndOutput = case mlogFile of
runAndOutput :: CompilerVersion -> m ()
runAndOutput compilerVer = case mlogFile of
Just (_, h) ->
sinkProcessStderrStdoutHandle (Just pkgDir) menv (toFilePath exeName) fullArgs h h
Nothing ->
void $ sinkProcessStderrStdout (Just pkgDir) menv (toFilePath exeName) fullArgs
(outputSink False LevelWarn)
(outputSink stripTHLoading LevelInfo)
outputSink excludeTH level =
(outputSink KeepTHLoading LevelWarn compilerVer)
(outputSink stripTHLoading LevelInfo compilerVer)
outputSink
:: ExcludeTHLoading
-> LogLevel
-> CompilerVersion
-> Sink S.ByteString IO ()
outputSink excludeTH level compilerVer =
CT.decodeUtf8Lenient
=$ mungeBuildOutput excludeTH makeAbsolute pkgDir
=$ mungeBuildOutput excludeTH makeAbsolute pkgDir compilerVer
=$ CL.mapM_ (runInBase . monadLoggerLog $(TH.location >>= liftLoc) "" level)
-- If users want control, we should add a config option for this
makeAbsolute = stripTHLoading
makeAbsolute :: ConvertPathsToAbsolute
makeAbsolute = case stripTHLoading of
ExcludeTHLoading -> ConvertPathsToAbsolute
KeepTHLoading -> KeepPathsAsIs

wc <- view $ actualCompilerVersionL.whichCompilerL
exeName <- case (esetupexehs, wc) of
Expand Down Expand Up @@ -1166,7 +1192,7 @@ withSingleContext runInBase ActionContext {..} ExecuteEnv {..} task@Task {..} md
-- local install directory. Note that this is literally invoking Cabal
-- with @copy@, and not the copying done by @stack install@ - that is
-- handled by 'copyExecutables'.
singleBuild :: (StackM env m, HasEnvConfig env)
singleBuild :: forall env m. (StackM env m, HasEnvConfig env)
=> (m () -> IO ())
-> ActionContext
-> ExecuteEnv m
Expand Down Expand Up @@ -1322,8 +1348,15 @@ singleBuild runInBase ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} in

initialBuildSteps cabal announce = do
() <- announce ("initial-build-steps" <> annSuffix)
cabal False ["repl", "stack-initial-build-steps"]

cabal KeepTHLoading ["repl", "stack-initial-build-steps"]

realBuild
:: ConfigCache
-> Package
-> Path Abs Dir
-> (ExcludeTHLoading -> [String] -> m ())
-> (Text -> m ())
-> m Installed
realBuild cache package pkgDir cabal announce = do
wc <- view $ actualCompilerVersionL.whichCompilerL

Expand Down Expand Up @@ -1363,7 +1396,10 @@ singleBuild runInBase ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} in
() <- announce ("build" <> annSuffix)
config <- view configL
extraOpts <- extraBuildOptions wc eeBuildOpts
cabal (configHideTHLoading config) (("build" :) $ (++ extraOpts) $
let stripTHLoading
| configHideTHLoading config = ExcludeTHLoading
| otherwise = KeepTHLoading
cabal stripTHLoading (("build" :) $ (++ extraOpts) $
case (taskType, taskAllInOne, isFinalBuild) of
(_, True, True) -> error "Invariant violated: cannot have an all-in-one build that also has a final build step."
(TTLocal lp, False, False) -> primaryComponentOptions lp
Expand Down Expand Up @@ -1391,22 +1427,23 @@ singleBuild runInBase ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} in
("Warning: haddock not generating hyperlinked sources because 'HsColour' not\n" <>
"found on PATH (use 'stack install hscolour' to install).")
return ["--hyperlink-source" | hscolourExists]
cabal False (concat [ ["haddock", "--html", "--html-location=../$pkg-$version/"]
, sourceFlag
, ["--internal" | boptsHaddockInternal eeBuildOpts]
, [ "--haddock-option=" <> opt
| opt <- hoAdditionalArgs (boptsHaddockOpts eeBuildOpts) ]
])
cabal KeepTHLoading $ concat
[ ["haddock", "--html", "--html-location=../$pkg-$version/"]
, sourceFlag
, ["--internal" | boptsHaddockInternal eeBuildOpts]
, [ "--haddock-option=" <> opt
| opt <- hoAdditionalArgs (boptsHaddockOpts eeBuildOpts) ]
]

let shouldCopy = not isFinalBuild && (packageHasLibrary package || not (Set.null (packageExes package)))
when shouldCopy $ withMVar eeInstallLock $ \() -> do
announce "copy/register"
eres <- try $ cabal False ["copy"]
eres <- try $ cabal KeepTHLoading ["copy"]
case eres of
Left err@CabalExitedUnsuccessfully{} ->
throwM $ CabalCopyFailed (packageBuildType package == Just C.Simple) (show err)
_ -> return ()
when (packageHasLibrary package) $ cabal False ["register"]
when (packageHasLibrary package) $ cabal KeepTHLoading ["register"]

let (installedPkgDb, installedDumpPkgsTVar) =
case taskLocation task of
Expand Down Expand Up @@ -1649,31 +1686,54 @@ singleBench runInBase beopts benchesToRun ac ee task installedMap = do
return True

when toRun $ do
announce "benchmarks"
cabal False ("bench" : args)
announce "benchmarks"
cabal KeepTHLoading ("bench" : args)

data ExcludeTHLoading = ExcludeTHLoading | KeepTHLoading
data ConvertPathsToAbsolute = ConvertPathsToAbsolute | KeepPathsAsIs

-- | Strip Template Haskell "Loading package" lines and making paths absolute.
mungeBuildOutput :: (MonadIO m, MonadCatch m, MonadBaseControl IO m)
=> Bool -- ^ exclude TH loading?
-> Bool -- ^ convert paths to absolute?
-> Path Abs Dir -- ^ package's root directory
mungeBuildOutput :: forall m. (MonadIO m, MonadCatch m, MonadBaseControl IO m)
=> ExcludeTHLoading -- ^ exclude TH loading?
-> ConvertPathsToAbsolute -- ^ convert paths to absolute?
-> Path Abs Dir -- ^ package's root directory
-> CompilerVersion -- ^ compiler we're building with
-> ConduitM Text Text m ()
mungeBuildOutput excludeTHLoading makeAbsolute pkgDir = void $
mungeBuildOutput excludeTHLoading makeAbsolute pkgDir compilerVer = void $
CT.lines
=$ CL.map stripCR
=$ CL.filter (not . isTHLoading)
=$ CL.mapM toAbsolutePath
=$ filterLinkerWarnings
=$ toAbsolute
where
-- | Is this line a Template Haskell "Loading package" line
-- ByteString
isTHLoading :: Text -> Bool
isTHLoading _ | not excludeTHLoading = False
isTHLoading bs =
"Loading package " `T.isPrefixOf` bs &&
("done." `T.isSuffixOf` bs || "done.\r" `T.isSuffixOf` bs)
isTHLoading = case excludeTHLoading of
KeepTHLoading -> const False
ExcludeTHLoading -> \bs ->
"Loading package " `T.isPrefixOf` bs &&
("done." `T.isSuffixOf` bs || "done.\r" `T.isSuffixOf` bs)

filterLinkerWarnings :: ConduitM Text Text m ()
filterLinkerWarnings
-- Check for ghc 7.8 since it's the only one prone to producing
-- linker warnings on Windows x64
| getGhcVersion compilerVer >= $(mkVersion "7.8") = doNothing
| otherwise = CL.filter (not . isLinkerWarning)

isLinkerWarning :: Text -> Bool
isLinkerWarning str =
("ghc.exe: warning:" `T.isPrefixOf` str || "ghc.EXE: warning:" `T.isPrefixOf` str) &&
"is linked instead of __imp_" `T.isInfixOf` str

-- | Convert GHC error lines with file paths to have absolute file paths
toAbsolutePath bs | not makeAbsolute = return bs
toAbsolute :: ConduitM Text Text m ()
toAbsolute = case makeAbsolute of
KeepPathsAsIs -> doNothing
ConvertPathsToAbsolute -> CL.mapM toAbsolutePath

toAbsolutePath :: Text -> m Text
toAbsolutePath bs = do
let (x, y) = T.break (== ':') bs
mabs <-
Expand All @@ -1686,6 +1746,9 @@ mungeBuildOutput excludeTHLoading makeAbsolute pkgDir = void $
Nothing -> return bs
Just fp -> return $ fp `T.append` y

doNothing :: ConduitM Text Text m ()
doNothing = awaitForever yield

-- | Match the error location format at the end of lines
isValidSuffix = isRight . parseOnly lineCol
lineCol = char ':'
Expand Down
2 changes: 1 addition & 1 deletion src/Stack/SDist.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -266,7 +266,7 @@ getSDistFileList lp =
$ \ee ->
withSingleContext runInBase ac ee task Nothing (Just "sdist") $ \_package cabalfp _pkgDir cabal _announce _console _mlogFile -> do
let outFile = toFilePath tmpdir FP.</> "source-files-list"
cabal False ["sdist", "--list-sources", outFile]
cabal KeepTHLoading ["sdist", "--list-sources", outFile]
contents <- liftIO (readFile outFile)
return (contents, cabalfp)
where
Expand Down