;;; syd-prelude.el -*- lexical-binding: t; -*-

(eval-when-compile (require 'cl-lib))

(require 'syd-constants)

(use-package dash)

(require 'dash)

(cl-defmacro syd-define-stub
    (name &key (desc "implement me!") interactive)
  (let ((todo (format "%s: TODO: %s" name desc)))
    `(defun ,name (&rest _)
       ,@(if interactive (list '(interactive)) nil)
       ,todo
       (error ,todo))))

;; FIXME: When `arg-list' contains nils, things break.
(cl-defun syd-parse-rest-and-keys (arg-list)
  "The default behaviour of `cl-defun' makes combining &rest with &keys pretty
useless.  This function will partition ARG-LIST by returning a pair (REST
. KEYS), where REST is the list of ARGS that belong to no key-value pair, and
KEYS is an alist of the parsed keywords."
  ;; Ugh.
  (let (parsed-rest parsed-keys)
    (cl-loop for (lead lag) on arg-list by (lambda (x) (-drop 2 x))
             do (if (keywordp lead)
                    (push (cons lead lag) parsed-keys)
                  ;; Push in reverse order; we reverse the whole list as a
                  ;; post-processing step.
                  (push lead parsed-rest)
                  (when lag
                    (push lag parsed-rest))))
    (cons (reverse parsed-rest) parsed-keys)))

(cl-defun syd-lift-lambdas (&key with-each with-all forms)
  ;; Call the continuation if non-nil.  Wraps the return value in a singleton
  ;; list for "affine" use with unquote-splicing.
  (-let ((call-cont (lambda (cont arg)
                      (if cont
                          (list (funcall cont arg))
                        nil)))
         names)
    `(progn
       ,@(cl-loop
          for form in forms
          appending (cond ((syd-hform-symbol form)
                           (let ((name (nth 1 form)))
                             (push name names)
                             (funcall call-cont with-each name)))
                          ((syd-hform-defun form)
                           (let ((name (nth 1 form)))
                             (push name names)
                             `(,form
                               ,@(funcall call-cont with-each name))))
                          ((syd-hform-lambda form)
                           (let ((name (gensym "lifted-lambda")))
                             (push name names)
                             `((defun ,name (&rest args)
                                 (,form args))
                               ,@(funcall call-cont with-each name))))
                          (t (error "IDK!"))))
       ,@(funcall call-cont with-all names))))

(defun syd-hform-symbol (hform)
  (and (listp hform)
       (= 2 (length hform))
       (symbolp (nth 1 hform))
       (memq (nth 0 hform) '(quote function))))

(defun syd-hform-defun (hform)
  "If HFORM is a defun form, return the defun's name.  Otherwise, return nil"
  (when-let* ((sym (car-safe hform)))
    (and (symbolp sym)
         (eq sym 'defun)
         (nth 1 hform))))

(defun syd-hform-lambda (hform)
  "If HFORM is a lambda, return non-nil."
  (when-let* ((sym (car-safe hform)))
    (and (symbolp sym)
         (eq sym 'lambda))))

(defmacro comment (&rest _)
  "Ignore each argument, and expand to nil."
  nil)

(defmacro with-transient-after (hook-or-function &rest forms)
  (declare (indent defun))
  (let ((hook-name (gensym "transient-hook"))
        (hook-or-function* (gensym "hook-or-function")))
    `(let* ((,hook-or-function* ,hook-or-function))
       (defun ,hook-name (&rest _)
         "Transient hook defined by `with-transient-after'."
         (cond ((functionp ,hook-or-function*)
                (advice-remove ,hook-or-function* #',hook-name))
               ((symbolp ,hook-or-function*)
                (remove-hook ,hook-or-function* #',hook-name)))
         ,@forms)
       (cond ((functionp ,hook-or-function*)
              (advice-add ,hook-or-function* :before #',hook-name))
             ((symbolp ,hook-or-function*)
              ;; https://www.gnu.org/software/emacs/manual/html_node/elisp/Setting-Hooks.html#Setting-Hooks-1
              (put ',hook-name 'permanent-local-hook t)
              (add-hook ,hook-or-function* #',hook-name))))))

(defun syd-plist-put (plist prop new-val)
  "Immutably update a single property of PLIST.  Like `plist-put', but PLIST is
not mutated; a new plist is returned."
  (cl-loop for (prop* old-val) on plist by #'cddr
           appending (if (eq prop prop*)
                         (list prop* new-val)
                       (list prop* old-val))))

(defmacro syd-add-hook (hooks &rest hforms)
  (declare (indent defun))
  (syd-lift-lambdas
   :forms hforms
   :with-all (lambda (fns)
               (let ((fn* (gensym "fn"))
                     (fns* (gensym "fns"))
                     (hook* (gensym "hook")))
                 `(let ((,fns* (list ,@(--map `(function ,it)
                                              fns))))
                    (dolist (,hook* (ensure-list ,hooks))
                      (dolist (,fn* ,fns*)
                        (add-hook ,hook* ,fn*))))))))

(defmacro syd-silently (&rest body)
  `(error "TODO: syd-silently"))

(defmacro syd-quietly (&rest body)
  "Evaluate BODY without generating any output.

This silences calls to `message', `load', `write-region' and anything that
writes to `standard-output'.  In interactive sessions this inhibits output to
the echo-area, but not to *Messages*.  Return value is that of BODY's final
form."
  `(if init-file-debug
       (progn ,@body)
     ,(if noninteractive
          `(syd-silently ,@body)
        `(let ((inhibit-message t)
               (save-silently t))
           (prog1 (progn ,@body)
             (message ""))))))

(defun syd--parse-defadvice-args (arg-list)
  "Parses the docstring and keywords provided to `syd-defadvice'."
  (let (docstring
        advice)
    (when (stringp (car-safe arg-list))
      (setq docstring (pop arg-list)))
    (while (and (length> arg-list 2)
                (keywordp (car arg-list)))
      (let ((how (pop arg-list))
            (sym (pop arg-list)))
        (push (cons how sym) advice)))
    ;; What's left of `arg-list' is the body of the defun.
    (list docstring advice arg-list)))

(defmacro syd-defadvice (name params &rest args)
  "Define a function and add it as advice."
  (declare (indent defun))
  (-let (((docstring advice body) (syd--parse-defadvice-args args)))
    `(progn (defun ,name ,params
              ,@(-some-> docstring list)
              ,@body)
            ,@(-map (lambda (arg)
                      (-let (((how . sym) arg))
                        `(advice-add ,sym ,how #',name)))
                    advice))))

(syd-defadvice syd-lsp-install-server-a ()
  :override #'lsp-install-server
  (user-error (concat "Ignoring a call to `lsp-install-server'"
                      " — tell the caller to use Nix!")))

(defun syd-str (sep &rest strs)
  (mapconcat #'identity strs sep))

(provide 'syd-prelude)