;;;
;;; Guix automation.
;;;
(with-eval-after-load 'geiser-guile
  (define-key scheme-mode-map
              (kbd "<f6>")
              (lambda ()
                (interactive)
                (let ((win (selected-window)))
                  (save-excursion
                    (guix-devel-lint-package)
                    (end-of-buffer))
                  (select-window win)))))

(defun guix-package-name-at-point ()
  "Return the name of package at point, as a string"
  (save-excursion
    (beginning-of-defun)
    (forward-char)                      ;skip (
    (forward-sexp)                      ;define-public
    (forward-comment (point-max))
    (symbol-name (symbol-at-point))))

(defun guix-package-sexp-at-point ()
  "Return the package at point, as a string."
  (save-mark-and-excursion
    (mark-defun)
    (buffer-substring-no-properties
     (region-beginning)
     (region-end))))

;;; Patched version, to be removed after released upstream.
(defun guix-geiser-eval-in-repl-synchronously (str &optional repl
                                                   no-history no-display)
  "Evaluate STR in Geiser REPL synchronously, i.e., wait until the
REPL operation will be finished.
See `guix-geiser-eval-in-repl' for the meaning of arguments."
  (let* ((repl (if repl (get-buffer repl) (guix-geiser-repl)))
         (proc (get-buffer-process repl))
         (running? nil)
         (filter (lambda (output)
                   (setq running?
                         (and (get-buffer-process repl)
                              (not (guix-guile-prompt? output))))))
         (comint-output-filter-functions
          (cons filter comint-output-filter-functions)))
    (guix-geiser-eval-in-repl str repl no-history no-display)
    (while running?
      (accept-process-output proc 0.1)
      (unless no-display
        (redisplay t)
        (end-of-buffer)))))

(defun guix-build-package-at-point ()
  "Evaluate sexp at point and build it in Geiser."
  (interactive)
  (let* ((name (guix-package-name-at-point))
         (sexp-string (guix-package-sexp-at-point))
         (build-command (format ",build %s" name))
         (register-last-value-hook
          (format
           "%s"
           '(add-hook! before-print-hook
                       (lambda (v)
                         (if (not (unspecified? v))
	                     (let ((history (resolve-module '(value-history)))
                                   (last '$0))
                               (module-define! history last v)
	                       (module-export! history (list last)))))))))
    ;; Evaluate the package.
    (geiser-mode-switch-to-repl-and-enter) ;start geiser/load module
    (geiser-repl-switch)                ;switch back to scheme buffer
    (guix-geiser-eval sexp-string)

    ;; Build the package.
    (guix-geiser-eval "(use-modules (guix))")
    (guix-geiser-eval  register-last-value-hook)
    (guix-geiser-eval-in-repl-synchronously build-command)

    ;; Inspect log file if the build failed.
    (let ((repl-text (save-mark-and-excursion
                       (end-of-buffer)
                       (mark)
                       (search-backward build-command)
                       (buffer-substring-no-properties
                        (region-beginning)
                        (region-end)))))
      (geiser-repl-switch)              ;restore original cursor
      ;; FIXME: We should be checking for the REPL exit status, geiser
      ;; seems to have something called 'retort' for that?
      (cond ((string-match (rx "View build log at '" (group (+ graphic)) "'.")
                           repl-text)
             (let ((revert-without-query '(".*")))
               (guix-build-log-find-file (match-string 1 repl-text))
               (end-of-buffer)))
            ((string-search "error" repl-text)
             nil)
            (guix-geiser-eval-in-repl-synchronously
             "\
(when (module-variable (current-module) '$0)
 (format #t \"Build succeeded; log at `~a'~%\"
         (with-store store (log-file store $0)))
 $0)")))))

;;; Bind it to F7.
(with-eval-after-load 'scheme
  (define-key scheme-mode-map
              (kbd "<f7>")
              #'guix-build-package-at-point))

(defun guix-commit-package-at-point ()
  "Commit a new package NAME at point."
  (interactive)
  (save-buffer)
  (save-window-excursion
    (save-mark-and-excursion
      (let* ((name (guix-package-name-at-point))
             (package-text (guix-package-sexp-at-point))
             (diff-text (replace-regexp-in-string
                         "^" "+" (string-trim-left package-text)))
             (magit-save-repository-buffers 'dontask))
        ;; Find and select change.
        (magit-diff-unstaged)
        (beginning-of-buffer)
        (let* ((end (search-forward diff-text))
               (beg (- end (length diff-text))))
          (set-mark end)
          (goto-char beg))
        ;; Stage it.
        (magit-stage)
        ;; Commit it.
        (let ((commit-message (format "gnu: Add %s.

* %s (%s): New variable." name (car (magit-staged-files)) name)))
          (magit-call-git "commit" "-m" commit-message))
        (magit-refresh)
        (message "Package %s committed." name))))
  ;; Refresh buffer, to update areas highlighted with diff-hl-mode.
  (revert-buffer t t))

;;; Bind it to F8.
(with-eval-after-load 'scheme
  (define-key scheme-mode-map
              (kbd "<f8>")
              #'guix-commit-package-at-point))