From f5c89a0b71eae5de26d2d7227ca05aa286506bdf Mon Sep 17 00:00:00 2001 From: GLENN THOMPSON Date: Fri, 4 Oct 2024 14:40:34 +0300 Subject: [PATCH] Created modules from main scm file --- modules/stash/colors.scm | 13 + modules/stash/conflict.scm | 76 +++++ modules/stash/file-ops.scm | 139 ++++++++ stash-help.scm => modules/stash/help.scm | 2 +- modules/stash/log.scm | 43 +++ modules/stash/paths.scm | 28 ++ stash.log | 68 +--- stash.scm | 390 ++++++++++++++--------- 8 files changed, 535 insertions(+), 224 deletions(-) create mode 100644 modules/stash/colors.scm create mode 100644 modules/stash/conflict.scm create mode 100644 modules/stash/file-ops.scm rename stash-help.scm => modules/stash/help.scm (97%) create mode 100644 modules/stash/log.scm create mode 100644 modules/stash/paths.scm diff --git a/modules/stash/colors.scm b/modules/stash/colors.scm new file mode 100644 index 0000000..911d9c1 --- /dev/null +++ b/modules/stash/colors.scm @@ -0,0 +1,13 @@ + +(define-module (stash colors) + #:export (red-text yellow-text green-text reset-text color-message)) + +;;; 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)) diff --git a/modules/stash/conflict.scm b/modules/stash/conflict.scm new file mode 100644 index 0000000..592f78a --- /dev/null +++ b/modules/stash/conflict.scm @@ -0,0 +1,76 @@ +;; stash-conflict.scm --- Conflict resolution module for Stash + +;; (define-module (stash conflict) +;; #:export (prompt-user-for-action handle-conflict)) + +;; ;; Import necessary modules +;; (use-modules (ice-9 rdelim)) ;; Import read-line function for reading user input + +;; ;;; Conflict resolution handler with user options +;; (define (prompt-user-for-action) +;; "Prompt the user to decide how to handle a conflict: overwrite (o), skip (s), or cancel (c)." +;; (display "A conflict was detected. Choose action - Overwrite (o), Skip (s), or Cancel (c): ") +;; (let ((response (read-line))) +;; (cond +;; ((string-ci=? response "o") 'overwrite) +;; ((string-ci=? response "s") 'skip) +;; ((string-ci=? response "c") 'cancel) +;; (else +;; (display "Invalid input. Please try again.\n") +;; (prompt-user-for-action))))) + +;; ;;; Helper function to handle conflicts +;; (define (handle-conflict target-source-dir source-dir delete-directory log-action) +;; "Handle conflicts when the target directory already exists." +;; (let ((choice (prompt-user-for-action))) +;; (cond +;; ((eq? choice 'overwrite) +;; (delete-directory target-source-dir) +;; (rename-file source-dir target-source-dir) +;; (display (format #f "Overwriting directory ~a.\n" target-source-dir)) +;; (log-action (format #f "Overwritten directory: ~a" target-source-dir))) +;; ((eq? choice 'skip) +;; (display "Skipping move operation.\n") +;; (log-action (format #f "Skipped moving directory: ~a" target-source-dir))) +;; ((eq? choice 'cancel) +;; (display "Operation cancelled by user.\n") +;; (log-action "Operation cancelled by user.") +;; (exit 0))))) + +(define-module (stash conflict) + #:export (prompt-user-for-action handle-conflict)) + +;; Import necessary modules +(use-modules (ice-9 rdelim) + (stash colors)) ;; Import the colors module + +;;; Conflict resolution handler with user options +(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)) ;; Yellow for prompt + (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)) ;; Red for invalid input + (prompt-user-for-action))))) + +;;; Helper function to handle conflicts +(define (handle-conflict target-source-dir source-dir delete-directory log-action) + "Handle conflicts when the target directory already exists." + (let ((choice (prompt-user-for-action))) + (cond + ((eq? choice 'overwrite) + (delete-directory target-source-dir) + (rename-file source-dir target-source-dir) + (display (color-message (format #f "Overwriting directory ~a.\n" target-source-dir) green-text)) ;; Green for success + (log-action (format #f "Overwritten directory: ~a" target-source-dir))) + ((eq? choice 'skip) + (display (color-message "Skipping move operation.\n" green-text)) ;; Green for skipping + (log-action (format #f "Skipped moving directory: ~a" target-source-dir))) + ((eq? choice 'cancel) + (display (color-message "Operation cancelled by user.\n" yellow-text)) ;; Yellow for cancel + (log-action "Operation cancelled by user.") + (exit 0))))) diff --git a/modules/stash/file-ops.scm b/modules/stash/file-ops.scm new file mode 100644 index 0000000..ffd946a --- /dev/null +++ b/modules/stash/file-ops.scm @@ -0,0 +1,139 @@ +;; stash-file-ops.scm --- File operations module for Stash + +;; (define-module (stash file-ops) +;; #:export (move-source-to-target create-symlink-in-parent delete-directory)) + +;; ;; Import necessary modules +;; (use-modules (stash log) ;; Import log-action, current-timestamp +;; (stash paths) ;; Import expand-home, concat-path, ensure-config-path +;; (stash conflict)) ;; Import prompt-user-for-action, handle-conflict + +;; ;;; Helper function to quote shell arguments +;; (define (shell-quote-argument arg) +;; "Quote shell argument to handle spaces or special characters." +;; (if (string-contains arg " ") +;; (string-append "\"" (string-replace arg "\"" "\\\"") "\"") +;; arg)) + +;; ;;; Helper function to delete a directory recursively +;; (define (delete-directory path) +;; "Delete a directory recursively." +;; (if (file-is-directory? path) +;; (begin +;; (system (string-append "rm -rf " (shell-quote-argument path))) +;; (log-action (format #f "Deleted directory: ~a" path))) +;; (display "Error: Path is not a directory.\n"))) + +;; ;;; Helper function to move source to target +;; (define (move-source-to-target source-dir target-dir) +;; "Move the entire source directory to the target directory, ensuring .config in the target path." +;; (let* ((target-dir (ensure-config-path target-dir)) ;; Use ensure-config-path from paths.scm +;; (source-dir (expand-home source-dir)) ;; Use expand-home from paths.scm +;; (source-name (basename source-dir)) +;; (target-source-dir (concat-path target-dir source-name))) ;; Use concat-path from paths.scm +;; ;; Ensure that the .config directory exists in the target +;; (if (not (file-exists? target-dir)) +;; (mkdir target-dir #o755)) +;; ;; Check if the target directory already exists +;; (if (file-exists? target-source-dir) +;; (handle-conflict target-source-dir source-dir delete-directory log-action) ;; Conflict handling +;; ;; If the target directory doesn't exist, proceed with the move +;; (begin +;; (rename-file source-dir target-source-dir) +;; (display (format #f "Moved ~a to ~a\n" source-dir target-source-dir)) +;; (log-action (format #f "Moved ~a to ~a" source-dir target-source-dir)))) +;; target-source-dir)) ;; Return the path of the moved source directory + +;; ;;; Helper function to create a symlink in the parent directory of the original source +;; (define (create-symlink-in-parent source-dir target-dir) +;; "Create a symlink in the parent directory of source-dir." +;; (let* ((parent-dir (expand-home (dirname source-dir))) ;; Ensure the parent path is expanded +;; (symlink-target (concat-path parent-dir (basename source-dir))) ;; Concatenate paths safely +;; (target-dir (expand-home target-dir))) ;; Ensure the target path is expanded +;; ;; Check if symlink already exists +;; (if (file-exists? symlink-target) +;; (let ((choice (prompt-user-for-action))) +;; (cond +;; ((eq? choice 'overwrite) +;; (delete-file symlink-target) +;; (symlink target-dir symlink-target) +;; (display (format #f "Overwriting symlink ~a pointing to ~a\n" symlink-target target-dir)) +;; (log-action (format #f "Overwritten symlink: ~a pointing to ~a" symlink-target target-dir))) +;; ((eq? choice 'skip) +;; (display "Skipping symlink creation.\n") +;; (log-action (format #f "Skipped symlink creation: ~a" symlink-target))) +;; ((eq? choice 'cancel) +;; (display "Operation cancelled by user.\n") +;; (log-action "Operation cancelled by user.") +;; (exit 0)))) +;; ;; Create the symlink if no conflict +;; (begin +;; (symlink target-dir symlink-target) +;; (display (format #f "Symlink created at ~a pointing to ~a\n" symlink-target target-dir)) +;; (log-action (format #f "Symlink created at ~a pointing to ~a" symlink-target target-dir)))))) + +(define-module (stash file-ops) + #:export (move-source-to-target create-symlink-in-parent delete-directory)) + +;; Import necessary modules +(use-modules (stash colors) ;; Import color definitions + (stash log) + (stash paths) + (stash conflict)) + +;;; Helper function to delete a directory recursively +(define (delete-directory path) + "Delete a directory recursively." + (if (file-is-directory? path) + (begin + (system (string-append "rm -rf " (shell-quote-argument path))) + (log-action (color-message (format #f "Deleted directory: ~a" path) green-text))) + (display (color-message "Error: Path is not a directory.\n" red-text)))) + +;;; Helper function to move source to target +(define (move-source-to-target source-dir target-dir) + "Move the entire source directory to the target directory, ensuring .config in the target path." + (let* ((target-dir (ensure-config-path target-dir)) + (source-dir (expand-home source-dir)) + (source-name (basename source-dir)) + (target-source-dir (concat-path target-dir source-name))) + ;; Ensure that the .config directory exists in the target + (if (not (file-exists? target-dir)) + (mkdir target-dir #o755)) + ;; Check if the target directory already exists + (if (file-exists? target-source-dir) + (handle-conflict target-source-dir source-dir delete-directory log-action) + ;; If the target directory doesn't exist, proceed with the move + (begin + (rename-file source-dir target-source-dir) + (display (color-message (format #f "Moved ~a to ~a\n" source-dir target-source-dir) green-text)) + (log-action (format #f "Moved ~a to ~a" source-dir target-source-dir)))) + target-source-dir)) + +;;; Helper function to create a symlink in the parent directory of the original source +(define (create-symlink-in-parent source-dir target-dir) + "Create a symlink in the parent directory of source-dir." + (let* ((parent-dir (expand-home (dirname source-dir))) + (symlink-target (concat-path parent-dir (basename source-dir))) + (target-dir (expand-home target-dir))) + ;; Check if symlink already exists + (if (file-exists? symlink-target) + (let ((choice (prompt-user-for-action))) + (cond + ((eq? choice 'overwrite) + (delete-file symlink-target) + (symlink target-dir symlink-target) + (display (color-message (format #f "Overwriting symlink ~a pointing to ~a\n" symlink-target target-dir) green-text)) + (log-action (format #f "Overwritten symlink: ~a pointing to ~a" symlink-target target-dir))) + ((eq? choice 'skip) + (display (color-message "Skipping symlink creation.\n" green-text)) + (log-action (format #f "Skipped symlink creation: ~a" symlink-target))) + ((eq? choice 'cancel) + (display (color-message "Operation cancelled by user.\n" yellow-text)) + (log-action "Operation cancelled by user.") + (exit 0)))) + ;; Create the symlink if no conflict + (begin + (symlink target-dir symlink-target) + (display (color-message (format #f "Symlink created at ~a pointing to ~a\n" symlink-target target-dir) green-text)) + (log-action (format #f "Symlink created at ~a pointing to ~a" symlink-target target-dir)))))) diff --git a/stash-help.scm b/modules/stash/help.scm similarity index 97% rename from stash-help.scm rename to modules/stash/help.scm index b9f4275..c0915a1 100644 --- a/stash-help.scm +++ b/modules/stash/help.scm @@ -1,6 +1,6 @@ ;; stash-help.scm --- Help message module for Stash -(define-module (stash-help) +(define-module (stash help) #:export (display-help)) ;;; Function to display help message diff --git a/modules/stash/log.scm b/modules/stash/log.scm new file mode 100644 index 0000000..d3ab79a --- /dev/null +++ b/modules/stash/log.scm @@ -0,0 +1,43 @@ +;; stash-log.scm --- Logging module for Stash + +;; (define-module (stash log) +;; #:export (log-action current-timestamp)) + +;; (use-modules (srfi srfi-19)) ;; For date and time functions + +;; ;;; Function to get a formatted current time string +;; (define (current-timestamp) +;; "Return the current date and time as a formatted string." +;; (let* ((time (current-time)) +;; (seconds (time-second time))) +;; (strftime "%Y-%m-%d-%H-%M-%S" (localtime seconds)))) + +;; ;;; Function to log actions with a timestamp +;; (define (log-action message) +;; "Log an action with a timestamp to the stash.log file." +;; (let ((log-port (open-file "stash.log" "a"))) ;; Open file in append mode +;; (display (string-append "[" (current-timestamp) "] " message) log-port) +;; (newline log-port) +;; (close-port log-port))) + +(define-module (stash log) + #:export (log-action current-timestamp)) + +;; Import necessary modules +(use-modules (stash colors) ;; Import color definitions + (srfi srfi-19)) ;; For date and time handling + +;;; Helper function to get a formatted current time string +(define (current-timestamp) + "Return the current date and time as a formatted string." + (let* ((time (current-time)) + (seconds (time-second time))) + (strftime "%Y-%m-%d-%H-%M-%S" (localtime seconds)))) + +;;; Improved logging function with timestamp and colored output +(define (log-action message) + "Log an action with a timestamp to the stash.log file." + (let ((log-port (open-file "stash.log" "a"))) ;; Open file in append mode + (display (color-message (string-append "[" (current-timestamp) "] " message) green-text) log-port) ;; Green text in logs + (newline log-port) + (close-port log-port))) diff --git a/modules/stash/paths.scm b/modules/stash/paths.scm new file mode 100644 index 0000000..5c914c8 --- /dev/null +++ b/modules/stash/paths.scm @@ -0,0 +1,28 @@ +;; stash-paths.scm --- Path handling module for Stash + +(define-module (stash paths) + #:export (expand-home concat-path ensure-config-path)) + +;;; Expand ~ in paths to the full home directory path +(define (expand-home path) + "Expand ~ to the user's home directory." + (if (string-prefix? "~" path) + (string-append (getenv "HOME") (substring path 1)) + path)) + +;;; Concatenate paths safely +(define (concat-path base path) + "Concatenate two paths, ensuring there are no double slashes." + (if (string-suffix? "/" base) + (string-append (string-drop-right base 1) "/" path) + (string-append base "/" path))) + +;;; Ensure target has .config appended, avoiding double slashes +(define (ensure-config-path target-dir) + "Ensure that the target directory has .config appended, avoiding double slashes." + (let ((target-dir (expand-home target-dir))) + (if (string-suffix? "/" target-dir) + (set! target-dir (string-drop-right target-dir 1))) ;; Remove trailing slash if it exists + (if (not (string-suffix? "/.config" target-dir)) + (string-append target-dir "/.config") + target-dir))) diff --git a/stash.log b/stash.log index d061036..0d9008b 100644 --- a/stash.log +++ b/stash.log @@ -1,67 +1 @@ -Moved /home/glenn/.config/test to /home/glenn/.dotfiles/.config/test -Symlink created at /home/glenn/.config/test pointing to /home/glenn/.dotfiles/.config/test -Moved /home/glenn/.config/test to /home/glenn/.dotfiles/.config/test -Moved /home/glenn/.config/test to /home/glenn/.dotfiles/.config/test -Moved /home/glenn/.config/test to /home/glenn/.dotfiles/.config/test -Symlink created at /home/glenn/.config/test pointing to /home/glenn/.dotfiles/.config/test -[2024-09-22 11:08:52] Moved /home/glenn/.config/test to /home/glenn/.dotfiles/.config/test -[2024-09-22 11:08:52] Symlink created at /home/glenn/.config/test pointing to /home/glenn/.dotfiles/.config/test -[2024-09-22 13:52:41] Skipped moving directory: /home/glenn/.dotfiles/.config/test -[2024-09-22 13:52:45] Operation cancelled by user. -[2024-09-22 14:00:22] Deleted directory: /home/glenn/.dotfiles/.config/test -[2024-09-22 14:00:22] Overwritten directory: /home/glenn/.dotfiles/.config/test -[2024-09-22 14:00:22] Symlink created at /home/glenn/.config/test pointing to /home/glenn/.dotfiles/.config/test -[2024-09-22-14-13-00] Moved /home/glenn/.config/test to /home/glenn/.dotfiles/.config/test -[2024-09-22-14-13-00] Symlink created at /home/glenn/.config/test pointing to /home/glenn/.dotfiles/.config/test -[2024-09-22-14-13-09] Backed up /home/glenn/.dotfiles/.config/test to /home/glenn/.dotfiles/.config/test.backup.2024-09-22-14-13-09 -[2024-09-22-14-13-09] Moved /home/glenn/.config/test to /home/glenn/.dotfiles/.config/test after backup -[2024-09-22-14-13-09] Symlink created at /home/glenn/.config/test pointing to /home/glenn/.dotfiles/.config/test -[2024-09-22-14-20-03] Moved /home/glenn/.config/test to /home/glenn/.dotfiles/.config/test -[2024-09-22-14-20-03] Symlink created at /home/glenn/.config/test pointing to /home/glenn/.dotfiles/.config/test -[2024-09-22-14-20-09] Backed up /home/glenn/.dotfiles/.config/test to /home/glenn/.dotfiles/.config/test.backup.2024-09-22-14-20-09 -[2024-09-22-14-45-22] Operation cancelled by user. -[2024-09-22 15:08:02] Moved /home/glenn/.config/test to /home/glenn/.dotfiles/.config/test -[2024-09-22 15:08:02] Symlink created at /home/glenn/.config/test pointing to /home/glenn/.dotfiles/.config/test -[2024-09-22-15-10-35] Operation cancelled by user. -[2024-09-22-15-11-04] Moved /home/glenn/.config/test to /home/glenn/.dotfiles/.config/test -[2024-09-22-15-11-04] Symlink created at /home/glenn/.config/test pointing to /home/glenn/.dotfiles/.config/test -[2024-09-22-15-11-19] Operation cancelled by user. -[2024-09-27-12-35-30] Moved /home/glenn/.config/fastfetch/ to /home/glenn/.dotfiles/.config/fastfetch/ -[2024-09-27-12-37-59] Moved /home/glenn/.config/variety to /home/glenn/.dotfiles/.config/variety -[2024-09-27-12-37-59] Symlink created at /home/glenn/.config/variety pointing to /home/glenn/.dotfiles/.config/variety -[2024-09-27-12-41-42] Moved /home/glenn/.password-store to /home/glenn/.dotfiles//.password-store -[2024-09-27-12-41-42] Symlink created at /home/glenn/.password-store pointing to /home/glenn/.dotfiles//.password-store -[2024-10-04-09-23-18] Moved /home/glenn/.config/alacritty/test/ to /home/glenn/.dotfiles//test/ -[2024-10-04-09-28-04] Moved /home/glenn/.config/test to /home/glenn/.dotfiles//test -[2024-10-04-09-28-04] Symlink created at /home/glenn/.config/test pointing to /home/glenn/.dotfiles//test -[2024-10-04-09-38-56] Moved /home/glenn/.config/test to /home/glenn/.dotfiles//test -[2024-10-04-09-38-56] Symlink created at /home/glenn/.config/test pointing to /home/glenn/.dotfiles//test -[2024-10-04-09-44-28] Conflict: Directory /home/glenn/.dotfiles//.config already exists -[2024-10-04-09-44-28] Conflict: Symlink /home/glenn/.config/test already exists -[2024-10-04-09-45-21] Conflict: Directory /home/glenn/.dotfiles//.config already exists -[2024-10-04-09-45-21] Conflict: Symlink /home/glenn/.config/test already exists -[2024-10-04-09-49-29] Moved /home/glenn/.config/test to /home/glenn/.dotfiles//.config/test -[2024-10-04-09-49-29] Symlink created at /home/glenn/.config/test pointing to /home/glenn/.dotfiles//.config/test -[2024-10-04-09-50-37] Conflict: Directory /home/glenn/.dotfiles//.config/test already exists -[2024-10-04-09-50-37] Conflict: Symlink /home/glenn/.config/test already exists -[2024-10-04-09-50-58] Conflict: Directory /home/glenn/.dotfiles//.config/test already exists -[2024-10-04-09-50-58] Conflict: Symlink /home/glenn/.config/test already exists -[2024-10-04-10-03-19] Moved /home/glenn/.config/test to /home/glenn/.dotfiles//.config/test -[2024-10-04-10-03-19] Symlink created at /home/glenn/.config/test pointing to /home/glenn/.dotfiles//.config/test -[2024-10-04-10-03-26] Operation cancelled by user. -[2024-10-04-10-08-56] Operation cancelled by user. -[2024-10-04-10-09-27] Moved /home/glenn/.config/test to /home/glenn/.dotfiles//.config/test -[2024-10-04-10-09-27] Symlink created at /home/glenn/.config/test pointing to /home/glenn/.dotfiles//.config/test -[2024-10-04-10-14-57] Moved /home/glenn/.config/test to /home/glenn/.dotfiles/.config/test -[2024-10-04-10-14-57] Symlink created at /home/glenn/.config/test pointing to /home/glenn/.dotfiles/.config/test -[2024-10-04-10-15-00] Operation cancelled by user. -[2024-10-04-10-18-57] Operation cancelled by user. -[2024-10-04-12-40-06] Moved /home/glenn/.config/test to /home/glenn/.dotfiles/.config/test -[2024-10-04-12-40-06] Symlink created at /home/glenn/.config/test pointing to /home/glenn/.dotfiles/.config/test -[2024-10-04-12-40-11] Operation cancelled by user. -[2024-10-04-12-43-41] Moved /home/glenn/.config/test to /home/glenn/.dotfiles/.config/test -[2024-10-04-12-43-41] Symlink created at /home/glenn/.config/test pointing to /home/glenn/.dotfiles/.config/test -[2024-10-04-12-43-45] Operation cancelled by user. -[2024-10-04-12-46-28] Operation cancelled by user. -[2024-10-04-12-46-43] Skipped moving directory: /home/glenn/.dotfiles/.config/test -[2024-10-04-12-46-48] Operation cancelled by user. +[2024-10-04-14-39-19] Operation cancelled by user. diff --git a/stash.scm b/stash.scm index 546909b..98e70b5 100644 --- a/stash.scm +++ b/stash.scm @@ -34,43 +34,221 @@ ;;; Code: ;; Import necessary modules +;; (use-modules (ice-9 getopt-long) +;; (ice-9 popen) +;; (ice-9 rdelim) +;; (ice-9 format) +;; (stash-help) ;; Import the stash-help module for help functionality +;; (srfi srfi-1) +;; (srfi srfi-19)) ;; Use for list handling and date-time formatting + +;; ;;; 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)) + +;; ;;; Helper function to get a formatted current time string +;; (define (current-timestamp) +;; "Return the current date and time as a formatted string." +;; (let* ((time (current-time)) +;; (seconds (time-second time))) +;; (strftime "%Y-%m-%d-%H-%M-%S" (localtime seconds)))) + +;; ;;; Improved logging function with timestamp +;; (define (log-action message) +;; "Log an action with a timestamp to the stash.log file." +;; (let ((log-port (open-file "stash.log" "a"))) ;; Open file in append mode +;; (display (string-append "[" (current-timestamp) "] " message) log-port) +;; (newline log-port) +;; (close-port log-port))) + +;; ;;; Version function +;; (define (display-version) +;; "Display the current version of the program." +;; (display (format #f "Stash version ~a\n" "0.1.0-alpha.1")) +;; (exit 0)) + +;; ;;; Helper function to check for version flag and display version +;; (define (check-for-version args) +;; "Check if --version or -v is in the arguments list." +;; (if (or (member "--version" args) +;; (member "-v" args)) +;; (display-version))) + +;; ;;; Expand ~ in paths to the full home directory path +;; (define (expand-home path) +;; "Expand ~ to the user's home directory." +;; (if (string-prefix? "~" path) +;; (string-append (getenv "HOME") (substring path 1)) +;; path)) + +;; ;;; Helper function to concatenate paths safely +;; (define (concat-path base path) +;; "Concatenate two paths, ensuring there are no double slashes." +;; (if (string-suffix? "/" base) +;; (string-append (string-drop-right base 1) "/" path) +;; (string-append base "/" path))) + +;; ;;; Conflict resolution handler with user options +;; (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))))) + +;; ;;; Helper function to delete a directory recursively +;; (define (delete-directory path) +;; "Delete a directory recursively." +;; (if (file-is-directory? path) +;; (begin +;; (system (string-append "rm -rf " (shell-quote-argument path))) +;; (log-action (format #f "Deleted directory: ~a" path))) +;; (display (color-message "Error: Path is not a directory.\n" red-text)))) + +;; ;;; Helper function to handle conflicts +;; (define (handle-conflict target-source-dir source-dir) +;; "Handle conflicts when the target directory already exists." +;; (let ((choice (prompt-user-for-action))) +;; (cond +;; ((eq? choice 'overwrite) +;; (delete-directory target-source-dir) +;; (rename-file source-dir target-source-dir) +;; (display (color-message (format #f "Overwriting directory ~a.\n" target-source-dir) green-text)) +;; (log-action (format #f "Overwritten directory: ~a" target-source-dir))) +;; ((eq? choice 'skip) +;; (display (color-message "Skipping move operation.\n" green-text)) +;; (log-action (format #f "Skipped moving directory: ~a" target-source-dir))) +;; ((eq? choice 'cancel) +;; (display (color-message "Operation cancelled by user.\n" yellow-text)) +;; (log-action "Operation cancelled by user.") +;; (exit 0))))) + +;; ;;; Helper function to ensure target has .config appended, avoiding double slashes +;; (define (ensure-config-path target-dir) +;; "Ensure that the target directory has .config appended, avoiding double slashes." +;; (let ((target-dir (expand-home target-dir))) +;; (if (string-suffix? "/" target-dir) +;; (set! target-dir (string-drop-right target-dir 1))) ;; Remove trailing slash if it exists +;; (if (not (string-suffix? "/.config" target-dir)) +;; (string-append target-dir "/.config") +;; target-dir))) + +;; ;;; Helper function to move source to target +;; (define (move-source-to-target source-dir target-dir) +;; "Move the entire source directory to the target directory, ensuring .config in the target path." +;; (let* ((target-dir (ensure-config-path target-dir)) +;; (source-dir (expand-home source-dir)) +;; (source-name (basename source-dir)) +;; (target-source-dir (concat-path target-dir source-name))) +;; ;; Ensure that the .config directory exists in the target +;; (if (not (file-exists? target-dir)) +;; (mkdir target-dir #o755)) +;; ;; Check if the target directory already exists +;; (if (file-exists? target-source-dir) +;; (handle-conflict target-source-dir source-dir) +;; ;; If the target directory doesn't exist, proceed with the move +;; (begin +;; (rename-file source-dir target-source-dir) +;; (display (color-message (format #f "Moved ~a to ~a\n" source-dir target-source-dir) green-text)) +;; (log-action (format #f "Moved ~a to ~a" source-dir target-source-dir)))) +;; target-source-dir)) ;; Return the path of the moved source directory + +;; ;;; Helper function to create a symlink in the parent directory of the original source +;; (define (create-symlink-in-parent source-dir target-dir) +;; "Create a symlink in the parent directory of source-dir." +;; (let* ((parent-dir (expand-home (dirname source-dir))) ;; Ensure the parent path is expanded +;; (symlink-target (concat-path parent-dir (basename source-dir))) +;; (target-dir (expand-home target-dir))) ;; Ensure the target path is expanded +;; ;; Check if symlink already exists +;; (if (file-exists? symlink-target) +;; (let ((choice (prompt-user-for-action))) +;; (cond +;; ((eq? choice 'overwrite) +;; (delete-file symlink-target) +;; (symlink target-dir symlink-target) +;; (display (color-message (format #f "Overwriting symlink ~a pointing to ~a\n" symlink-target target-dir) green-text)) +;; (log-action (format #f "Overwritten symlink: ~a pointing to ~a" symlink-target target-dir))) +;; ((eq? choice 'skip) +;; (display (color-message "Skipping symlink creation.\n" green-text)) +;; (log-action (format #f "Skipped symlink creation: ~a" symlink-target))) +;; ((eq? choice 'cancel) +;; (display (color-message "Operation cancelled by user.\n" yellow-text)) +;; (log-action "Operation cancelled by user.") +;; (exit 0)))) +;; ;; Create the symlink if no conflict +;; (begin +;; (symlink target-dir symlink-target) +;; (display (color-message (format #f "Symlink created at ~a pointing to ~a\n" symlink-target target-dir) green-text)) +;; (log-action (format #f "Symlink created at ~a pointing to ~a" symlink-target target-dir)))))) + +;; ;;; Main function to handle source and target operations +;; (define (handle-source-and-target source-dir target-dir) +;; "Move the source directory to the target and create a symlink in the parent directory." +;; (let ((target-source-dir (move-source-to-target source-dir target-dir))) ;; Move the directory +;; (create-symlink-in-parent source-dir target-source-dir))) ;; Create the symlink + +;; ;;; Function to handle command-line arguments +;; (define (parse-arguments args) +;; "Parse command-line arguments." +;; (getopt-long args +;; '((target (value #t) (single-char #\t)) ;; Support both --target and -t +;; (source (value #t) (single-char #\s)) ;; Support both --source and -s +;; (help (value #f) (single-char #\h)) ;; Support -h for help +;; (version (value #f) (single-char #\v))))) ;; Support -v for version + +;; ;;; Main entry point +;; (define (main args) +;; "Main function to parse arguments and execute the program." +;; (setenv "GUILE_AUTO_COMPILE" "0") +;; ;; Check if --help or -h was passed +;; (if (or (member "--help" args) (member "-h" args)) +;; (display-help)) + +;; ;; Check if --version or -v was passed +;; (check-for-version args) + +;; ;; Parse remaining arguments +;; (let* ((options (parse-arguments args)) +;; (target-dir (assoc-ref options 'target)) +;; (source-dir (assoc-ref options 'source))) +;; (if (and target-dir source-dir) +;; (handle-source-and-target source-dir target-dir) +;; (begin +;; (display (color-message "Error: Missing required arguments.\n" red-text)) +;; (display (color-message "Usage: stash.scm --target= --source=\n" yellow-text)) +;; (exit 1))))) + +;; ;; Entry point for stash +;; (main (command-line)) + +;; stash.scm --- Main script for moving directories and creating symlinks with conflict resolution + (use-modules (ice-9 getopt-long) - (ice-9 popen) - (ice-9 rdelim) - (ice-9 format) - (stash-help) ;; Import the stash-help module for help functionality + (stash help) ;; Help module + (stash colors) ;; ANSI colors + (stash log) ;; Logging module + (stash paths) ;; Path handling module + (stash conflict) ;; Conflict resolution module + (stash file-ops) ;; File and symlink operations module (srfi srfi-1) - (srfi srfi-19)) ;; Use for list handling and date-time formatting - -;;; 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)) - -;;; Helper function to get a formatted current time string -(define (current-timestamp) - "Return the current date and time as a formatted string." - (let* ((time (current-time)) - (seconds (time-second time))) - (strftime "%Y-%m-%d-%H-%M-%S" (localtime seconds)))) - -;;; Improved logging function with timestamp -(define (log-action message) - "Log an action with a timestamp to the stash.log file." - (let ((log-port (open-file "stash.log" "a"))) ;; Open file in append mode - (display (string-append "[" (current-timestamp) "] " message) log-port) - (newline log-port) - (close-port log-port))) + (srfi srfi-19)) ;;; Version function (define (display-version) "Display the current version of the program." - (display (format #f "Stash version ~a\n" "0.1.0-alpha.1")) + (newline) + (display "Stash version 0.1.0-alpha.1\n") (exit 0)) ;;; Helper function to check for version flag and display version @@ -80,123 +258,11 @@ (member "-v" args)) (display-version))) -;;; Expand ~ in paths to the full home directory path -(define (expand-home path) - "Expand ~ to the user's home directory." - (if (string-prefix? "~" path) - (string-append (getenv "HOME") (substring path 1)) - path)) - -;;; Helper function to concatenate paths safely -(define (concat-path base path) - "Concatenate two paths, ensuring there are no double slashes." - (if (string-suffix? "/" base) - (string-append (string-drop-right base 1) "/" path) - (string-append base "/" path))) - -;;; Conflict resolution handler with user options -(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))))) - -;;; Helper function to delete a directory recursively -(define (delete-directory path) - "Delete a directory recursively." - (if (file-is-directory? path) - (begin - (system (string-append "rm -rf " (shell-quote-argument path))) - (log-action (format #f "Deleted directory: ~a" path))) - (display (color-message "Error: Path is not a directory.\n" red-text)))) - -;;; Helper function to handle conflicts -(define (handle-conflict target-source-dir source-dir) - "Handle conflicts when the target directory already exists." - (let ((choice (prompt-user-for-action))) - (cond - ((eq? choice 'overwrite) - (delete-directory target-source-dir) - (rename-file source-dir target-source-dir) - (display (color-message (format #f "Overwriting directory ~a.\n" target-source-dir) green-text)) - (log-action (format #f "Overwritten directory: ~a" target-source-dir))) - ((eq? choice 'skip) - (display (color-message "Skipping move operation.\n" green-text)) - (log-action (format #f "Skipped moving directory: ~a" target-source-dir))) - ((eq? choice 'cancel) - (display (color-message "Operation cancelled by user.\n" yellow-text)) - (log-action "Operation cancelled by user.") - (exit 0))))) - -;;; Helper function to ensure target has .config appended, avoiding double slashes -(define (ensure-config-path target-dir) - "Ensure that the target directory has .config appended, avoiding double slashes." - (let ((target-dir (expand-home target-dir))) - (if (string-suffix? "/" target-dir) - (set! target-dir (string-drop-right target-dir 1))) ;; Remove trailing slash if it exists - (if (not (string-suffix? "/.config" target-dir)) - (string-append target-dir "/.config") - target-dir))) - -;;; Helper function to move source to target -(define (move-source-to-target source-dir target-dir) - "Move the entire source directory to the target directory, ensuring .config in the target path." - (let* ((target-dir (ensure-config-path target-dir)) - (source-dir (expand-home source-dir)) - (source-name (basename source-dir)) - (target-source-dir (concat-path target-dir source-name))) - ;; Ensure that the .config directory exists in the target - (if (not (file-exists? target-dir)) - (mkdir target-dir #o755)) - ;; Check if the target directory already exists - (if (file-exists? target-source-dir) - (handle-conflict target-source-dir source-dir) - ;; If the target directory doesn't exist, proceed with the move - (begin - (rename-file source-dir target-source-dir) - (display (color-message (format #f "Moved ~a to ~a\n" source-dir target-source-dir) green-text)) - (log-action (format #f "Moved ~a to ~a" source-dir target-source-dir)))) - target-source-dir)) ;; Return the path of the moved source directory - -;;; Helper function to create a symlink in the parent directory of the original source -(define (create-symlink-in-parent source-dir target-dir) - "Create a symlink in the parent directory of source-dir." - (let* ((parent-dir (expand-home (dirname source-dir))) ;; Ensure the parent path is expanded - (symlink-target (concat-path parent-dir (basename source-dir))) - (target-dir (expand-home target-dir))) ;; Ensure the target path is expanded - ;; Check if symlink already exists - (if (file-exists? symlink-target) - (let ((choice (prompt-user-for-action))) - (cond - ((eq? choice 'overwrite) - (delete-file symlink-target) - (symlink target-dir symlink-target) - (display (color-message (format #f "Overwriting symlink ~a pointing to ~a\n" symlink-target target-dir) green-text)) - (log-action (format #f "Overwritten symlink: ~a pointing to ~a" symlink-target target-dir))) - ((eq? choice 'skip) - (display (color-message "Skipping symlink creation.\n" green-text)) - (log-action (format #f "Skipped symlink creation: ~a" symlink-target))) - ((eq? choice 'cancel) - (display (color-message "Operation cancelled by user.\n" yellow-text)) - (log-action "Operation cancelled by user.") - (exit 0)))) - ;; Create the symlink if no conflict - (begin - (symlink target-dir symlink-target) - (display (color-message (format #f "Symlink created at ~a pointing to ~a\n" symlink-target target-dir) green-text)) - (log-action (format #f "Symlink created at ~a pointing to ~a" symlink-target target-dir)))))) - ;;; Main function to handle source and target operations (define (handle-source-and-target source-dir target-dir) "Move the source directory to the target and create a symlink in the parent directory." - (let ((target-source-dir (move-source-to-target source-dir target-dir))) ;; Move the directory - (create-symlink-in-parent source-dir target-source-dir))) ;; Create the symlink + (let ((target-source-dir (move-source-to-target source-dir target-dir))) ;; Only pass source-dir and target-dir + (create-symlink-in-parent source-dir target-source-dir))) ;; Create the symlink if no conflict ;;; Function to handle command-line arguments (define (parse-arguments args) @@ -210,7 +276,8 @@ ;;; Main entry point (define (main args) "Main function to parse arguments and execute the program." - (setenv "GUILE_AUTO_COMPILE" "0") + (setenv "GUILE_AUTO_COMPILE" "0") ;; Disable auto-compilation for performance + ;; Check if --help or -h was passed (if (or (member "--help" args) (member "-h" args)) (display-help)) @@ -218,16 +285,27 @@ ;; Check if --version or -v was passed (check-for-version args) - ;; Parse remaining arguments - (let* ((options (parse-arguments args)) - (target-dir (assoc-ref options 'target)) - (source-dir (assoc-ref options 'source))) - (if (and target-dir source-dir) - (handle-source-and-target source-dir target-dir) - (begin - (display (color-message "Error: Missing required arguments.\n" red-text)) - (display (color-message "Usage: stash.scm --target= --source=\n" yellow-text)) - (exit 1))))) +;;; Parse remaining arguments +(let* ((options (parse-arguments args)) ;; Parse the command-line options + (target-dir (assoc-ref options 'target)) ;; Extract --target or -t argument + (source-dir (assoc-ref options 'source))) ;; Extract --source or -s argument + (if (and target-dir source-dir) ;; Ensure both arguments are provided + (handle-source-and-target source-dir target-dir) ;; Proceed with moving the directory and creating the symlink + (begin + (display (color-message "Error: Missing required arguments.\n" red-text)) ;; Show error in red text + (display (color-message "Usage: stash.scm --target --source \n" yellow-text)) ;; Show updated usage message + (exit 1))))) ;; Exit with error status + + ;; ;; Parse remaining arguments + ;; (let* ((options (parse-arguments args)) + ;; (target-dir (assoc-ref options 'target)) + ;; (source-dir (assoc-ref options 'source))) + ;; (if (and target-dir source-dir) + ;; (handle-source-and-target source-dir target-dir) ;; Handle the source move and symlink creation + ;; (begin + ;; (display "Error: Missing required arguments.\n") + ;; (display "Usage: stash.scm --target= --source=\n") + ;; (exit 1))))) ;; Entry point for stash (main (command-line))