;;; -*- lexical-binding: t -*-
;;;
;;; Copyright © 2022 David Thompson <davet@gnu.org>
;;;
;;; emacs-guix-shell is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by the
;;; Free Software Foundation, either version 3 of the License, or (at your
;;; option) any later version.
;;;
;;; emacs-guix-shell is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
;;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
;;; for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program.  If not, see
;;; <http://www.gnu.org/licenses/>.

(defvar guix-shell--search-paths '()
  "Project environment variable cache.")

(defun guix-shell--current-directory ()
  "Return the project directory for the current buffer."
  (let ((project (project-current)))
    (if project
        (project-root project)
      default-directory)))

(defun guix-shell--search-paths-for-directory (directory)
  "Execute 'guix shell' in DIRECTORY, parse the output, and return
an alist of search path environment variables."
  (let ((buffer (get-buffer-create "*guix-shell-temp*"))
        (names '()))
    (with-current-buffer buffer
      (setq default-directory directory)
      (erase-buffer)
      (call-process "guix" nil t nil "shell" "--search-paths")
      ;; Gather up the names of all the environment variables and transform
      ;; the lines into echo commands that we can eval to get the actual
      ;; search path values.
      (goto-char (point-min))
      (while (not (eobp))
        (let ((start (point)))
          (forward-word)
          (let ((word (buffer-substring-no-properties start (point))))
            (if (string-equal word "export")
                (progn
                  (forward-whitespace 1)
                  (delete-backward-char (- (point) start))
                  (let ((var-start (point)))
                    (search-forward "=")
                    (backward-char 1)
                    (push (buffer-substring-no-properties var-start (point)) names)
                    (delete-backward-char (- (point) var-start)))
                  (delete-char 1)
                  (insert "echo ")
                  (beginning-of-line)
                  (forward-line 1))
              (progn
                (goto-char start)
                (kill-whole-line))))))
      (setq names (reverse names))
      ;; Eval the search paths.
      (call-process-region (point-min) (point-max) "sh" t t nil)
      ;; Iterate over the result lines and create an environment variable
      ;; mapping.
      (goto-char (point-min))
      (let ((env-vars '()))
        (dolist (var names)
          (let ((start (point)))
            (end-of-line 1)
            (let ((search-path (buffer-substring-no-properties start (point))))
              (push (cons var search-path) env-vars))
            (beginning-of-line)
            (forward-line 1)))
        (kill-buffer buffer)
        env-vars))))

(defun guix-shell--update-search-paths-for-directory (directory)
  "Refresh the cached 'guix shell' search paths for DIRECTORY."
  (when directory
    (let ((search-paths (guix-shell--search-paths-for-directory directory)))
      (setq guix-shell--search-paths
            (cons (cons directory (or search-paths 'none))
                  (assoc-delete-all directory guix-shell--search-paths)))
      search-paths)))

(defun guix-shell--cached-search-paths-for-directory (directory)
  "Return an alist of 'guix shell' search paths cached for
DIRECTORY.  If there are no cached search paths, nil is returned.
If the search paths are cached but DIRECTORY has no 'guix shell'
search paths present, 'none' is returned.."
  (cdr (assoc directory guix-shell--search-paths)))

;; From envrc.el
(defun guix-shell--merged-environment (process-env pairs)
  "Make a `process-environment' value that merges PROCESS-ENV with PAIRS.
PAIRS is an alist obtained from direnv's output.  Values from
PROCESS-ENV will be included, but their values will be masked by
Emacs' handling of `process-environment' if they also appear in
PAIRS."
  (append (mapcar (lambda (pair)
                    (format "%s=%s" (car pair) (cdr pair)))
                  pairs)
          process-env))

(defun guix-shell--apply-search-paths (search-paths)
  "Apply SEARCH-PATHS to the environment of the current buffer."
  (setq-local process-environment
              (guix-shell--merged-environment process-environment search-paths))
  (setq-local exec-path (append (parse-colon-path (getenv "PATH"))
                                (list exec-directory)))
  (when (derived-mode-p 'eshell-mode)
    (setq-local eshell-path-env path)))

(defun guix-shell--apply-search-paths-for-directory (directory)
  "Set search path environment variables from 'guix shell' for
DIRECTORY."
  (when directory
    (let ((search-paths
           (or (guix-shell--cached-search-paths-for-directory directory)
               (guix-shell--update-search-paths-for-directory directory))))
      (unless (eq search-paths 'none)
        (guix-shell--apply-search-paths search-paths)))))

(defun guix-shell--apply-search-paths-for-current-directory ()
  "Set search path environment variables from 'guix shell' in the
context of the current directory."
  (guix-shell--apply-search-paths-for-directory (guix-shell--current-directory)))

(defun guix-shell--clear (buffer)
  "Remove any effects of `guix-shell-mode' from BUFFER."
  (with-current-buffer buffer
    (kill-local-variable 'exec-path)
    (kill-local-variable 'process-environment)
    (kill-local-variable 'eshell-path-env)))

(defun guix-shell-update ()
  "Update the search paths set by 'guix shell'."
  (interactive)
  (guix-shell--update-search-paths-for-directory
   (guix-shell--current-directory))
  (guix-shell--clear (current-buffer))
  (guix-shell-apply-search-paths-for-current-directory))

;;;###autoload
(define-minor-mode guix-shell-mode
  "A local minor mode in which environment variables are set by
'guix shell'."
  :init-value nil
  (if guix-shell-mode
      (guix-shell--apply-search-paths-for-current-directory)
    (guix-shell--clear (current-buffer))))

;;;###autoload
(define-globalized-minor-mode guix-shell-global-mode guix-shell-mode
  (lambda ()
    (unless (or (minibufferp) (file-remote-p default-directory))
      (guix-shell-mode 1))))