cabal-validate/src/OutputUtil.hs

   1 -- | Utilities for printing terminal output.
   2 module OutputUtil
   3   ( printHeader
   4   , withTiming
   5   ) where
   6
   7 import Control.Exception (catch)
   8 import qualified System.Console.Terminal.Size as Terminal
   9 import System.Process.Typed (ExitCodeException)
  10
  11 import ANSI (SGR (Bold, BrightCyan, BrightGreen, BrightRed, Reset), setSGR)
  12 import ClockUtil (AbsoluteTime, diffAbsoluteTime, formatDiffTime, getAbsoluteTime)
  13 import System.Exit (exitFailure)
  14
  15 -- | Get the width of the current terminal, or 80 if no width can be determined.
  16 getTerminalWidth :: IO Int
  17 getTerminalWidth = maybe 80 Terminal.width <$> Terminal.size @Int
  18
  19 -- | Print a header for a given step.
  20 --
  21 -- This is colorful and hard to miss in the output.
  22 printHeader
  23   :: String
  24   -- ^ Title to print.
  25   -> IO ()
  26 printHeader title = do
  27   columns <- getTerminalWidth
  28   let left = 3
  29       right = columns - length title - left - 2
  30       header =
  31         setSGR [Bold, BrightCyan]
  32           <> replicate left '═'
  33           <> " "
  34           <> title
  35           <> " "
  36           <> replicate right '═'
  37           <> setSGR [Reset]
  38   putStrLn header
  39
  40 -- | Run an `IO` action and print duration information after it finishes.
  41 withTiming
  42   :: AbsoluteTime
  43   -- ^ Start time for the whole @cabal-validate@ run.
  44   -> String
  45   -- ^ Name for describing the action.
  46   --
  47   -- Used in a sentence like "@title@ finished after 16.34s".
  48   -> IO a
  49   -- ^ Action to time.
  50   -> IO a
  51 withTiming startTime title action = do
  52   startTime' <- getAbsoluteTime
  53
  54   result <-
  55     (Right <$> action)
  56       `catch` (\exception -> pure (Left (exception :: ExitCodeException)))
  57
  58   endTime <- getAbsoluteTime
  59
  60   let duration = diffAbsoluteTime endTime startTime'
  61       totalDuration = diffAbsoluteTime endTime startTime
  62
  63   case result of
  64     Right inner -> do
  65       putStrLn $
  66         setSGR [Bold, BrightGreen]
  67           <> title
  68           <> " finished after "
  69           <> formatDiffTime duration
  70           <> "\nTotal time so far: "
  71           <> formatDiffTime totalDuration
  72           <> setSGR [Reset]
  73
  74       pure inner
  75     Left _procFailed -> do
  76       putStrLn $
  77         setSGR [Bold, BrightRed]
  78           <> title
  79           <> " failed after "
  80           <> formatDiffTime duration
  81           <> "\nTotal time so far: "
  82           <> formatDiffTime totalDuration
  83           <> setSGR [Reset]
  84
  85       -- TODO: `--keep-going` mode.
  86       exitFailure