Merge pull request #10573 from 9999years/validate-verbose

`cabal-validate`: Better output verbosity defaults

Author: mergify[bot]

.github/workflows/validate.yml

@@ -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
 
@@ -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

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
@@ -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' =
@@ -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])
@@ -257,7 +270,7 @@ resolveOpts opts = do
 
   pure
     Opts
-      { verbose = rawVerbose opts
+      { verbosity = rawVerbosity opts
       , jobs = jobs'
       , cwd = cwd'
       , startTime = startTime'
@@ -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
@@ -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"
@@ -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"
       )
@@ -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

cabal-validate/src/Main.hs

@@ -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
 
@@ -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
@@ -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 ""
 
@@ -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.
 --
@@ -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
@@ -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]

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 > Quiet
       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 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
@@ -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 $