diff options
author | Profpatsch <mail@profpatsch.de> | 2023-08-06T10·46+0200 |
---|---|---|
committer | clbot <clbot@tvl.fyi> | 2023-08-06T11·17+0000 |
commit | 1fd59f51580244bac8e75b4c08f103daa20674d9 (patch) | |
tree | 701df9da2d8ff52f7c881e221b416472b0988be3 /users/Profpatsch/my-prelude/src/RunCommand.hs | |
parent | ce4acc08a53fca8bc00282ca0eb4ca5fc048a222 (diff) |
chore(users/Profpatsch): clean up haskell libs a little r/6464
Change-Id: Ia9a6c5a754ca8f2912308feb5a26f5276a08d24c Reviewed-on: https://cl.tvl.fyi/c/depot/+/9011 Reviewed-by: Profpatsch <mail@profpatsch.de> Autosubmit: Profpatsch <mail@profpatsch.de> Tested-by: BuildkiteCI
Diffstat (limited to 'users/Profpatsch/my-prelude/src/RunCommand.hs')
-rw-r--r-- | users/Profpatsch/my-prelude/src/RunCommand.hs | 162 |
1 files changed, 0 insertions, 162 deletions
diff --git a/users/Profpatsch/my-prelude/src/RunCommand.hs b/users/Profpatsch/my-prelude/src/RunCommand.hs deleted file mode 100644 index 5c80eb3aacf4..000000000000 --- a/users/Profpatsch/my-prelude/src/RunCommand.hs +++ /dev/null @@ -1,162 +0,0 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} - -module RunCommand where - -import Data.ByteString qualified as ByteString -import Data.ByteString.Lazy qualified as Bytes.Lazy -import Data.Char qualified as Char -import Data.List qualified as List -import Data.Text qualified as Text -import MyPrelude -import System.Exit qualified as Exit -import System.IO (Handle) -import System.Process.Typed qualified as Process -import Prelude hiding (log) - --- | Given a a command, the executable and arguments, --- spawn the tool as subprocess and collect its stdout (stderr will go to our stderr). - --- Will strip the stdout of trailing newlines. --- --- If the executable is not a path, it will be resolved via the @PATH@ environment variable. -runCommand :: MonadIO m => FilePath -> [Text] -> m (Exit.ExitCode, ByteString) -runCommand executable args = do - let bashArgs = prettyArgsForBash ((executable & stringToText) : args) - log [fmt|Running: $ {bashArgs}|] - Process.proc - executable - (args <&> textToString) - & Process.readProcessStdout - <&> second toStrictBytes - <&> second stripWhitespaceFromEnd - --- | Given a a command, the executable and arguments, --- spawn the tool as subprocess and run it to conclusion. --- --- If the executable is not a path, it will be resolved via the @PATH@ environment variable. -runCommandNoStdout :: MonadIO m => FilePath -> [Text] -> m Exit.ExitCode -runCommandNoStdout executable args = do - let bashArgs = prettyArgsForBash ((executable & stringToText) : args) - log [fmt|Running: $ {bashArgs}|] - Process.proc - executable - (args <&> textToString) - & Process.runProcess - --- TODO: This is reversing the whole string *twice*. Can we strip from end without doing that? -stripWhitespaceFromEnd :: ByteString -> ByteString -stripWhitespaceFromEnd = ByteString.reverse . ByteString.dropWhile (\w -> w == charToWordUnsafe '\n') . ByteString.reverse - --- | Like `runCommand`, but takes a Bytestring that provides the command with streamed input on stdin. -runCommandWithStdin :: MonadIO m => FilePath -> [Text] -> Bytes.Lazy.ByteString -> m (Exit.ExitCode, ByteString) -runCommandWithStdin executable args stdin = do - let bashArgs = prettyArgsForBash ((executable & stringToText) : args) - log [fmt|Running: $ {bashArgs}|] - Process.proc - executable - (args <&> textToString) - & Process.setStdin (Process.byteStringInput stdin) - & Process.readProcessStdout - <&> second toStrictBytes - <&> second stripWhitespaceFromEnd - --- | Like `runCommand`, but takes a Bytestring that provides the command with streamed input on stdin. -runCommandWithStdinNoStdout :: MonadIO m => FilePath -> [Text] -> Bytes.Lazy.ByteString -> m Exit.ExitCode -runCommandWithStdinNoStdout executable args stdin = do - let bashArgs = prettyArgsForBash ((executable & stringToText) : args) - log [fmt|Running: $ {bashArgs}|] - Process.proc - executable - (args <&> textToString) - & Process.setStdin (Process.byteStringInput stdin) - & Process.runProcess - --- | Like 'runCommandWithStdin' but exit if the command returns a non-0 status. -runCommandWithStdinExpect0 :: MonadIO m => FilePath -> [Text] -> Bytes.Lazy.ByteString -> m ByteString -runCommandWithStdinExpect0 executable args stdin = - runCommandWithStdin executable args stdin >>= \case - (ex, stdout) -> do - checkStatus0 executable ex - pure stdout - --- | Like 'runCommandWithStdinNoStdout' but exit if the command returns a non-0 status. -runCommandWithStdinNoStdoutExpect0 :: MonadIO m => FilePath -> [Text] -> Bytes.Lazy.ByteString -> m () -runCommandWithStdinNoStdoutExpect0 executable args stdin = - runCommandWithStdinNoStdout executable args stdin - >>= checkStatus0 executable - --- | Like 'runCommandExpect0', but don’t capture stdout, --- connect stdin and stdout to the command until it returns. --- --- This is for interactive subcommands. -runCommandInteractiveExpect0 :: MonadIO m => FilePath -> [Text] -> m () -runCommandInteractiveExpect0 executable args = do - let bashArgs = prettyArgsForBash ((executable & stringToText) : args) - log [fmt|Running interactively: $ {bashArgs}|] - ( liftIO $ - Process.runProcess $ - Process.proc - executable - (args <&> textToString) - ) - >>= checkStatus0 executable - --- | Given a name of a command, the executable and arguments, --- spawn the tool as subprocess and pipe its stdout to the given 'Handle'. --- --- If the executable is not a path, it will be resolved via the @PATH@ environment variable. -runCommandPipeToHandle :: MonadIO m => FilePath -> [Text] -> Handle -> m Exit.ExitCode -runCommandPipeToHandle executable args handle = do - -- TODO log the output file? - let bashArgs = prettyArgsForBash ((executable & stringToText) : args) - log [fmt|Running: $ {bashArgs}|] - liftIO $ - Process.runProcess - ( Process.proc - executable - (args <&> textToString) - & Process.setStdout (Process.useHandleClose handle) - ) - --- | Check whether a command exited 0 or crash. -checkStatus0 :: MonadIO m => FilePath -> Exit.ExitCode -> m () -checkStatus0 executable = \case - Exit.ExitSuccess -> pure () - Exit.ExitFailure status -> do - logCritical [fmt|Command `{executable}` did not exit with status 0 (success), but status {status}|] - -log :: MonadIO m => Text -> m () -log = liftIO . putStderrLn - --- | Log the message on the normal logging level & exit the program -logCritical :: MonadIO m => Text -> m b -logCritical msg = do - liftIO $ putStderrLn msg - liftIO $ Exit.exitWith (Exit.ExitFailure 1) - --- | Pretty print a command line in a way that can be copied to bash. -prettyArgsForBash :: [Text] -> Text -prettyArgsForBash = Text.intercalate " " . map simpleBashEscape - --- | Simple escaping for bash words. If they contain anything that’s not ascii chars --- and a bunch of often-used special characters, put the word in single quotes. -simpleBashEscape :: Text -> Text -simpleBashEscape t = do - case Text.find (not . isSimple) t of - Just _ -> escapeSingleQuote t - Nothing -> t - where - -- any word that is just ascii characters is simple (no spaces or control characters) - -- or contains a few often-used characters like - or . - isSimple c = - Char.isAsciiLower c - || Char.isAsciiUpper c - || Char.isDigit c - -- These are benign, bash will not interpret them as special characters. - || List.elem c ['-', '.', ':', '/'] - -- Put the word in single quotes - -- If there is a single quote in the word, - -- close the single quoted word, add a single quote, open the word again - escapeSingleQuote t' = "'" <> Text.replace "'" "'\\''" t' <> "'" |