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.

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

cabal-validate: Better output verbosity defaults #10573

Open
wants to merge 7 commits into
base: master
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
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
9 changes: 0 additions & 9 deletions .github/workflows/validate.yml
Original file line number Diff line number Diff line change
Expand Up @@ -192,12 +192,6 @@ jobs:
fi
echo "FLAGS=$FLAGS" >> "$GITHUB_ENV"

- name: Validate print-config
run: sh validate.sh $FLAGS -s print-config

- name: Validate print-tool-versions
run: sh validate.sh $FLAGS -s print-tool-versions

- name: Validate build
run: sh validate.sh $FLAGS -s build

Expand Down Expand Up @@ -454,9 +448,6 @@ jobs:
- name: Untar the cabal executable
run: tar -xzf "./cabal-head/cabal-head-${{ runner.os }}-$CABAL_ARCH.tar.gz" -C cabal-head

- name: print-config using cabal HEAD
run: sh validate.sh ${{ env.COMMON_FLAGS }} --with-cabal ./cabal-head/cabal -s print-config

# We dont use cache to force a build with a fresh store dir and build dir
# This way we check cabal can build all its dependencies
- name: Build using cabal HEAD
Expand Down
50 changes: 34 additions & 16 deletions cabal-validate/src/Cli.hs
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,8 @@ module Cli
, HackageTests (..)
, Compiler (..)
, VersionParseException (..)
, Verbosity (..)
, whenVerbose
)
where

Expand Down Expand Up @@ -53,7 +55,7 @@ import Step (Step (..), displayStep, parseStep)

