;;; stdio.el -- stdio routines for emacs lisp  -*- lexical-binding: t; -*-
;;; Commentary:
;;; Code:

(require 'cl-lib)

(cl-defstruct (stdio-process (:constructor stdio-process-create)
                             (:copier nil))
  emacs-process buffer)

(defun stdio-make-filter (process)
  "Return a input filter function for PROCESS."
  (lambda (_ input)
    (setf (stdio-process-buffer process)
          (concat (stdio-process-buffer process)
                  input))))

(defvar stdio--process-counter 0)

(defun stdio--make-process-name ()
  "Generate a new uniqe process name."
  (let* ((num stdio--process-counter)
         (name (format "stdio-subp-%d" num)))
    (setq stdio--process-counter (+ stdio--process-counter 1))
    name))

(defun stdio-call (command)
  "Call COMMAND, return stdio-process."
  (let* ((process (stdio-process-create))
         (process-name (stdio--make-process-name))
         (emacs-process (make-process
                         :name process-name
                         :command command
                         :coding 'utf-8-unix
                         :noquery nil
                         :connection-type 'pipe
                         :filter (stdio-make-filter process)
                         :stderr (get-buffer-create
                                  (format "*%s stderr*" process-name))
                         )))
    (setf (stdio-process-emacs-process process) emacs-process)
    process))

(defun stdio-read-line (process)
  "Read next line from PROCESS."
  (if-let ((stdin-buf (stdio-process-buffer process))
           (newline-pos (string-search "\n" stdin-buf))
           (line (substring stdin-buf 0 newline-pos))
           (rest (substring stdin-buf (+ 1 newline-pos))))
      (progn
        (setf (stdio-process-buffer process) rest)
        line)
    ;; no newline character found
    (if (accept-process-output (stdio-process-emacs-process process))
        (stdio-read-line process)
      ;; no more output from process
      (when (> (length stdin-buf) 0)
        (progn (setf (stdio-process-buffer process) "")
               stdin-buf)))))

(defun stdio-read-json (process &rest JSON-ARGS)
  "Read next json element from PROCESS.

The arguments JSON-ARGS are directly passed to `json-parse-string'
and control how json elements are represented as Lisp constructs.

Json elements need to be seperated by newlines."
  (let (next-line input-string json-object done)
    (while (not done)
      (setq next-line (stdio-read-line process)
            input-string (concat input-string next-line)
            json-object (condition-case err
                            (apply #'json-parse-string input-string JSON-ARGS)
                          (json-trailing-content (signal (car err) (cdr err)))
                          (json-end-of-file nil)
                          (json-parse-error nil))
            done (or (not next-line)
                     json-object)))
    json-object))

(defun stdio-quit (process)
  "Kill the subprocess PROCESS."
  (delete-process (stdio-process-emacs-process process)))

(defun stdio-write-line (process string)
  "Write STRING to PROCESS, ensure it ends with a newline character."
  (let ((line (string-trim-right string "\r?\n?"))
        (emacs-process (stdio-process-emacs-process process)))
    (process-send-string emacs-process (concat line "\n"))))

(provide 'stdio)
;;; stdio.el ends here