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

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

(require 'syd-constants)

(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 (&rest args)
  ;; Call the continuation if non-nil.  Wraps the return value in a singleton
  ;; list for "affine" use with unquote-splicing.
  (-let (((forms . (&alist :with-each with-each
                           :with-all with-all))
          (syd-parse-rest-and-keys args))
         (call-cont (lambda (cont arg)
                      (if cont
                          (list (funcall cont arg))
                        nil)))
         names)
    `(progn
       ,@(cl-loop
          for form in forms
          appending (cond ((and (symbolp form) (functionp form))
                           (push form names)
                           (funcall call-cont with-each form))
                          ((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-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)
  (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))))

;; TODO: Support (syd-add-hook 'hook (defun my-hook () ...))
(defun syd-add-hook (hooks &rest functions)
  (declare (indent defun))
  (dolist (hook (ensure-list hooks))
    (dolist (fn functions)
      (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 ""))))))

(provide 'syd-prelude)