diff --git a/.github/workflows/validate.yml b/.github/workflows/validate.yml index 786a3b9902d..7e581555a35 100644 --- a/.github/workflows/validate.yml +++ b/.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 diff --git a/cabal-validate/src/Cli.hs b/cabal-validate/src/Cli.hs index 482fb2096b1..6a3a33c8f40 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 @@ -179,11 +192,7 @@ resolveOpts opts = do then rawSteps opts else concat - [ - [ PrintConfig - , PrintToolVersions - , Build - ] + [ [Build] , optional (rawDoctest opts) Doctest , optional (rawRunLibTests opts) LibTests , optional (rawRunLibSuite opts) LibSuite @@ -191,7 +200,6 @@ resolveOpts opts = do , 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 diff --git a/cabal-validate/src/Main.hs b/cabal-validate/src/Main.hs index 51472ad34a4..7164f3f8cc4 100644 --- a/cabal-validate/src/Main.hs +++ b/cabal-validate/src/Main.hs @@ -14,11 +14,10 @@ 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) @@ -26,7 +25,21 @@ 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] diff --git a/cabal-validate/src/ProcessUtil.hs b/cabal-validate/src/ProcessUtil.hs index 3e27f5517a1..86c5c16e73f 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 > 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 $ diff --git a/cabal-validate/src/Step.hs b/cabal-validate/src/Step.hs index 2636f483a79..801b660f5cc 100644 --- a/cabal-validate/src/Step.hs +++ b/cabal-validate/src/Step.hs @@ -11,9 +11,7 @@ import qualified Data.Map.Strict as Map -- | A step to be run by @cabal-validate@. data Step - = PrintConfig - | PrintToolVersions - | Build + = Build | Doctest | LibTests | LibSuite @@ -22,7 +20,6 @@ data Step | CliSuite | SolverBenchmarksTests | SolverBenchmarksRun - | TimeSummary deriving (Eq, Enum, Bounded, Show) -- | Get the display identifier for a given `Step`. @@ -34,8 +31,6 @@ data Step displayStep :: Step -> String displayStep step = case step of - PrintConfig -> "print-config" - PrintToolVersions -> "print-tool-versions" Build -> "build" Doctest -> "doctest" LibTests -> "lib-tests" @@ -45,7 +40,6 @@ displayStep step = CliSuite -> "cli-suite" SolverBenchmarksTests -> "solver-benchmarks-tests" SolverBenchmarksRun -> "solver-benchmarks-run" - TimeSummary -> "time-summary" -- | A map from step names to `Steps`. --