stash/stash2.scm

;;; Code:

;; Import necessary modules
(use-modules (ice-9 getopt-long)
             (ice-9 popen)  ;; Additional module for executing system commands
             (ice-9 rdelim))

;;; ANSI Color Codes for terminal output
(define red-text "\x1b[31m")
(define yellow-text "\x1b[33m")
(define green-text "\x1b[32m")
(define reset-text "\x1b[0m")

;;; Function to wrap messages in color
(define (color-message message color)
  (string-append color message reset-text))

(define (shell-quote-argument arg)
  (if (string-contains arg " ")
      (string-append "\"" (string-replace arg "\"" "\\\"") "\"")
      arg))

(define (parse-arguments args)
  "Parse command-line arguments."
  (let* ((opts (getopt-long args
                            '((target (value #t) (required? #t))
                              (package-dir (value #t) (required? #t))))))
    opts))

(define (delete-directory path)
  (if (file-is-directory? path)
      (begin
        (system (string-append "rm -r " (shell-quote-argument path)))
        #t)
      #f))

(define (prompt-user-for-action)
  "Prompt the user to decide how to handle a conflict: overwrite (o), skip (s), or cancel (c)."
  (display (color-message "A conflict was detected. Choose action - Overwrite (o), Skip (s), or Cancel (c): " yellow-text))
  (let ((response (read-line)))
    (cond
      ((string-ci=? response "o") 'overwrite)
      ((string-ci=? response "s") 'skip)
      ((string-ci=? response "c") 'cancel)
      (else
       (display (color-message "Invalid input. Please try again.\n" red-text))
       (prompt-user-for-action))))) ; Recursive call on invalid input.


;; (define (prompt-user-for-action)
;;   "Prompt the user to decide how to handle a conflict: overwrite (o), skip (s), or rename (r)."
;;   (display (color-message "A conflict was detected. Choose action - Overwrite (o), Skip (s), or Rename (r): " yellow-text))
;;   (let ((response (read-line)))
;;     (cond
;;       ((string-ci=? response "o") 'overwrite)
;;       ((string-ci=? response "s") 'skip)
;;       ((string-ci=? response "r") 'rename)
;;       (else
;;        (display (color-message "Invalid input. " red-text))
;;        (prompt-user-for-action))))) ; Recursive call on invalid input.

(define (file-is-symlink? path)
  ;; Use lstat to check if the file is a symbolic link without following it
  (let ((stat (lstat path)))
    (eqv? (stat:type stat) 'symlink)))

(define (create-symlink source target)
  "Create a symlink for the source file or directory at the target location."
  ;; Determine whether source is a file or directory and adjust the target path accordingly.
  (let ((target-symlink-path
         (if (file-is-directory? source)
             (string-append target "/" (basename source))  ;; If it's a directory, append the directory name to the target
             (string-append target "/" (basename source))))) ;; If it's a file, append the file name to the target
    (if (file-exists? target-symlink-path)
        (handle-conflicts source target-symlink-path) ; Call conflict handler if symlink already exists
        (catch 'system-error
          (lambda ()
            (symlink source target-symlink-path)
            (display (color-message (format #f "Symlink created: ~a -> ~a\n" target-symlink-path source) green-text)))
          (lambda args
            (display (color-message "Error creating symlink.\n" red-text)))))))

(define (handle-conflicts source target)
  ;; Display the conflict message in yellow (warning).
  (display (color-message (format #f "Conflict detected! A symbolic link already exists at ~a.\n" target) yellow-text))
  (let ((choice (prompt-user-for-action))) ;; Call the updated prompt-user-for-action
    (cond
      ((eq? choice 'overwrite)
       ;; Check if the target is a symlink, and remove the symlink (not the directory it points to).
       (if (file-is-symlink? target)
           (begin
             (delete-file target) ;; Safely delete the symlink.
             (display (color-message "Removed the existing symbolic link.\n" green-text))
             ;; Now, recreate the symlink after removing the old one
             (create-symlink source (dirname target)))
           (display (color-message "Error: Target is not a symbolic link.\n" red-text))))
      ((eq? choice 'skip)
       ;; Do nothing; keep the existing symbolic link.
       (display (color-message "Keeping existing symbolic link.\n" green-text)))
      ((eq? choice 'cancel)
       ;; Cancel the operation and exit
       (display (color-message "Operation cancelled.\n" yellow-text))
       (exit 0))
      (else
       ;; Invalid input (this should never happen because prompt-user-for-action handles it).
       (display (color-message "Invalid choice. Please try again.\n" red-text))
       (handle-conflicts source target)))))


;; (define (handle-conflicts source target)
;;   ;; Display the conflict message in yellow (warning).
;;   (display (color-message (format #f "Conflict detected! A symbolic link already exists at ~a.\n" target) yellow-text))
;;   (display "Do you want to:\n")
;;   (display "1. Remove the existing symbolic link and create a new one\n")
;;   (display "2. Keep the existing symbolic link\n")
;;   (display "3. Cancel the operation\n")
;;   (display "> ")
;;   (let ((choice (read)))
;;     (cond
;;       ((eq? choice 1)
;;        ;; Check if the target is a symlink, and remove the symlink (not the directory it points to).
;;        (if (file-is-symlink? target)
;;            (begin
;;              (delete-file target) ;; Safely delete the symlink.
;;              (display (color-message "Removed the existing symbolic link.\n" green-text))
;;              ;; Now, recreate the symlink after removing the old one
;;              (create-symlink source (dirname target)))
;;            (display (color-message "Error: Target is not a symbolic link.\n" red-text))))
;;       ((eq? choice 2)
;;        ;; Do nothing; keep the existing symbolic link.
;;        (display (color-message "Keeping existing symbolic link.\n" green-text)))
;;       ((eq? choice 3)
;;        ;; Cancel the operation and exit
;;        (display (color-message "Operation cancelled.\n" yellow-text))
;;        (exit 0))
;;       (else
;;        ;; Invalid input, so retry.
;;        (display (color-message "Invalid choice. Please try again.\n" red-text))
;;        (handle-conflicts source target)))))


;; (define (handle-conflicts source target)
;;   ;; Display the conflict message in yellow (warning).
;;   (display (color-message (format #f "Conflict detected! A symbolic link already exists at ~a.\n" target) yellow-text))
;;   (display "Do you want to:\n")
;;   (display "1. Remove the existing symbolic link and create a new one\n")
;;   (display "2. Keep the existing symbolic link\n")
;;   (display "> ")
;;   (let ((choice (read)))
;;     (cond
;;       ((eq? choice 1)
;;        ;; Check if the target is a symlink, and remove the symlink (not the directory it points to).
;;        (if (file-is-symlink? target)
;;            (begin
;;              (delete-file target) ;; Safely delete the symlink.
;;              (display (color-message "Removed the existing symbolic link and created a new one.\n" green-text)))
;;            (display (color-message "Error: Target is not a symbolic link.\n" red-text))))
;;       ((eq? choice 2)
;;        ;; Do nothing; keep the existing symbolic link.
;;        (display (color-message "Keeping existing symbolic link.\n" green-text)))
;;       (else
;;        ;; Invalid input, so retry.
;;        (display (color-message "Invalid choice. Please try again.\n" red-text))
;;        (handle-conflicts source target)))))


;; (define (handle-conflicts source target)
;;   ;; Display the conflict message in yellow (warning).
;;   (display (color-message (format #f "Conflict detected! A symbolic link already exists at ~a.\n" target) yellow-text))
;;   (display "Do you want to:\n")
;;   (display "1. Remove the existing symbolic link and create a new one\n")
;;   (display "2. Keep the existing symbolic link\n")
;;   (display "> ")
;;   (let ((choice (read)))
;;     (cond
;;       ((eq? choice 1)
;;        ;; Check if the target is a symlink, and remove the symlink (not the directory it points to).
;;        (if (file-is-symlink? target)
;;            (begin
;;              (delete-file target) ;; Safely delete the symlink.
;;              (display (color-message "Removed the existing symbolic link and created a new one.\n" green-text))) ;; Use display
;;            (display (color-message "Error: Target is not a symbolic link.\n" red-text)))) ;; Use display
;;       ((eq? choice 2)
;;        ;; Do nothing; keep the existing symbolic link.
;;        (display (color-message "Keeping existing symbolic link.\n" green-text))) ;; Use display
;;       (else
;;        ;; Invalid input, so retry.
;;        (display (color-message "Invalid choice. Please try again.\n" red-text)) ;; Use display
;;        (handle-conflicts source target)))))


;; (define (handle-conflicts source target)
;;   ;; Display the conflict message in yellow (warning).
;;   (display (color-message (format #f "Conflict detected! A symbolic link already exists at ~a.\n" target) yellow-text))
;;   (display "Do you want to:\n")
;;   (display "1. Remove the existing symbolic link and create a new one\n")
;;   (display "2. Keep the existing symbolic link\n")
;;   (display "> ")
;;   (let ((choice (read)))
;;     (cond
;;       ((eq? choice 1)
;;        ;; Check if the target is a symlink, and remove the symlink (not the directory it points to).
;;        (if (file-is-symlink? target)
;;            (begin
;;              (delete-file target) ;; Safely delete the symlink.
;;              (color-message (format #f "Removed the existing symbolic link and created a new one.\n") green-text))
;;            (color-message (format #f "Error: Target is not a symbolic link.\n") red-text)))
;;       ((eq? choice 2)
;;        ;; Do nothing; keep the existing symbolic link.
;;        (color-message (format #f "Keeping existing symbolic link.\n") green-text))
;;       (else
;;        ;; Invalid input, so retry.
;;        (color-message (format #f "Invalid choice. Please try again.\n") red-text)
;;        (handle-conflicts source target)))))

;; (define (handle-conflicts source target)
;;   ;; Display the conflict message in yellow (warning).
;;   (display (color-message (format #f "Conflict detected! A symbolic link already exists at ~a.\n" target) yellow-text))
;;   (display "Do you want to:\n")
;;   (display "1. Remove the existing symbolic link and create a new one\n")
;;   (display "2. Keep the existing symbolic link\n")
;;   (display "> ")
;;   (let ((choice (read)))
;;     (cond
;;       ((eq? choice 1)
;;        ;; Check if the target is a symlink, and remove the symlink (not the directory it points to).
;;        (if (file-is-symlink? target)
;;            (delete-file target) ;; Safely delete the symlink.
;;            (format #t "Error: Target is not a symbolic link.\n"))
;;        (format #t "Removed the existing symbolic link and created a new one.\n"))
;;       ((eq? choice 2)
;;        ;; Do nothing; keep the existing symbolic link.
;;        (format #t "Keeping existing symbolic link.\n"))
;;       (else
;;        ;; Invalid input, so retry.
;;        (format #t "Invalid choice. Please try again.\n")
;;        (handle-conflicts source target)))))

;; This section kind of works.
;; (define (handle-conflicts source target)
;;   ;; Display the conflict message with the target path.
;;   (format #t "Conflict detected! A symbolic link already exists at ~a.\n" target)
;;   (display "Do you want to:\n")
;;   (display "1. Remove the existing link and create a new one\n")
;;   (display "2. Keep the existing link\n")
;;   (display "> ")
;;   (let ((choice (read)))
;;     (cond
;;       ((eq? choice 1)
;;        ;; Check if the target is a directory and remove it appropriately.
;;        (if (file-is-directory? target)
;;            (delete-directory target)
;;            (delete-file target))
;;        (format #t "Removed the existing link and created a new one.\n"))
;;       ((eq? choice 2)
;;        ;; Do nothing; keep the existing link.
;;        (format #t "Keeping existing link.\n"))
;;       (else
;;        ;; Invalid input, so retry.
;;        (format #t "Invalid choice. Please try again.\n")
;;        (handle-conflicts source target)))))

;; Original working code
;; (define (handle-conflicts existing-path new-symlink-path)
;;   "Handle conflicts between existing files and new symlinks."
;;   (case (prompt-user-for-action)
;;     ((overwrite)
;;      (if (file-is-directory? existing-path)
;;          (delete-directory existing-path)  ;; Call the delete-directory function
;;          (delete-file existing-path))  ;; Use Guile's built-in delete-file for files
;;      (symlink new-symlink-path existing-path)
;;      (format #t (color-message (string-append "Existing file/directory overwritten with new symlink: " existing-path " -> " new-symlink-path "\n") green-text)))
;;     ((skip)
;;      (display (color-message "Skipped creating new symlink due to conflict.\n" red-text)))
;;     ((rename)
;;      ;; Prompt for new name and execute renaming
;;      (display (color-message "Enter new name for the existing symlink or file: " yellow-text))
;;      (let ((new-name (read-line)))
;;        (let ((new-path (string-append (dirname existing-path) "/" new-name)))
;;          (rename-file existing-path new-path)
;;          (format #t (color-message (string-append "Renamed " existing-path " to " new-name "\n") green-text)))))
;;     (else
;;      (display (color-message "No valid action selected, no changes made.\n" red-text)))))

;; (define (create-symlink source target)
;;   "Create a symlink for the source directory at the target location."
;;   (let ((target-symlink-path (string-append target "/" (basename source))))
;;     (if (file-exists? target-symlink-path)
;;         (handle-conflicts target-symlink-path source) ; Call conflict handler if file exists
;;         (catch 'system-error
;;           (lambda ()
;;             (symlink source target-symlink-path)
;;             (display (color-message (string-append "Symlink created for: " target-symlink-path " -> " source "\n") green-text)))
;;           (lambda args
;;             (display (color-message "Error creating symlink.\n" red-text)))))))

;;; Updated main function with error handling using `catch`
(define (main args)
  "Main function to parse arguments and initiate processing."
  (setenv "GUILE_AUTO_COMPILE" "0")
  (let* ((options (parse-arguments args))
         (target-dir (assoc-ref options 'target))
         (package-dir (assoc-ref options 'package-dir)))
    (if (and target-dir package-dir)
        (catch 'symlink-error
          (lambda ()
            (create-symlink package-dir target-dir)) ;; Try to create symlink
          (lambda (key . args)
            ;; Handle the 'symlink-error
            (display (color-message (format #f "Error creating symlink: ~a\n" (car args)) red-text))))
        (begin
          (display (color-message "Error: Missing required arguments.\n" red-text))
          (display (color-message "Usage: guile stash.scm --target=<target-dir> --package-dir=<package-dir>\n" yellow-text))
          (exit 1)))))

;; Entry point for guile-stash
(main (command-line))