#!/usr/bin/env bash
":"; command -v emacs >/dev/null || { >&2 echo "Emacs isn't installed"; exit 1; } # -*-emacs-lisp-*-
":"; [[ $(emacs --version | head -n1) == *\ 2[0-2].[0-1].[0-9] ]] && { echo "You're running $(emacs --version | head -n1)"; echo "That version is too old to run the doctor. Check your PATH"; echo; exit 2; } || exec emacs --quick --script "$0"

;; Uses a couple simple heuristics to locate issues with your environment that
;; could interfere with running or setting up DOOM Emacs.

;; In case it isn't defined (in really old versions of Emacs, like the one that
;; ships with MacOS).
(defvar user-emacs-directory (expand-file-name "~/.emacs.d/"))

(unless (equal (expand-file-name user-emacs-directory)
               (expand-file-name "~/.emacs.d/"))
  (error "Couldn't find ~/.emacs.d"))

(require 'pp)

;;
(defvar doom-init-p nil)
(defvar doom-errors 0)
(defmacro check! (cond &rest body)
  (declare (indent defun))
  `(when ,cond
     ,@body
     (setq doom-errors (1+ doom-errors))))

(defun indented (spc msg)
  (declare (indent defun))
  (with-temp-buffer
    (insert msg)
    (indent-rigidly (point-min) (point-max) spc)
    (buffer-string)))

(defun autofill (&rest msgs)
  (declare (indent defun))
  (let ((fill-column 70))
    (with-temp-buffer
      (dolist (line msgs)
        (when line
          (insert line)))
      (fill-region (point-min) (point-max))
      (buffer-string))))

(defun columns (cols length strings)
  (declare (indent defun))
  (with-temp-buffer
    (let ((sub-format (format "%%-%ds " (1- length)))
          col-format)
      (dotimes (i (1- cols))
        (setq col-format (concat col-format sub-format)))
      (setq col-format (concat col-format "%s"))
      (while strings
        (insert (apply #'format col-format
                       (let (args)
                         (dotimes (i cols (nreverse args))
                           (push (if strings (pop strings) "") args))))
                "\n")))
    (buffer-string)))

(defmacro wait-for! (var if-body &optional else-body)
  (declare (indent defun))
  `(let ((i 0))
     (while (and (not ,var)
                 (< i 5))
       (sleep-for 1)
       (setq i (1+ i)))
     (if ,var
         ,if-body
       ,else-body)))

(defun color (code msg &rest args)
  (format "\e[%dm%s\e[%dm" code (apply #'format msg args) 0))

(defalias 'msg! #'message)
(defmacro error!   (&rest args) `(message (color 1 (color 31 ,@args))))
(defmacro warn!    (&rest args) `(message (color 1 (color 33 ,@args))))
(defmacro success! (&rest args) `(message (color 1 (color 32 ,@args))))
(defmacro log!     (&rest args) `(if doom-debug-mode (message (color 34 ,@args))))
(defmacro explain! (&rest args) `(message (indented 2 (autofill ,@args))))

;;; Polyfills
;; early versions of emacs won't have this
(unless (fboundp 'string-match-p)
  (defun string-match-p (regexp string &optional start)
    (save-match-data
      (string-match regexp string &optional start))))


;; --- start a'doctorin' --------------------------------------

(msg! "%s\nRunning Emacs v%s, commit %s"
      (color 1 "DOOM Doctor")
      (color 1 emacs-version)
      (if (executable-find "git")
          (shell-command-to-string "git rev-parse HEAD")
        "n/a"))
(when (boundp 'system-configuration-features)
  (msg! "Compiled with:\n%s" (indented 2 (autofill system-configuration-features))))
(msg! "uname -a:\n%s" (indented 2 (autofill (shell-command-to-string "uname -a"))))

(let (doom-core-packages doom-debug-mode)
  (condition-case ex
      (progn
        (let ((inhibit-message t)
              noninteractive)
          (load "~/.emacs.d/init.el" nil t))
        (doom-initialize-packages)
        (doom|finalize)
        (success! "Attempt to load DOOM: success! Loaded v%s" doom-version)
        (when (executable-find "git")
          (msg! "Revision %s"
                (or (ignore-errors
                      (let ((default-directory user-emacs-directory))
                        (shell-command-to-string "git rev-parse HEAD")))
                    "\n"))))
    ('error (warn! "Attempt to load DOOM: failed\n  %s\n"
                   (or (cdr-safe ex) (car ex))))))

(msg! "----\n")

;; --- is emacs set up properly? ------------------------------

(log! "test-emacs")
(check! (version< emacs-version "25.1")
  (error! "Important: Emacs %s detected [%s]" emacs-version (executable-find "emacs"))
  (explain!
   "DOOM only supports >= 25.1. Perhaps your PATH wasn't set up properly."
   (when (eq system-type 'darwin)
     (concat "\nMacOS users should use homebrew (https://brew.sh) to install Emacs\n"
             "  brew install emacs --with-modules --with-imagemagick --with-cocoa"))))


;; --- is the environment set up properly? --------------------

;; windows? windows
(log! "test-windows")
(check! (memq system-type '(windows-nt ms-dos cygwin))
  (warn! "Warning: Windows detected")
  (explain! "DOOM was designed for MacOS and Linux. Expect a bumpy ride!"))

;; are all default fonts present
(log! "test-fonts")
(if (not (fboundp 'find-font))
    (progn
      (warn! "Warning: unable to detect font")
      (explain! "The `find-font' function is missing. This could indicate the incorrect "
                "version of Emacs is being used!"))
  ;; all-the-icons fonts
  (let ((font-dest (pcase system-type
                     ('gnu/linux (concat (or (getenv "XDG_DATA_HOME")
                                             (concat (getenv "HOME") "/.local/share"))
                                         "/fonts/"))
                     ('darwin (concat (getenv "HOME") "/Library/Fonts/")))))
    (when (and font-dest (require 'all-the-icons nil t))
      (dolist (font all-the-icons-font-names)
        (if (file-exists-p (expand-file-name font font-dest))
            (success! "Found font %s" font)
          (warn! "Warning: couldn't find %s font in %s"
                 font font-dest)
          (explain! "You can install it by running `M-x all-the-icons-install-fonts' within Emacs.\n\n"
                    "This could also mean you've installed them in non-standard locations, in which "
                    "case, ignore this warning."))))))

;; gnutls-cli & openssl
(log! "test-gnutls")
(cond ((executable-find "gnutls-cli"))
      ((executable-find "openssl")
       (let* ((output (shell-command-to-string "openssl ciphers -v"))
              (protocols
               (let (protos)
                 (mapcar (lambda (row)
                           (add-to-list 'protos (cadr (split-string row " " t))))
                         (split-string (shell-command-to-string "openssl ciphers -v") "\n"))
                 (delq nil protos))))
         (check! (not (or (member "TLSv1.1" protocols)
                          (member "TLSv1.2" protocols)))
           (let ((version (cadr (split-string (shell-command-to-string "openssl version") " " t))))
             (warn! "Warning: couldn't find gnutls-cli, and OpenSSL is out-of-date (v%s)" version)
             (explain!
              "This may not affect your Emacs experience, but there are security "
              "vulnerabilities in the SSL2/3 & TLS1.0 protocols. You should use "
              "TLS 1.1+, which wasn't introduced until OpenSSL v1.0.1.\n\n"

              "Please consider updating (or install gnutls-cli, which is preferred).")))))
      (t
       (check! t
         (error! "Important: couldn't find either gnutls-cli nor openssl")
         (explain!
          "You won't be able to install/update packages because Emacs won't be able to "
          "verify HTTPS ELPA sources. Install gnutls-cli or openssl v1.0.0+. If for some "
          "reason you can't, you can bypass this verification with the INSECURE flag:\n\n"

          "  INSECURE=1 make install\n\n"

          "Or change `package-archives' to use non-https sources.\n\n"

          "But remember that you're leaving your security in the hands of your "
          "network, provider, government, neckbearded mother-in-laws, geeky roommates, "
          "or just about anyone who knows more about computers than you do!"))))

(log! "test-tls")
(cond ((not (string-match-p "\\_<GNUTLS\\_>" system-configuration-features))
       (warn! "Warning: You didn't install Emacs with gnutls support")
       (explain!
        "This may cause 'pecular error' errors with the Doom doctor, and is likely to "
        "interfere with package management. Your mileage may vary."
        (when (eq system-type 'darwin)
          (concat "\nMacOS users are advised to install Emacs via homebrew with one of the following:\n"
                  "    brew install emacs --with-gnutls"
                  "      or"
                  "    brew tap d12frosted/emacs-plus"
                  "    brew install emacs-plus"))))

      ((or (executable-find "gnutls-cli")
           (executable-find "openssl"))
       (let ((tls-checktrust t)
             (gnutls-verify-error t))
         (dolist (url '("https://elpa.gnu.org"
                        "https://melpa.org"))
           (condition-case-unless-debug ex
               (let (result)
                 (let ((inhibit-message t))
                   (url-retrieve url (lambda (status &rest _) (setq result status))))
                 (wait-for! result
                   (when (getenv "DEBUG")
                     (success! "Verified %s" (nth 2 (split-string url "/"))))
                   (signal 'timed-out url)))
             ('timed-out
              (error! "Timed out trying to contact %s" ex))
             ('error
              (check! t
                (error! "Rejected %s" url)
                (explain! (pp-to-string ex))))))
         (dolist (url '("https://self-signed.badssl.com"
                        "https://wrong.host.badssl.com/"))
           (condition-case-unless-debug ex
               (let (result)
                 (let ((inhibit-message t))
                   (url-retrieve url (lambda (status &rest _) (setq result status))))
                 (wait-for! result
                   (check! t
                     (warn! "Verified %s (this shouldn't happen!)" (nth 2 (split-string url "/")))
                     (explain! (pp-to-string result)))
                   (signal 'timed-out url)))
             ('timed-out
              (error! "Timed out trying to contact %s" ex))
             ('error
              (when (getenv "DEBUG")
                (success! "Rejected %s (a good thing!)" url)
                (explain! (pp-to-string ex))))))))

      (t
       (error! "Nope!")))

;; bsd vs gnu tar
(log! "test-tar")
(let ((tar-bin (or (executable-find "gtar")
                   (executable-find "tar"))))
  (if tar-bin
      (check! (not (string-match-p "(GNU tar)" (shell-command-to-string (format "%s --version" tar-bin))))
        (warn! "Warning: BSD tar detected")
        (explain!
         "QUELPA (through package-build) uses the system tar to build plugins, but it "
         "expects GNU tar. BSD tar *could* cause errors during package installation or "
         "updating from non-ELPA sources."
         (when (eq system-type 'darwin)
           (concat "\nMacOS users can install gnu-tar via homebrew:\n"
                   "    brew install gnu-tar"))))
    (check! t ; very unlikely
      (error! "Important: Couldn't find tar")
      (explain!
       "This is required by package.el and QUELPA to build packages and will "
       "prevent you from installing & updating packages."))))


;; --- report! ------------------------------------------------

(when (getenv "DEBUG")
  (msg! "\n====\nHave some debug information:\n")

  (when (bound-and-true-p doom-modules)
    (msg! "  + enabled modules:\n%s"
       (indented 4
         (columns 3 23
           (mapcar (lambda (x) (format "+%s" x))
                   (mapcar #'cdr (doom-module-pairs)))))))

  (when (and (bound-and-true-p doom-packages)
             (require 'package nil t))
    (msg! "  + enabled packages:\n%s"
       (indented 4
         (columns 2 35
           (mapcar (lambda (pkg)
                     (let ((desc (cadr (assq pkg package-alist))))
                       (when desc
                         (package-desc-full-name desc))))
                   (sort (mapcar #'car doom-packages) #'string-lessp))))))

  (msg! "  + byte-compiled files:\n%s"
     (indented 4
       (columns 2 39
         (let ((files (append (directory-files-recursively doom-core-dir ".elc$")
                              (directory-files-recursively doom-modules-dir ".elc$"))))
           (or (and files (mapcar (lambda (file) (file-relative-name file doom-emacs-dir))
                                  (nreverse files)))
               (list "n/a"))))))

  (msg! "  + exec-path:\n%s"
     (indented 4
       (columns 1 79 exec-path)))

  (msg! "  + PATH:\n%s"
     (indented 4
       (columns 1 79 (split-string (getenv "PATH") ":")))))

;;
(if (= doom-errors 0)
    (success! "Everything seems fine, happy Emacs'ing!")
  (message "\n----")
  (warn! "There were issues!")
  (unless (getenv "DEBUG")
    (msg! "\nHopefully these can help you find problems. If not, run this doctor again with DEBUG=1:")
    (msg! "\n  DEBUG=1 make doctor\n")
    (msg! "And file a bug report with its output at https://github.com/hlissner/.emacs.d/issues")))