-- | Command-line options, resolved with context from the environment.
data Opts = Opts
{ verbose :: Bool
{ verbosity :: Verbosity
-- ^ Whether to display build and test output.
, jobs :: Int
-- ^ How many jobs to use when running tests.
Expand Down Expand Up @@ -116,6 +118,17 @@ data Compiler = Compiler
}
deriving (Show)

-- | A verbosity level, for log output.
data Verbosity
= Quiet
| Info
| Verbose
deriving (Show, Eq, Ord)

-- | Run an action only if the `verbosity` is `Verbose` or higher.
whenVerbose :: Applicative f => Opts -> f () -> f ()
whenVerbose opts action = when (verbosity opts >= Verbose) action

-- | An `Exception` thrown when parsing @--numeric-version@ output from a compiler.
data VersionParseException = VersionParseException
{ versionInput :: String
Expand Down Expand Up @@ -179,19 +192,14 @@ resolveOpts opts = do
then rawSteps opts
else
concat
[
[ PrintConfig
, PrintToolVersions
, Build
]
[ [Build]
, optional (rawDoctest opts) Doctest
, optional (rawRunLibTests opts) LibTests
, optional (rawRunLibSuite opts) LibSuite
, optional (rawRunLibSuite opts && not (null (rawExtraCompilers opts))) LibSuiteExtras
, optional (rawRunCliTests opts && not (rawLibOnly opts)) CliTests
, optional (rawRunCliSuite opts && not (rawLibOnly opts)) CliSuite
, optionals (rawSolverBenchmarks opts) [SolverBenchmarksTests, SolverBenchmarksRun]
, [TimeSummary]
]

targets' =
Expand Down Expand Up @@ -233,7 +241,12 @@ resolveOpts opts = do
else "cabal.validate.project"

tastyArgs' =
optional (rawTastyHideSuccesses opts) "--hide-successes"
maybe
-- If neither `--hide-successes` or `--no-hide-successes` was given, then
-- only `--hide-successes` if `--quiet` is given.
(optional (rawVerbosity opts <= Quiet) "--hide-successes")
(\hideSuccesses -> optional hideSuccesses "--hide-successes")
(rawTastyHideSuccesses opts)
++ maybe
[]
(\tastyPattern -> ["--pattern", tastyPattern])
Expand All @@ -257,7 +270,7 @@ resolveOpts opts = do

pure
Opts
{ verbose = rawVerbose opts
{ verbosity = rawVerbosity opts
, jobs = jobs'
, cwd = cwd'
, startTime = startTime'
Expand All @@ -275,14 +288,14 @@ resolveOpts opts = do
-- | Literate command-line options as supplied by the user, before resolving
-- defaults and other values from the environment.
data RawOpts = RawOpts
{ rawVerbose :: Bool
{ rawVerbosity :: Verbosity
, rawJobs :: Maybe Int
, rawCompiler :: FilePath
, rawCabal :: FilePath
, rawExtraCompilers :: [FilePath]
, rawTastyPattern :: Maybe String
, rawTastyArgs :: [String]
, rawTastyHideSuccesses :: Bool
, rawTastyHideSuccesses :: Maybe Bool
, rawDoctest :: Bool
, rawSteps :: [Step]
, rawListSteps :: Bool
Expand All @@ -303,14 +316,14 @@ rawOptsParser :: Parser RawOpts
rawOptsParser =
RawOpts
<$> ( flag'
True
Verbose
( short 'v'
<> long "verbose"
<> help "Always display build and test output"
)
<|> flag
False
False
Info
Quiet
( short 'q'
<> long "quiet"
<> help "Silence build and test output"
Expand Down Expand Up @@ -353,8 +366,7 @@ rawOptsParser =
<> help "Extra arguments to pass to Tasty test suites"
)
)
<*> boolOption
True
<*> maybeBoolOption
"hide-successes"
( help "Do not print tests that passed successfully"
)
Expand Down Expand Up @@ -436,6 +448,12 @@ boolOption :: Bool -> String -> Mod FlagFields Bool -> Parser Bool
boolOption defaultValue trueName =
boolOption' defaultValue trueName ("no-" <> trueName)

-- | Like `boolOption`, but can tell if an option was passed or not.
maybeBoolOption :: String -> Mod FlagFields (Maybe Bool) -> Parser (Maybe Bool)
maybeBoolOption trueName modifiers =
flag' (Just True) (modifiers <> long trueName)
<|> flag Nothing (Just False) (modifiers <> hidden <> long ("no-" <> trueName))

-- | Full `Parser` for `RawOpts`, which includes a @--help@ argument and
-- information about the program.
fullRawOptsParser :: ParserInfo RawOpts
Expand Down
128 changes: 66 additions & 62 deletions cabal-validate/src/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -14,19 +14,32 @@ import qualified Data.Text.Lazy as T (toStrict)
import qualified Data.Text.Lazy.Encoding as T (decodeUtf8)
import Data.Version (makeVersion, showVersion)
import System.FilePath ((</>))
import System.IO (BufferMode (LineBuffering), hSetBuffering, stderr, stdout)
import System.Process.Typed (proc, readProcessStdout_)

import ANSI (SGR (Bold, BrightCyan, Reset), setSGR)
import Cli (Compiler (..), HackageTests (..), Opts (..), parseOpts)
import ClockUtil (diffAbsoluteTime, formatDiffTime, getAbsoluteTime)
import Cli (Compiler (..), HackageTests (..), Opts (..), parseOpts, whenVerbose)
import OutputUtil (printHeader, withTiming)
import ProcessUtil (timed, timedWithCwd)
import Step (Step (..), displayStep)

-- | Entry-point for @cabal-validate@.
main :: IO ()
main = do
-- You'd _think_ that line-buffering for stdout and stderr would be the
-- default behavior, and the documentation makes gestures at it, but it
-- appears to not be the case!
--
-- > For most implementations, physical files will normally be
-- > block-buffered and terminals will normally be line-buffered.
--
-- However, on GitHub Actions and on my machine (macOS M1), adding these
-- lines makes output appear in the correct order!
hSetBuffering stdout LineBuffering
hSetBuffering stderr LineBuffering

opts <- parseOpts
printConfig opts
printToolVersions opts
forM_ (steps opts) $ \step -> do
runStep opts step

Expand All @@ -36,8 +49,6 @@ runStep opts step = do
let title = displayStep step
printHeader title
let action = case step of
PrintConfig -> printConfig opts
PrintToolVersions -> printToolVersions opts
Build -> build opts
Doctest -> doctest opts
LibTests -> libTests opts
Expand All @@ -47,7 +58,6 @@ runStep opts step = do
CliTests -> cliTests opts
SolverBenchmarksTests -> solverBenchmarksTests opts
SolverBenchmarksRun -> solverBenchmarksRun opts
TimeSummary -> timeSummary opts
withTiming (startTime opts) title action
T.putStrLn ""

Expand Down Expand Up @@ -106,11 +116,11 @@ cabalListBinArgs opts = "list-bin" : cabalArgs opts
cabalListBin :: Opts -> String -> IO FilePath
cabalListBin opts target = do
let args = cabalListBinArgs opts ++ [target]
stdout <-
stdout' <-
readProcessStdout_ $
proc (cabal opts) args

pure (T.unpack $ T.strip $ T.toStrict $ T.decodeUtf8 stdout)
pure (T.unpack $ T.strip $ T.toStrict $ T.decodeUtf8 stdout')

-- | Get the RTS arguments for invoking test suites.
--
Expand Down Expand Up @@ -139,57 +149,62 @@ timedCabalBin opts package component args = do

-- | Print the configuration for CI logs.
printConfig :: Opts -> IO ()
printConfig opts = do
putStr $
unlines
[ "compiler: "
<> compilerExecutable (compiler opts)
, "cabal-install: "
<> cabal opts
, "jobs: "
<> show (jobs opts)
, "steps: "
<> unwords (map displayStep (steps opts))
, "Hackage tests: "
<> show (hackageTests opts)
, "verbose: "
<> show (verbose opts)
, "extra compilers: "
<> unwords (extraCompilers opts)
, "extra RTS options: "
<> unwords (rtsArgs opts)
]
printConfig opts =
whenVerbose opts $ do
printHeader "Configuration"
putStr $
unlines
[ "compiler: "
<> compilerExecutable (compiler opts)
, "cabal-install: "
<> cabal opts
, "jobs: "
<> show (jobs opts)
, "steps: "
<> unwords (map displayStep (steps opts))
, "Hackage tests: "
<> show (hackageTests opts)
, "verbosity: "
<> show (verbosity opts)
, "extra compilers: "
<> unwords (extraCompilers opts)
, "extra RTS options: "
<> unwords (rtsArgs opts)
]

-- | Print the versions of tools being used.
printToolVersions :: Opts -> IO ()
printToolVersions opts = do
timed opts (compilerExecutable (compiler opts)) ["--version"]
timed opts (cabal opts) ["--version"]
printToolVersions opts =
whenVerbose opts $ do
printHeader "Tool versions"
timed opts (cabal opts) ["--version"]
timed opts (compilerExecutable (compiler opts)) ["--version"]

forM_ (extraCompilers opts) $ \compiler' -> do
timed opts compiler' ["--version"]
forM_ (extraCompilers opts) $ \compiler' -> do
timed opts compiler' ["--version"]

-- | Run the build step.
build :: Opts -> IO ()
build opts = do
printHeader "build (dry run)"
timed
opts
(cabal opts)
( cabalNewBuildArgs opts
++ targets opts
++ ["--dry-run"]
)

printHeader "build (full build plan; cached and to-be-built dependencies)"
timed
opts
"jq"
[ "-r"
, -- TODO: Maybe use `cabal-plan`? It's a heavy dependency though...
".\"install-plan\" | map(.\"pkg-name\" + \"-\" + .\"pkg-version\" + \" \" + .\"component-name\") | join(\"\n\")"
, baseBuildDir opts </> "cache" </> "plan.json"
]
whenVerbose opts $ do
printHeader "build (dry run)"
timed
opts
(cabal opts)
( cabalNewBuildArgs opts
++ targets opts
++ ["--dry-run"]
)

printHeader "build (full build plan; cached and to-be-built dependencies)"
timed
opts
"jq"
[ "-r"
, -- TODO: Maybe use `cabal-plan`? It's a heavy dependency though...
".\"install-plan\" | map(.\"pkg-name\" + \"-\" + .\"pkg-version\" + \" \" + .\"component-name\") | join(\"\n\")"
, baseBuildDir opts </> "cache" </> "plan.json"
]

printHeader "build (actual build)"
timed
Expand Down Expand Up @@ -413,14 +428,3 @@ solverBenchmarksRun opts = do
, "--packages=Chart-diagrams"
, "--print-trials"
]

-- | Print the total time taken so far.
timeSummary :: Opts -> IO ()
timeSummary opts = do
endTime <- getAbsoluteTime
let totalDuration = diffAbsoluteTime endTime (startTime opts)
putStrLn $
setSGR [Bold, BrightCyan]
<> "!!! Validation completed in "
<> formatDiffTime totalDuration
<> setSGR [Reset]
12 changes: 7 additions & 5 deletions cabal-validate/src/ProcessUtil.hs
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@ module ProcessUtil
) where

import Control.Exception (throwIO)
import Control.Monad (unless)
import Control.Monad (when)
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as ByteString
import Data.Text (Text)
Expand All @@ -18,7 +18,7 @@ import System.Exit (ExitCode (ExitFailure, ExitSuccess))
import System.Process.Typed (ExitCodeException (..), proc, readProcess, runProcess)

import ANSI (SGR (BrightBlue, BrightGreen, BrightRed, Reset), setSGR)
import Cli (Opts (..))
import Cli (Opts (..), Verbosity (..))
import ClockUtil (diffAbsoluteTime, formatDiffTime, getAbsoluteTime)

-- | Like `timed`, but runs the command in a given directory.
Expand Down Expand Up @@ -62,7 +62,7 @@ timed opts command args = do
<> setSGR [Reset]

(exitCode, rawStdout, rawStderr) <-
if verbose opts
if verbosity opts > Quiet
then do
exitCode <- runProcess process
pure (exitCode, ByteString.empty, ByteString.empty)
Expand All @@ -81,7 +81,9 @@ timed opts command args = do

case exitCode of
ExitSuccess -> do
unless (verbose opts) $ do
-- Output is captured when `--quiet` is used, so only print it here
-- if `--quiet` _isn't_ used.
when (verbosity opts > Quiet) $ do
if hiddenLines <= 0
then T.putStrLn output
else
Expand All @@ -102,7 +104,7 @@ timed opts command args = do
<> formatDiffTime totalDuration
<> setSGR [Reset]
ExitFailure exitCode' -> do
unless (verbose opts) $ do
when (verbosity opts <= Info) $ do
T.putStrLn output

putStrLn $
Expand Down
Loading
Loading