cabal-validate: Add --quiet

Doesn't do anything yet.
haskell · Dec 13, 2024 · 2749de9 · 2749de9
1 parent ac29d59
commit 2749de9
Show file tree

Hide file tree

Showing 3 changed files with 33 additions and 18 deletions.
diff --git 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
@@ -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
@@ -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 $