;; Deepenv
;; Copyright (C) 2024 Guillaume Pasquet

;; This program 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.

;; This program 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/>.

(import scheme
        (chicken base)
        (chicken pathname)
        (chicken file)
        (chicken io)
        (chicken string)
        (chicken process)
        (chicken process-context)
        (chicken condition)
        (chicken format)
        srfi-1
        srfi-13
        srfi-14)

(define (dir-has-.env? dir)
  (file-exists? (make-pathname dir ".env")))

(define (split-env-line line)
  (let* ((definition (string-split line "="))
         (key (car definition))
         (value (string-trim-both (cadr definition)
                                  (list->char-set (list #\") char-set:whitespace))))
    (cons key value)))

(define (line-empty? line)
  (string=? "" (string-trim-both line)))

(define (line-comment? line)
  (let ((clean-line (string-trim-both line)))
    (and (> (string-length clean-line) 0)
	 (eq? (string-ref clean-line 0) #\#))))

(define (line-eof? line)
  (eq? line #!eof))

(define (line-ignore? line)
  (or (line-empty? line)
      (line-comment? line)))

(define (read-env-line port)
  "Read an env-definition line from PORT and return as a cons cell"
  (let ((line (read-line port)))
    (cond
     ((line-eof? line) #!eof)
     ((line-ignore? line) '())
     (else (split-env-line line)))))

(define (load-dir-.env dir)
  "Load a .env file present in `.dir` and return its environment definitions as a alist"
  (let ((.env-file (conc dir "/.env")))
    (if (file-exists? .env-file)
        (filter
	 (lambda (item)
	   (not (null? item)))
	 (with-input-from-file .env-file
	   (lambda () (read-list (current-input-port) read-env-line))))
        '())))

(define (path-parts path)
  (call-with-values
      (lambda () (decompose-directory path))
    (lambda (origin base elts)
      (if (not (eq? origin #f))
          (cons origin elts)
          (if (not (eq? base #f))
              (cons base elts)
              elts)))))

(define (path-parents path)
  (fold (lambda (item acc)
          (if (> (length acc) 0)
              (if (string=? (car acc) "/")
                  (cons (conc "/" item) acc)
                  (cons (conc (car acc) "/" item) acc))
              (list item)))
        '()
        (path-parts path)))

(define (.env-union alist2 alist1)
  (lset-union (lambda (a b) (string=? (car a) (car b)))
              alist2 alist1))

(define (resolve-program program)
  (let* ((paths (map
                     (lambda (path)
                       (conc path "/" program))
                     (string-split (get-environment-variable "PATH") ":")))
         (executables (filter file-exists? paths)))
    (if (> (length executables) 0)
        (car executables)
        program)))

(define (run-with-.env directory command arguments)
  (let* ((parents (path-parents directory))
             (environment (fold .env-union '() (cons (get-environment-variables) (reverse (map load-dir-.env parents)))))
             (program (resolve-program command)))
    (condition-case
        (process-execute program arguments environment)
        ((exn) (printf "Program `~a' not found!~%" command)))))

(let ((not-enough-args (< (length (command-line-arguments)) 1))
      (user-asking-help (find (lambda (item) (string=? item "--help")) (command-line-arguments))))
  (if (or not-enough-args user-asking-help)
      (begin
        (display "Deepenv sources .env files in the current and parent directories, then runs a program.\n")
        (display "Usage: deepenv <program> <arguments>\n"))
      (run-with-.env (current-directory)
                     (car (command-line-arguments))
                     (cdr (command-line-arguments)))))