#+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 (and error output?) 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))))

(deftype direct-command-spec ()
  '(and command-spec (satisfies direct-command-spec-p)))

(defun direct-command-spec-p (spec)
  (and (typep spec 'command-spec)
       (null (command-redirections spec))))

(defun run-spec (spec &key ignore-error-status output)
  (let* ((command
          (if (consp spec)
            (parse-process-spec spec)
            spec))
         (command
          (etypecase command
            (direct-command-spec
             (command-arguments spec))
            (process-spec
             (print-process-spec spec))
            (string
             spec))))
    (case output
      ((t)
       (run-program/ command :ignore-error-status ignore-error-status))
      ((:interactively)
       (run-program/interactively
        command :ignore-error-status ignore-error-status))
      (otherwise
       (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
        (run-spec spec :ignore-error-status ignore-error-status :output output))
       (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 time (output t) show host (on-error (list "Command ~S failed~@[ on ~A~]" cmd 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)
               (subprocess-error () (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
                               &key &allow-other-keys)
  (slurp-stream-string/stripped input-stream))

(defun run/lines (cmd &rest keys &key on-error time show host)
  "Like run/s, but return a list of lines rather than one string"
  (declare (ignore on-error time show host))
  (apply 'run cmd :output :lines keys))