cabal-validate/src/ProcessUtil.hs

   1 -- | Utilities for running processes and timing them.
   2 module ProcessUtil
   3   ( timed
   4   , timedWithCwd
   5   ) where
   6
   7 import Control.Exception (throwIO)
   8 import Control.Monad (unless)
   9 import Data.ByteString.Lazy (ByteString)
  10 import qualified Data.ByteString.Lazy as ByteString
  11 import Data.Text (Text)
  12 import qualified Data.Text as T
  13 import qualified Data.Text.IO as T
  14 import qualified Data.Text.Lazy as T (toStrict)
  15 import qualified Data.Text.Lazy.Encoding as T (decodeUtf8)
  16 import System.Directory (withCurrentDirectory)
  17 import System.Exit (ExitCode (ExitFailure, ExitSuccess))
  18 import System.Process.Typed (ExitCodeException (..), proc, readProcess, runProcess)
  19
  20 import ANSI (SGR (BrightBlue, BrightGreen, BrightRed, Reset), setSGR)
  21 import Cli (Opts (..))
  22 import ClockUtil (diffAbsoluteTime, formatDiffTime, getAbsoluteTime)
  23
  24 -- | Like `timed`, but runs the command in a given directory.
  25 timedWithCwd
  26   :: Opts
  27   -- ^ @cabal-validate@ options.
  28   -> FilePath
  29   -- ^ Path to run the command in.
  30   -> FilePath
  31   -- ^ The command to run.
  32   -> [String]
  33   -- ^ Arguments to pass to the command.
  34   -> IO ()
  35 timedWithCwd opts cdPath command args =
  36   withCurrentDirectory cdPath (timed opts command args)
  37
  38 -- | Run a command, displaying timing information after it finishes.
  39 --
  40 -- This prints out the command to be executed before it's run, handles hiding
  41 -- or showing output (according to the value of `verbose`), and throws an
  42 -- `ExitCodeException` if the command fails.
  43 timed
  44   :: Opts
  45   -- ^ @cabal-validate@ options.
  46   -> FilePath
  47   -- ^ The command to run.
  48   -> [String]
  49   -- ^ Arguments to pass to the command.
  50   -> IO ()
  51 timed opts command args = do
  52   let prettyCommand = displayCommand command args
  53       process = proc command args
  54
  55   startTime' <- getAbsoluteTime
  56
  57   -- TODO: Replace `$HOME` or `opts.cwd` for brevity?
  58   putStrLn $
  59     setSGR [BrightBlue]
  60       <> "$ "
  61       <> prettyCommand
  62       <> setSGR [Reset]
  63
  64   (exitCode, rawStdout, rawStderr) <-
  65     if verbose opts
  66       then do
  67         exitCode <- runProcess process
  68         pure (exitCode, ByteString.empty, ByteString.empty)
  69       else readProcess process
  70
  71   endTime <- getAbsoluteTime
  72
  73   let duration = diffAbsoluteTime endTime startTime'
  74       totalDuration = diffAbsoluteTime endTime (startTime opts)
  75
  76       output = decodeStrip rawStdout <> "\n" <> decodeStrip rawStderr
  77       linesLimit = 50
  78       outputLines = T.lines output
  79       hiddenLines = length outputLines - linesLimit
  80       tailLines = drop hiddenLines outputLines
  81
  82   case exitCode of
  83     ExitSuccess -> do
  84       unless (verbose opts) $ do
  85         if hiddenLines <= 0
  86           then T.putStrLn output
  87           else
  88             T.putStrLn $
  89               "("
  90                 <> T.pack (show hiddenLines)
  91                 <> " lines hidden, use `--verbose` to show)\n"
  92                 <> "...\n"
  93                 <> T.unlines tailLines
  94
  95       putStrLn $
  96         setSGR [BrightGreen]
  97           <> "Finished after "
  98           <> formatDiffTime duration
  99           <> ": "
 100           <> prettyCommand
 101           <> "\nTotal time so far: "
 102           <> formatDiffTime totalDuration
 103           <> setSGR [Reset]
 104     ExitFailure exitCode' -> do
 105       unless (verbose opts) $ do
 106         T.putStrLn output
 107
 108       putStrLn $
 109         setSGR [BrightRed]
 110           <> "Failed with exit code "
 111           <> show exitCode'
 112           <> " after "
 113           <> formatDiffTime duration
 114           <> ": "
 115           <> prettyCommand
 116           <> "\nTotal time so far: "
 117           <> formatDiffTime totalDuration
 118           <> setSGR [Reset]
 119
 120       throwIO
 121         ExitCodeException
 122           { eceExitCode = exitCode
 123           , eceProcessConfig = process
 124           , eceStdout = rawStdout
 125           , eceStderr = rawStderr
 126           }
 127
 128 -- | Decode `ByteString` output from a command and strip whitespace at the
 129 -- start and end.
 130 decodeStrip :: ByteString -> Text
 131 decodeStrip = T.strip . T.toStrict . T.decodeUtf8
 132
 133 -- | Escape a shell command to display it to a user.
 134 --
 135 -- TODO: Shell escaping
 136 displayCommand :: String -> [String] -> String
 137 displayCommand command args = command <> " " <> unwords args