From 2749de93f72ca774829e44e39591b232021d7466 Mon Sep 17 00:00:00 2001 From: Rebecca Turner Date: Wed, 20 Nov 2024 12:31:13 -0800 Subject: [PATCH] cabal-validate: Add `--quiet` Doesn't do anything yet. --- cabal-validate/src/Cli.hs | 25 +++++++++++++++++++------ cabal-validate/src/Main.hs | 14 +++++++------- cabal-validate/src/ProcessUtil.hs | 12 +++++++----- 3 files changed, 33 insertions(+), 18 deletions(-) diff --git a/cabal-validate/src/Cli.hs b/cabal-validate/src/Cli.hs index 55894bd0c9c..70120497926 100644 --- a/cabal-validate/src/Cli.hs +++ b/cabal-validate/src/Cli.hs @@ -5,6 +5,8 @@ module Cli , HackageTests (..) , Compiler (..) , VersionParseException (..) + , Verbosity (..) + , whenVerbose ) where @@ -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. @@ -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 @@ -252,7 +265,7 @@ resolveOpts opts = do pure Opts - { verbose = rawVerbose opts + { verbosity = rawVerbosity opts , jobs = jobs' , cwd = cwd' , startTime = startTime' @@ -270,7 +283,7 @@ 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 @@ -298,14 +311,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" diff --git a/cabal-validate/src/Main.hs b/cabal-validate/src/Main.hs index e506448a940..8791a40705c 100644 --- a/cabal-validate/src/Main.hs +++ b/cabal-validate/src/Main.hs @@ -7,7 +7,7 @@ module Main , runStep ) where -import Control.Monad (forM_, when) +import Control.Monad (forM_) import qualified Data.Text as T import qualified Data.Text.IO as T import qualified Data.Text.Lazy as T (toStrict) @@ -16,7 +16,7 @@ import Data.Version (makeVersion, showVersion) import System.FilePath (()) import System.Process.Typed (proc, readProcessStdout_) -import Cli (Compiler (..), HackageTests (..), Opts (..), parseOpts) +import Cli (Compiler (..), HackageTests (..), Opts (..), parseOpts, whenVerbose) import OutputUtil (printHeader, withTiming) import ProcessUtil (timed, timedWithCwd) import Step (Step (..), displayStep) @@ -137,7 +137,7 @@ timedCabalBin opts package component args = do -- | Print the configuration for CI logs. printConfig :: Opts -> IO () printConfig opts = - when (verbose opts) $ + whenVerbose opts $ do printHeader "Configuration" putStr $ unlines @@ -151,8 +151,8 @@ printConfig opts = <> unwords (map displayStep (steps opts)) , "Hackage tests: " <> show (hackageTests opts) - , "verbose: " - <> show (verbose opts) + , "verbosity: " + <> show (verbosity opts) , "extra compilers: " <> unwords (extraCompilers opts) , "extra RTS options: " @@ -162,7 +162,7 @@ printConfig opts = -- | Print the versions of tools being used. printToolVersions :: Opts -> IO () printToolVersions opts = - when (verbose opts) $ do + whenVerbose opts $ do printHeader "Tool versions" timed opts (cabal opts) ["--version"] timed opts (compilerExecutable (compiler opts)) ["--version"] @@ -173,7 +173,7 @@ printToolVersions opts = -- | Run the build step. build :: Opts -> IO () build opts = do - when (verbose opts) $ do + whenVerbose opts $ do printHeader "build (dry run)" timed opts diff --git a/cabal-validate/src/ProcessUtil.hs b/cabal-validate/src/ProcessUtil.hs index 3e27f5517a1..01ea66e2c1a 100644 --- a/cabal-validate/src/ProcessUtil.hs +++ b/cabal-validate/src/ProcessUtil.hs @@ -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) @@ -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. @@ -62,7 +62,7 @@ timed opts command args = do <> setSGR [Reset] (exitCode, rawStdout, rawStderr) <- - if verbose opts + if verbosity opts >= Verbose then do exitCode <- runProcess process pure (exitCode, ByteString.empty, ByteString.empty) @@ -81,7 +81,9 @@ timed opts command args = do case exitCode of ExitSuccess -> do - unless (verbose opts) $ do + -- Output is captured unless `--verbose` is used, so only print it here + -- if `--verbose` _isn't_ used. + when (verbosity opts <= Info) $ do if hiddenLines <= 0 then T.putStrLn output else @@ -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 $