diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for pa-run-command + +## 0.1.0.0 -- 2023-05-24 + +- First version diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,11 @@ +Copyright 2023 Possehl Analytics GmbH + +Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. + +3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,3 @@ +# `pa-run-command` + +Some helper functions that run subcommands and print what they are running in a fashion that makes debugging easy (copy and paste as bash command). diff --git a/pa-run-command.cabal b/pa-run-command.cabal new file mode 100644 --- /dev/null +++ b/pa-run-command.cabal @@ -0,0 +1,80 @@ +cabal-version: 3.0 +-- !!! ATTN: file autogenerated from pa-template.cabal.mustache on toplevel !!! +name: pa-run-command +version: 0.1.0.0 +synopsis: Helper functions for spawning subprocesses +description: +license: BSD-3-Clause +license-file: LICENSE +-- author: +maintainer: Philip Patsch +copyright: 2023 Possehl Analytics GmbH +homepage: https://github.com/possehl-analytics/pa-hackage +category: Data, Possehl-Analytics +build-type: Simple +extra-doc-files: CHANGELOG.md + README.md +-- extra-source-files: + + +common common-options + ghc-options: + -Wall + -Wno-type-defaults + -Wunused-packages + -Wredundant-constraints + -fwarn-missing-deriving-strategies + + -- See https://downloads.haskell.org/ghc/latest/docs/users_guide/exts.html + -- for a description of all these extensions + default-extensions: + -- Infer Applicative instead of Monad where possible + ApplicativeDo + + -- Allow literal strings to be Text + OverloadedStrings + + -- Syntactic sugar improvements + LambdaCase + MultiWayIf + + -- Makes the (deprecated) usage of * instead of Data.Kind.Type an error + NoStarIsType + + -- Convenient and crucial to deal with ambiguous field names, commonly + -- known as RecordDotSyntax + OverloadedRecordDot + + -- does not export record fields as functions, use OverloadedRecordDot to access instead + NoFieldSelectors + + -- Record punning + RecordWildCards + + -- Improved Deriving + DerivingStrategies + DerivingVia + + -- Type-level strings + DataKinds + + -- to enable the `type` keyword in import lists (ormolu uses this automatically) + ExplicitNamespaces + + default-language: GHC2021 + +library + import: common-options + exposed-modules: + RunCommand, + -- other-modules: + -- other-extensions: + hs-source-dirs: src + build-depends: + base <5, + pa-prelude, + text, + bytestring, + typed-process, + monad-logger + diff --git a/src/RunCommand.hs b/src/RunCommand.hs new file mode 100644 --- /dev/null +++ b/src/RunCommand.hs @@ -0,0 +1,156 @@ +{-# LANGUAGE QuasiQuotes #-} + +module RunCommand where + +import Control.Monad.Logger.CallStack (MonadLogger, logError, logInfo) +import Data.ByteString qualified as ByteString +import Data.ByteString.Lazy qualified as Lazy +import Data.Char qualified as Char +import Data.List qualified as List +import Data.Text qualified as Text +import PossehlAnalyticsPrelude +import System.Exit (ExitCode (ExitFailure, ExitSuccess)) +import System.Exit qualified as Exit +import System.Exit qualified as System +import System.IO (Handle) +import System.Process.Typed qualified as Process + +-- | 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 :: (MonadLogger m, MonadIO m) => FilePath -> [Text] -> m (Exit.ExitCode, ByteString) +runCommand executable args = do + let bashArgs = prettyArgsForBash ((executable & stringToText) : args) + logInfo [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 :: (MonadLogger m, MonadIO m) => FilePath -> [Text] -> m Exit.ExitCode +runCommandNoStdout executable args = do + let bashArgs = prettyArgsForBash ((executable & stringToText) : args) + logInfo [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 :: (MonadLogger m, MonadIO m) => FilePath -> [Text] -> Lazy.ByteString -> m (Exit.ExitCode, ByteString) +runCommandWithStdin executable args stdin = do + let bashArgs = prettyArgsForBash ((executable & stringToText) : args) + logInfo [fmt|Running: $ {bashArgs}|] + Process.proc + executable + (args <&> textToString) + & Process.setStdin (Process.byteStringInput stdin) + & Process.readProcessStdout + <&> second toStrictBytes + <&> second stripWhitespaceFromEnd + +-- | Like 'runCommandExpect0', but don’t capture stdout, +-- connect stdin and stdout to the command until it returns. +-- +-- This is for interactive subcommands. +runCommandInteractiveExpect0 :: (MonadLogger m, MonadIO m) => FilePath -> [Text] -> m () +runCommandInteractiveExpect0 executable args = do + let bashArgs = prettyArgsForBash ((executable & stringToText) : args) + logInfo [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 :: (MonadLogger m, MonadIO m) => FilePath -> [Text] -> Handle -> m Exit.ExitCode +runCommandPipeToHandle executable args handle = do + -- TODO log the output file? + let bashArgs = prettyArgsForBash ((executable & stringToText) : args) + logInfo [fmt|Running: $ {bashArgs}|] + liftIO $ + Process.runProcess + ( Process.proc + executable + (args <&> textToString) + & Process.setStdout (Process.useHandleClose handle) + ) + +-- | Like 'runCommand' but exit if the command returns a non-0 status. +runCommandExpect0 :: (MonadLogger m, MonadIO m) => FilePath -> [Text] -> m ByteString +runCommandExpect0 executable args = + runCommand executable args >>= \case + (ex, stdout) -> do + checkStatus0 executable ex + pure stdout + +-- | Like 'runCommandNoStdout' but exit if the command returns a non-0 status. +runCommandExpect0NoStdout :: (MonadLogger m, MonadIO m) => FilePath -> [Text] -> m () +runCommandExpect0NoStdout executable args = + runCommandNoStdout executable args >>= \case + ex -> checkStatus0 executable ex + +-- | Like 'runCommandWithStdin' but exit if the command returns a non-0 status. +runCommandWithStdinExpect0 :: (MonadLogger m, MonadIO m) => FilePath -> [Text] -> Lazy.ByteString -> m ByteString +runCommandWithStdinExpect0 executable args stdin = + runCommandWithStdin executable args stdin >>= \case + (ex, stdout) -> do + checkStatus0 executable ex + pure stdout + +-- | Check whether a command exited 0 or crash. +checkStatus0 :: (MonadLogger m, MonadIO m) => FilePath -> ExitCode -> m () +checkStatus0 executable = \case + ExitSuccess -> pure () + ExitFailure status -> do + logCritical [fmt|Command `{executable}` did not exit with status 0 (success), but status {status}|] + +-- | Log the message with 'logError', and call 'System.exitFailure'. +logCritical :: (HasCallStack, MonadLogger m, MonadIO m) => Text -> m b +logCritical msg = do + logError msg + liftIO $ System.exitFailure + +-- | 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' <> "'"