(uiop:define-package ambrevar/shell
  (:documentation "Shell-like utilities.")
  ;; (:nicknames #:$)
  (:use #:common-lisp)
  (:use #:trivia)
  (:import-from #:ambrevar/file)
  (:import-from #:serapeum #:export-always))
(in-package ambrevar/shell)
(eval-when (:compile-toplevel :load-toplevel :execute)
  (trivial-package-local-nicknames:add-package-local-nickname :alex :alexandria)
  (trivial-package-local-nicknames:add-package-local-nickname :sera :serapeum))

(export-always 'date)
(defun date ()
  (local-time:format-rfc1123-timestring nil (local-time:now)))

(export-always 'env)
(defun env (&optional key)
  "Return the environment variables as a proper alist.
With KEY, return the corresponding environment variable value, and the whole
list as a second value."
  (let ((result
          (mapcar (lambda (line)
                    (let ((key-value (str:split "=" line :limit 2)))
                      (cons (first key-value)
                            (str:split (uiop:inter-directory-separator)
                                       (second key-value)))))
                  (str:split (string #\newline) (cmd:$cmd "env")))))
    (if key
        (alex:assoc-value result key :test #'string=)
        result)))

(export-always 'file->string)
(defun file->string (path)
  (sera:chomp (alex:read-file-into-string path)))

(defun assert-program (program &rest more-programs) ; TODO: Is this useful for a REPL?
  (sera:and-let* ((missing-programs
                   (delete-if #'sera:resolve-executable (cons program more-programs))))
    (error "Missing programs: ~{~a~,^, ~}" missing-programs)))

(export-always 'delete-empty-directory-upward)
(defun delete-empty-directory-upward (directory)
  "Delete directory and its parents until non-empty.
Return the first non-deleted directory."
  (or (and (ignore-errors (uiop:delete-empty-directory directory))
           (delete-empty-directory-upward
            (uiop:pathname-parent-directory-pathname
                 (uiop:ensure-directory-pathname directory))))
      directory))

(export-always 'make-directory)
(defun make-directory (path)
  "Including parents."
  (uiop:ensure-all-directories-exist (list (uiop:ensure-directory-pathname path)))
  path)

(defun system-signal (pid-or-pids &key (signal 'term) options)
  "OPTIONS are PKILL options."
  ;; TODO: Is it possible to kill a group without pkill, maybe with osicat?
  (uiop:run-program
   (append
    (list (if options "pkill" "kill") (format nil "-~a" signal))
    options
    (mapcar #'princ-to-string (alex:ensure-list pid-or-pids)))))

(defun kill (pid-or-pids)
  "Kill PID-OR-PIDS (with SIGKILL)."
  (system-signal pid-or-pids :signal 'kill))

(defun term (pid-or-pids)
  "Cleanly terminate PID-OR-PIDS."
  (system-signal pid-or-pids :signal 'term))

(defun terminate-process-with-group (process-info)
  (when (uiop:process-alive-p process-info)
    (system-signal
     (list (format nil "~a" (osicat-posix:getpgid (uiop:process-info-pid process-info))))
     :signal 'term                      ;TODO: -KILL instead?
     :options '("-g"))
    (uiop:terminate-process process-info)))

(defvar *process-list* '()
  "List of processes started from `run'.")

;; (export-always 'terminate-dangling-processes)
;; (defun terminate-dangling-processes ()
;;   (mapc #'terminate-process-with-group *process-list*)
;;   ;; TODO: Maybe don't flush the list in case some processes failed to be terminated.
;;   ;; Use -KILL to fix this?
;;   (setf *process-list* nil))

(export-always '*shell*)
(defvar *shell* "sh"
  "Default shell to use in `sh' and friends.
Also see `*shell-command-flags*'.")

(export-always '*shell-command-flag*)
(defvar *shell-command-flag* "-c"
  "Flag to pass a command string to the `*shell*'.")

(defun format-shell-command (shell-command)
  (format nil "~a ~a '~a'"
          *shell* *shell-command-flag* shell-command))

(export-always 'sh)
(defun sh (shell-command)
  "Wrapper around `cmd:cmd' to execute SHELL-COMMAND in `*shell*'."
  (cmd:cmd (format-shell-command shell-command)))

(export-always 'sh&)
(defun sh& (shell-command)
  "Wrapper around `cmd:cmd&' to execute SHELL-COMMAND in `*shell*'."
  (cmd:cmd& (format-shell-command shell-command)))

(export-always '$sh)
(defun $sh (shell-command)
  "Wrapper around `cmd:$cmd' to execute SHELL-COMMAND in `*shell*'."
  (cmd:$cmd (format-shell-command shell-command)))

(export-always 'cmd&)
(defun cmd& (cmd)                       ; TODO: Support (cmd &rest args) lambda list.
  "Like `cmd:cmd&' but run and monitor in a shell.
When Lisp is exited, the command is automatically terminated.
List of background process is maintained in `*process-list*'."
  (let* ((cmd (format nil
                      "bash -c 'set -o monitor; { ~a ; kill $$ ; } & read dummy; kill %1'" cmd))
         (handle (cmd:cmd& cmd :input :stream)))
    (push handle *process-list*)
    handle))

(export-always 'cmd>)
(defun cmd> (cmd &rest args) ; TODO: "|" is not convenient in CL, use "/" or "-"?  See `cmd<>'.
  "Like `cmd:cmd&' but return the output as a stream.
Return the process handler as second value.
Use

  (uiop:slurp-stream-string STREAM :stripped t)

to get the final output as a string."
  (let ((handler (apply #'cmd:cmd& cmd (append args
                                               (list :output :stream)))))
    (values (uiop:process-info-output handler)
            handler)))

(export-always 'cmd<>)
(defun cmd<> (cmd &rest args)
  "Like `cmd>' but last argument is passed as `:input'.
This can be usefully chained, e.g. with arrow macros.
Example:

  (->>
    (cmd> \"cat\" \".../share/hunspell/en_GB-large.dic\")
    (cmd<> \"sort\")
    (cmd<> \"uniq\" \"-c\")
    (cmd<> \"sort\" \"-nr\")
    (cmd<> \"head\" \"-3\"))"
  (let* ((butlast-args (butlast args))
         (last-arg (first (last args)))
         (handler (apply #'cmd:cmd& cmd (append butlast-args
                                                (list :output :stream
                                                      :input last-arg)))))
    (values (uiop:process-info-output handler)
            handler)))

(export-always 'cmd<)
(defun cmd< (cmd &rest args)
  "Like `cmd<>' but output to standard output."
  (let* ((butlast-args (butlast args))
         (last-arg (first (last args))))
    (apply #'cmd:cmd cmd (append butlast-args
                                 (list :input last-arg)))))

(export-always '$cmd<)
(defun $cmd< (cmd &rest args)
  "Like `cmd<>' but return string."
  (let* ((butlast-args (butlast args))
         (last-arg (first (last args))))
    (apply #'cmd:$cmd cmd (append butlast-args
                                  (list :input last-arg)))))

(defun %cmd- (final-caller &rest args)
  "See `cmd-'."
  (let ((arg-lists (sera:split-sequence :- args)))
    (sera:nlet call ((arg-lists arg-lists)
                     (last-result-stream nil))
      (let* ((args (first arg-lists)))
        (if (rest arg-lists)
            (let ((handler
                    (apply #'cmd:cmd&
                           (first args)
                           (append (rest args)
                                   (list :output :stream)
                                   (when last-result-stream
                                     (list :input last-result-stream))))))
              (call (rest arg-lists) (uiop:process-info-output handler)))
            (apply final-caller (first args)
                   (append (rest args)
                           (when last-result-stream
                             (list :input last-result-stream)))))))))

(export-always 'cmd-)
(defun cmd- (&rest args)
  "Call `:-'-separated commands in args, passing the result of one onto the next.
Example:

(cmd- \"cat\" \".../share/hunspell/en_GB-large.dic\"
  :- \"sort\"
  :- \"uniq\" \"-c\"
  :- \"sort\" \"-nr\"
  :- \"head\" \"-3\")"
  (apply #'%cmd- #'cmd:cmd args))

(defun $cmd- (&rest args)
  "Like `cmd-' but return a string."
  (apply #'%cmd- #'cmd:$cmd args))

(defun cmd-& (&rest args)
  "Like `cmd-' but return a `process-info' object."
  (apply #'%cmd- #'cmd:cmd& args))

(defun cmd-> (&rest args)
  "Like `cmd-' but return a stream."
  (apply #'%cmd- #'cmd> args))

(defvar *visual-command* '("htop"))
(defvar *command-wrappers* '("sudo" "env"))
(defun visual-command-p (command)
  "Return true if the COMMAND list runs one of the programs in `*visual-command*'.
`*command-wrappers*' are supported, i.e.

  env FOO=BAR sudo -i powertop

works."
  (labels ((basename (arg)
             (namestring (pathname-name arg)))
           (flag? (arg)
             (str:starts-with? "-" arg))
           (variable? (arg)
             (and (< 1 (length arg))
                  (str:contains? "=" (subseq arg 1))))
           (first-positional-argument (command)
             "Return the argument that's not a flag, not a variable setting and
not in `*command-wrappers*'."
             (when command
               (if (or (flag? (first command))
                       (variable? (first command))
                       (find (basename (first command))
                             *command-wrappers*
                             :test #'string=))
                   (first-positional-argument (rest command))
                   (first command)))))
    (sera:and-let* ((cmd (first-positional-argument command)))
      (find (basename cmd)
            *visual-command*
            :test #'string=))))

(defun vterm-terminal (cmd)
  (list
   "emacsclient" "--eval"
   (let ((*print-case* :downcase))
     (write-to-string
      `(progn
         (vterm)
         (vterm-insert ,(str:join " " cmd))
         (vterm-send-return))))))

(defvar *terminal* '("/gnu/store/751mcahyg3b5dpwkbfvzg6x1vdn9i49a-xterm-363/bin/xterm" "-e")
  "The terminal is either a list of arguments after which will be prepended to
the visual command to run, or a function of one argument, the list of commands,
returning the new list of commands.")

(defun maybe-launch-visual-command (cmd)
  (if (visual-command-p cmd)
      (cmd:cmd
       (if (functionp *terminal*)
           (funcall *terminal* cmd)
           (append *terminal* cmd)))
      (cmd:cmd cmd)))

(setf *terminal* #'vterm-terminal)

;; (maybe-launch-visual-command '("htop"))

(export-always 'tee)
(defun tee (input-stream)               ; TODO: Real `tee' with separate process.
  "Return the INPUT-STREAM and its string representation as a second value."
  (let ((result
          (uiop:slurp-stream-string input-stream :stripped t)))
    (values
     (make-string-input-stream result)
     result)))

(export-always 'disk-usage)
(defun disk-usage (files)
  "Return disk usage of FILES in octets.
As a second value, return a list of (FILE SIZE) pairs, biggest file first."
  (let ((pairs (mapcar (lambda (f)
                         (list f (or (trivial-file-size:file-size-in-octets f)
                                     0)))
                       files)))
    (values
     (reduce #'+ (mapcar #'second pairs))
     (sort
      pairs
      #'> :key #'second))))

(export-always 'tokenize)
(defun tokenize (string)
  "Return list of STRING lines, where each line is a list of each word."
  (mapcar (lambda (line)
            (sera:tokens line))
          (str:split (string #\newline) string)))

(export-always 'port-process)
(defun port-process (port)
  "Return process PID using PORT, NIL is none.
Return process name as second value."
  (sera:and-let* ((ss-line (first
                            (tokenize
                             (cmd:$cmd "ss"
                                       "--no-header"
                                       "--listening"
                                       "--tcp"
                                       "--processes"
                                       (format nil "( dport = :~a or sport = :~a )" port port)))))
                  (process-desc (first (last ss-line)))
                  (process-desc-no-prefix (second (str:split ":" process-desc)))
                  (process-props (first
                                  (read-from-string
                                   (str:replace-all "," " " process-desc-no-prefix))))
                  (process-name (first process-props))
                  (process-pid-prop (find-if (lambda (prop) (str:starts-with? "PID=" (string prop))) process-props))
                  (process-pid-string (second (str:split "=" (string process-pid-prop))))
                  (process-pid (parse-integer process-pid-string)))
    (values
     process-pid
     process-name)))

(export-always 'sha1)
(defun sha1 (file)                  ; TODO: Use pure CL / FFI version?
  "Return checksum of FILE."
  (first (first (tokenize (cmd:$cmd "sha1sum" (write-to-string (ambrevar/file:path file)))))))

(export-always 'move-file)
(defun move-file (source destination)
  "`rename-file' does not work cross-device, in particular it does not work on
different Btrfs subvolumes."
  (uiop:run-program (list "mv"
                          ;; Use native-namestring in case path contains escaped
                          ;; character, like "\\[".
                          (uiop:native-namestring source)
                          (uiop:native-namestring destination))))

(defun loopback? (interface)
  (or (string= "link/loopback" (first (second interface)))
      (string= "lo:" (second (first interface)))))

(defun ipv4 (interface)
  (when (string= "inet" (first (third interface)))
    (values (ppcre:regex-replace "/.*" (second (third interface)) ""))))

;; TODO: Make class for interfaces?  Can iolib / usocket be helpful here?
(defun interfaces (&optional interface)
  "Return IP of current INTERFACE.
INTERFACE is a string in the form of `wlp2s0'."
  (let* ((raw-list (tokenize (cmd:$cmd "ip" "address" interface))))
    (sera:collecting
      (sera:do-splits ((l r) (raw-list (lambda (line)
                                         (ppcre:scan "[0-9]+:" (first line)))))
        (sera:and-let* ((split (subseq raw-list (max 0 (1- l)) r)))
          (collect split))))))

(defun interfaces-with-ipv4 ()
  "Return list of interfaces with ipv4, excluding the loopback."
  (remove-if (complement #'ipv4)
             (remove-if #'loopback? (interfaces))))

(defun current-interface ()
  (first (interfaces-with-ipv4)))

(export-always 'current-ip)
(defun current-ip ()
  (ipv4 (current-interface)))