<commit_before>#+xcvb (module (:depends-on ("macros" "process-spec")))

(in-package :inferior-shell)

(defvar *backend* :auto)

;;; TODO: instead support a magic :interactive directly in driver.lisp's run-program/
;;; and/or add support for arbitrary input to said run-program/
(defun run-program/interactively (command &key ignore-error-status)
  #-(or clozure sbcl) (NIY 'run-program/interactively command ignore-error-status)
  #+(or clozure sbcl)
  (let* ((process
          (#+clozure ccl:run-program #+sbcl sb-ext:run-program
           (car command) (cdr command)
           :input t :output t :error t :wait t
           #+sbcl :search #+sbcl t))
         (return-code
          #+clozure (nth-value 1 (ccl:external-process-status process))
          #+sbcl (sb-ext:process-exit-code process)))
    (unless (or ignore-error-status (zerop return-code))
      (cerror "ignore error code~*~*"
              "Process ~S exited with error code ~D"
              command return-code))
    (zerop return-code)))

(defun on-host-spec (host spec)
  (if (current-host-name-p host)
      spec
      `(ssh ,host ,(print-process-spec spec))))

(defun run-spec (spec &key ignore-error-status output)
  (let ((command
         (if (and (typep spec 'command-spec)
                  (null (command-redirections spec)))
             (command-arguments spec)
             (print-process-spec spec))))
    (if (eq output t)
        (run-program/ command :ignore-error-status ignore-error-status)
        (run-program/ command
                      :ignore-error-status ignore-error-status
                      :output output))))

(defun run-process-spec (spec &rest keys &key ignore-error-status output host backend)
  (etypecase host
    (null
     (etypecase spec
       (string
        (if (eq output t)
            (run-program/ spec :ignore-error-status ignore-error-status)
            (apply 'run-program/ spec keys)))
       (cons
        (apply 'run-process-spec (parse-process-spec spec) keys))
       (process-spec
        (ecase (or backend *backend*)
          #+(and sbcl sb-thread unix)
          ((:sbcl)
           (sbcl-run
            spec :input (eq :output :interactively) :output output :error t
            :ignore-error-status ignore-error-status))
          ((:auto)
           (run-spec spec :ignore-error-status ignore-error-status :output output))))))
    (string
     (apply 'run-process-spec (on-host-spec host spec) :host nil keys))
    (function
     (apply 'run-process-spec (funcall host spec) :host nil keys))))

(defun run (cmd &key on-error time (output t) show host)
  (labels ((process-time ()
             (if time (time (process-command)) (process-command)))
           (process-command ()
             (or
              (run-process-spec
               cmd
               :ignore-error-status t :output output :host host)
              (error-behaviour on-error))))
    (when show
      (format *trace-output* "; ~A~%" (print-process-spec cmd)))
    (process-time)))

(defun run/s (cmd &rest keys &key on-error time show host)
  "run command CMD, return its standard output results as a string."
  (declare (ignore on-error time show host))
  (apply 'run cmd :output 'string keys))

(defun run/ss (cmd &rest keys &key on-error time show host)
  "Like run/s, but strips the line ending off the result string;
very much like `cmd` or $(cmd) at the shell"
  (declare (ignore on-error time show host))
  (apply 'run cmd :output :string/stripped keys))

(defun slurp-stream-string/stripped (input-stream)
  (stripln (slurp-stream-string input-stream)))

(defmethod slurp-input-stream ((x (eql :string/stripped)) input-stream<commit_msg>Actually handle errors kind of correctly.<commit_after>#+xcvb (module (:depends-on ("macros" "process-spec")))

(in-package :inferior-shell)

(defvar *backend* :auto)

;;; TODO: instead support a magic :interactive directly in driver.lisp's run-program/
;;; and/or add support for arbitrary input to said run-program/
(defun run-program/interactively (command &key ignore-error-status)
  #-(or clozure sbcl) (NIY 'run-program/interactively command ignore-error-status)
  #+(or clozure sbcl)
  (let* ((process
          (#+clozure ccl:run-program #+sbcl sb-ext:run-program
           (car command) (cdr command)
           :input t :output t :error t :wait t
           #+sbcl :search #+sbcl t))
         (return-code
          #+clozure (nth-value 1 (ccl:external-process-status process))
          #+sbcl (sb-ext:process-exit-code process)))
    (unless (or ignore-error-status (zerop return-code))
      (cerror "ignore error code~*~*"
              "Process ~S exited with error code ~D"
              command return-code))
    (zerop return-code)))

(defun on-host-spec (host spec)
  (if (current-host-name-p host)
      spec
      `(ssh ,host ,(print-process-spec spec))))

(defun run-spec (spec &key ignore-error-status output)
  (let ((command
         (if (and (typep spec 'command-spec)
                  (null (command-redirections spec)))
             (command-arguments spec)
             (print-process-spec spec))))
    (if (eq output t)
        (run-program/ command :ignore-error-status ignore-error-status)
        (run-program/ command
                      :ignore-error-status ignore-error-status
                      :output output))))

(defun run-process-spec (spec &rest keys &key ignore-error-status output host backend)
  (etypecase host
    (null
     (etypecase spec
       (string
        (if (eq output t)
            (run-program/ spec :ignore-error-status ignore-error-status)
            (apply 'run-program/ spec keys)))
       (cons
        (apply 'run-process-spec (parse-process-spec spec) keys))
       (process-spec
        (ecase (or backend *backend*)
          #+(and sbcl sb-thread unix)
          ((:sbcl)
           (sbcl-run
            spec :input (eq :output :interactively) :output output :error t
            :ignore-error-status ignore-error-status))
          ((:auto)
           (run-spec spec :ignore-error-status ignore-error-status :output output))))))
    (string
     (apply 'run-process-spec (on-host-spec host spec) :host nil keys))
    (function
     (apply 'run-process-spec (funcall host spec) :host nil keys))))

(defun run (cmd &key on-error time (output t) show host)
  (labels ((process-time ()
             (if time (time (process-command)) (process-command)))
           (process-command ()
             (handler-case
                 (run-process-spec
                  cmd
                  :ignore-error-status nil :output output :host host)
               (t () (error-behaviour on-error)))))
    (when show
      (format *trace-output* "; ~A~%" (print-process-spec cmd)))
    (process-time)))

(defun run/s (cmd &rest keys &key on-error time show host)
  "run command CMD, return its standard output results as a string."
  (declare (ignore on-error time show host))
  (apply 'run cmd :output 'string keys))

(defun run/ss (cmd &rest keys &key on-error time show host)
  "Like run/s, but strips the line ending off the result string;
very much like `cmd` or $(cmd) at the shell"
  (declare (ignore on-error time show host))
  (apply 'run cmd :output :string/stripped keys))

(defun slurp-stream-string/stripped (input-stream)
  (stripln (slurp-stream-string input-stream)))

(defmethod slurp-input-stream ((x (eql :string/stripped)) input-stream
{'fraction_non_alphanumeric': 0.13196043896490992, 'fraction_numerical': 0.00027096599376778217, 'mean_word_length': 2.5052231718898383, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 3, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1099372', 'n_tokens_mistral': 2289, 'n_tokens_neox': 2241, 'n_words': 697}