shadow-cljs.el

;; -*- lexical-binding: t -*-
;;; shadow-cljs.el --- shadow-cljs bindings for Emacs
;;; Commentary: Provides easy Cider interaction
;;              for shadow-cljs.

(require 'cider)
(require 'edn)


;; target/shadow-cljs/nrepl.port
(defvar-local shadow-cljs-ps nil)
(defvar-local shadow-cljs--retrycount 0)
(defvar       shadow-cljs--cider-repl-buffer nil)

;; https://emacs.stackexchange.com/a/3339
(defmacro shadow-cljs--add-hook-run-once (hook function &optional append local)
  "Like add-hook, but remove the hook after it is called"
  (let ((sym (make-symbol "#once")))
    `(progn
       (defun ,sym ()
         (remove-hook ,hook ',sym ,local)
         (funcall ,function))
       (add-hook ,hook ',sym ,append ,local))))

(defun shadow-cljs-find-config-file (&optional init-dir)
  (let ((cur-dir (or init-dir default-directory)))
    (if (string-equal "/" cur-dir)
        (error "No shadow-cljs.edn was found")
      (if (member "shadow-cljs.edn"
                  (directory-files
                   (directory-file-name cur-dir)))
          cur-dir
        (shadow-cljs-find-config-file
         (file-name-directory (directory-file-name cur-dir)))))))


;; FIXME: prompt option when more than 1
(defun shadow-cljs--find-cider-repl-buffer ()
  (first (cider-repl-buffers)))

;; (shadow-cider-force-cljs (shadow-cljs--find-cider-repl-buffer))

(defvar-local shadow-cider-force-cljs--timeout 0)


(defun shadow-cider-force-cljs (repl-buf build-id)
  (if (string-match-p build-id
                      (with-current-buffer repl-buf
                        (buffer-string)))
      (run-with-timer
       1 nil
       (lambda ()
         (setq shadow-cider-force-cljs--timeout 0)
         (with-current-buffer repl-buf
           (if (string-equal "clj" cider-repl-type)
               (prog2
                   (setq cider-repl-type "cljs")
                   (shadow-cider-force-cljs repl-buf build-id))
             (cider-repl--emit-interactive-output
              "shadow-cljs.el -> JS connection established!" :nil)))))
    (when (< shadow-cider-force-cljs--timeout 100)
      (run-with-timer
       1 nil (lambda ()
               (setq shadow-cider-force-cljs--timeout
                     (1+ shadow-cider-force-cljs--timeout))
               (shadow-cider-force-cljs repl-buf build-id))))))

(defun shadow-cljs--cider-connect (project-root port)
  (when-let* ((repl-buff (cider-find-reusable-repl-buffer '("localhost" port) nil)))
    (let* ((nrepl-create-client-buffer-function  #'cider-repl-create)
           (nrepl-use-this-as-repl-buffer repl-buff)
           (conn (process-buffer (nrepl-start-client-process "localhost" port))))
      (with-current-buffer conn
        (setq cider-connection-created-with 'connect))
      (cider-assoc-project-with-connection project-root conn)
      conn)))


(defun shadow-cljs--nrepl-select (build-id)
  (let ((repl-buf (shadow-cljs--find-cider-repl-buffer)))
    ;; (switch-to-buffer repl-buf)
    (with-current-buffer repl-buf
      (cider-interactive-eval
       (format "(shadow.cljs.devtools.api/nrepl-select %s)" build-id))
      ;; (cider-interactive-eval ":dummy\n")
      ;; (goto-char (buffer-size))
      (shadow-cider-force-cljs repl-buf build-id)
      ;; (switch-to-buffer last-buff)
      )))


(defun shadow-cljs--get-process-port (project-root cache-root callback)
  (let ((nrepl-port-file (concat (file-name-as-directory project-root)
                                 (file-name-as-directory cache-root)
                                 "nrepl.port")))
    (if (< 1000 shadow-cljs--retrycount)
        (prog2 (setq shadow-cljs--retrycount 0)
            (funcall callback :timeout))
      (if (file-exists-p nrepl-port-file)
          (funcall callback
                   (with-temp-buffer
                     (insert-file-contents nrepl-port-file)
                     (read (buffer-string))))
        ;; 1 min timeout
        (run-with-timer
         0.6 nil
         (lambda ()
           (setq shadow-cljs--retrycount (1+ shadow-cljs--retrycount))
           (shadow-cljs--get-process-port project-root cache-root callback)))))))


(defun shadow-cljs--output-message-sentinel (process msg)
  (when (and (processp process)
             (memq (process-status process) '(exit signal)))
    (message (concat (process-name process) " - " msg))))

(defun shadow-cljs--chomp (str)
  "Chomp leading and tailing whitespace from STR."
  (while (string-match "\\`\n+\\|^\\s-+\\|\\s-+$\\|\n+\\'" str)
    (setq str (replace-match "" t t str)))
  str)

(defun shadow-cljs--process-filter (process msg)
  (if shadow-cljs--cider-repl-buffer
      (cider-repl--emit-interactive-output msg :nil)
    (message "%s" (shadow-cljs--chomp msg))))


(defun shadow-cljs-start-process (project-root build-id cache-root &optional watch-arg)
  (progn
    (when (processp (get-process "shadow-cljs"))
      (process-send-string (get-process "shadow-cljs") ":repl/quit\n")
      (kill-process "shadow-cljs"))
    (let ((default-directory project-root))
      (setq shadow-cljs-ps
            (if (or (string-equal "node-repl" build-id)
                    (string-equal "browser-repl" build-id))
                (start-process "shadow-cljs" nil "shadow-cljs" build-id)
              (start-process "shadow-cljs" nil "shadow-cljs" "watch" watch-arg))))
    ;; (set-process-sentinel shadow-cljs-ps 'shadow-cljs--output-message-sentinel)
    (set-process-filter shadow-cljs-ps 'shadow-cljs--process-filter)
    (set-process-query-on-exit-flag shadow-cljs-ps nil)
    ;; (set-process-sentinel shadow-cljs-ps )
    (shadow-cljs--add-hook-run-once
     'nrepl-connected-hook
     (lambda ()
       (shadow-cljs--nrepl-select (if (and (stringp build-id)
                                           (or (string-equal "node-repl" build-id)
                                               (string-equal "browser-repl" build-id)))
                                      (concat ":" build-id)
                                    watch-arg))
       (cider-repl--emit-interactive-output "shadow-cljs.el -> wait a moment..." :nil)
       (setq shadow-cljs--cider-repl-buffer
             (shadow-cljs--find-cider-repl-buffer)))
     t nil)
    (shadow-cljs--add-hook-run-once
     'nrepl-disconnected-hook
     (lambda ()
       (setq shadow-cljs--cider-repl-buffer nil)
       (when (processp (get-process "shadow-cljs"))
         (process-send-string (get-process "shadow-cljs") ":repl/quit\n")
         ;; (delete-file (concat (file-name-as-directory project-root)
         ;;                      (file-name-as-directory cache-root)
         ;;                      "nrepl.port"))
         (kill-process "shadow-cljs")
         ;; (setq shadow-cljs-ps nil)
         )))))



(defun shadow-cljs-jack-in (op)
  (interactive
   (list
    (completing-read "shadow-cljs " '("watch" "node-repl" "browser-repl"))))
  (let* ((project-root (shadow-cljs-find-config-file default-directory))
         (shadow-cljs-edn (edn-read (with-temp-buffer
                                      (insert-file-contents
                                       (concat project-root "shadow-cljs.edn"))
                                      (buffer-string))))
         (watch-arg (when (string-equal "watch" op)
                      (completing-read
                       "build-id "
                       (hash-table-keys
                        (gethash :builds shadow-cljs-edn)))))
         (cache-root (or (gethash :cache-root shadow-cljs-edn) ".shadow-cljs")))
    (shadow-cljs-start-process project-root op cache-root watch-arg)
    (shadow-cljs--get-process-port
     project-root
     cache-root
     (lambda (port)
       (if (eq :timeout port)
           (throw :timeout (error "starting shadow-cljs timed out after 1 minute"))
         (shadow-cljs--cider-connect project-root port))))))



(provide 'shadow-cljs)