glenn
/
stash
mirror of https://codeberg.org/glenneth/stash.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

mproved logging with date and timestamp

This commit is contained in:
GLENN THOMPSON 2024-09-22 11:13:51 +03:00
parent ca71cf5fd3
commit 9d86d0d7d5
5 changed files with 212 additions and 554 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
guile-stash.log
View File

@ -1 +0,0 @@
Symlink created: /home/glenn/stash/test -> /home/glenn/.config/alacritty/test

236
guile-stash.scm
View File

@ -1,236 +0,0 @@
;;; guile-stash.scm --- A Guile script for creating and managing symlinks with conflict resolution
;;;
;;; Author: Glenn Thompson <glenn@kirstol.org>
;;; Version: 1.1
;;; Created: 2024-12-03
;;; Compatibility: Guile 3.0.9
;;; Keywords: symlink, file management, conflict resolution
;;;
;;; Commentary:
;;;
;;; Guile-Stash is a command-line utility written in Guile Scheme designed to facilitate the creation of symbolic links (symlinks)
;;; for files and directories. It allows users to specify a source file or directory and a target directory where the symlink(s)
;;; should be created. The utility handles potential conflicts with existing files or directories at the target location,
;;; offering users the choice to overwrite or skip the creation of new symlinks.
;;;
;;; Main Features:
;;; - Command-line argument parsing for specifying source and target paths.
;;; - Conflict detection with interactive user resolution options (overwrite or skip).
;;; - Support for symlinking both files and directories.
;;; - Simple and interactive user interface for easy use.
;;;
;;; Usage:
;;;
;;; guile -L . guile-stash.scm --target=<target-dir> --package-dir=<package-dir>
;;;
;;; Replace <target-dir> with the directory where you want the symlink(s) to be created,
;;; and <package-dir> with the path to the source file or directory.
;;;
;;; License:
;;;
;;; ;;; guile-stash.scm --- Description of the script
;;;
;;; Copyright (c) 2024 Glenn Thompson
;;;
;;; Permission is hereby granted, free of charge, to any person obtaining a copy
;;; of this software and associated documentation files (the "Software"), to deal
;;; in the Software without restriction, including without limitation the rights
;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
;;; copies of the Software, and to permit persons to whom the Software is
;;; furnished to do so, subject to the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be included in all
;;; copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
;;; SOFTWARE.
;;;
;;; For the full license text, see the LICENSE file.
;;; Code:
;; TODO: Refactor Repeated Logic: The logic for checking if a path is a file or directory and appending the basename is repeated in the create-symlink function. This could be encapsulatedin a helper function to improve readability and avoid redundancy. e.g.
;; (define (build-target-path source target)
;; (string-append target "/" (basename source)))
;; TODO: Modularize Conflict Handling: Separating conflict handling into its own module to keep the main functionality more focused. This will also help to extend the conflict resolution mechanism with more options (e.g., backup, replace).
;; TODO: Add Logging Capabilities: It might be useful to log actions like creating symlinks, skipping conflicts, or canceling operations to a file for auditing purposes. Adding a logging function that appends these actions to a log file. e.g.
;; (define (log-action message)
;; (with-output-to-file "guile-stash.log"
;; (lambda () (display message) (newline))
;; #:append #t))
;; TODO: Improve Error Handling: While catch is used, it's broad and might not capture the exact error. Using more specific error types (like system-error and file-error) could improve the granularity of error reporting. Additionally, return appropriate exit codes for different failure conditions to support integration with other scripts.
;; TODO: Optimize the delete-directory Function: Using rm -r is risky for recursive deletion in case of directory traversal attacks. You could implement a Scheme-native recursive delete function to avoid this.
;; #TODO Addition of a Non-Interactive Mode: Adding a non-interactive mode that automatically skips or overwrites conflicts (based on a command-line flag) could make the script more flexible for use in automation workflows. e.g.
;; (define (parse-arguments args)
;; (let* ((opts (getopt-long args
;; '((target (value #t) (required? #t))
;; (package-dir (value #t) (required? #t))
;; (non-interactive (value #f) (default #f))))))
;; opts))
;; TODO: Refactor Command-Line Parsing: The current command-line argument parsing could be expanded to handle other optional flags more easily. e.g., adding help or verbose flags to improve user interaction.
;; TODO: Check for Broken Symlinks: Before deciding to overwrite a symlink, check if the existing symlink is broken, and handle it appropriately. e.g.
;; (define (symlink-broken? path)
;; (and (file-is-symlink? path) (not (file-exists? path))))
;; These changes will make the script more maintainable, secure, and flexible for future development.
;; 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 (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 (log-action message)
(let ((log-port (open-file "guile-stash.log" "a"))) ;; Open file in append mode
(display message log-port)
(newline log-port)
(close-port log-port))) ;; Close the port after writing
;; (define (log-action message)
;; (with-output-to-file "guile-stash.log"
;; (lambda () (display message) (newline))
;; #:append #t))
;; Helper function to build target symlink path
(define (build-target-path source target)
"Builds the symlink path for the source file or directory under the target directory."
(string-append target "/" (basename source)))
;; Refactored create-symlink function
(define (create-symlink source target)
"Create a symlink for the source file or directory at the target location."
(let ((target-symlink-path (build-target-path source target))) ;; Use the helper function
(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)
(log-action (format #f "Symlink created: ~a -> ~a" target-symlink-path source)) ;; Log symlink creation
(display (color-message (format #f "Symlink created: ~a -> ~a\n" target-symlink-path source) green-text)))
(lambda args
(log-action "Error creating symlink")
(display (color-message "Error creating symlink.\n" red-text)))))))
;; (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 (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))

8
stash.log Normal file
View File

@ -0,0 +1,8 @@
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

204
stash.scm Normal file
View File

@ -0,0 +1,204 @@
;;; stash.scm --- A Guile script for moving directories and creating symlinks with conflict resolution
;;;
;;; Author: Glenn Thompson <glenn@kirstol.org>
;;; Version: 1.1
;;; Created: 2024-12-03
;;; Compatibility: Guile 3.0.9
;;; Keywords: symlink, file management, conflict resolution
;;;
;;; Commentary:
;;;
;;; Stash is a command-line utility written in Guile Scheme designed to facilitate the movement of directories and
;;; creation of symbolic links (symlinks) for files and directories. It allows users to specify a source directory
;;; and a target directory where the symlink should be created. The utility handles potential conflicts with existing
;;; files or directories at the target location, offering users the choice to overwrite or skip the creation of new symlinks.
;;;
;;; Main Features:
;;; - Command-line argument parsing for specifying source and target paths.
;;; - Conflict detection with interactive user resolution options (overwrite or skip).
;;; - Moving directories and creating symlinks.
;;; - Simple and interactive user interface for easy use.
;;;
;;; Usage:
;;;
;;; guile -L . stash.scm --target=<target-dir> --source=<source-dir>
;;;
;;; Replace <target-dir> with the directory where you want the symlink to be created,
;;; and <source-dir> with the path to the source directory.
;;;
;;; License:
;;;
;;; This software is licensed under the MIT License.
;;;
;;; Code:
;; TODO: Refactor Repeated Logic: The logic for checking if a path is a file or directory and appending the basename is repeated in the create-symlink function. This could be encapsulatedin a helper function to improve readability and avoid redundancy. e.g.
;; (define (build-target-path source target)
;; (string-append target "/" (basename source)))
;; TODO: Modularize Conflict Handling: Separating conflict handling into its own module to keep the main functionality more focused. This will also help to extend the conflict resolution mechanism with more options (e.g., backup, replace).
;; TODO: Add Logging Capabilities: It might be useful to log actions like creating symlinks, skipping conflicts, or canceling operations to a file for auditing purposes. Adding a logging function that appends these actions to a log file. e.g.
;; (define (log-action message)
;; (with-output-to-file "guile-stash.log"
;; (lambda () (display message) (newline))
;; #:append #t))
;; TODO: Improve Error Handling: While catch is used, it's broad and might not capture the exact error. Using more specific error types (like system-error and file-error) could improve the granularity of error reporting. Additionally, return appropriate exit codes for different failure conditions to support integration with other scripts.
;; TODO: Optimize the delete-directory Function: Using rm -r is risky for recursive deletion in case of directory traversal attacks. You could implement a Scheme-native recursive delete function to avoid this.
;; #TODO Addition of a Non-Interactive Mode: Adding a non-interactive mode that automatically skips or overwrites conflicts (based on a command-line flag) could make the script more flexible for use in automation workflows. e.g.
;; Import necessary modules
(use-modules (ice-9 getopt-long)
(ice-9 popen)
(ice-9 rdelim)
(ice-9 format)
(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))) ;; Extract the seconds from the time object
(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))) ;; Close the port after writing
;;; 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))
;;; Function to handle command-line arguments
(define (parse-arguments args)
"Parse command-line arguments."
(let* ((opts (getopt-long args
'((target (value #t) (required? #t))
(source (value #t) (required? #t))))))
opts))
;;; 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."
(let* ((source-dir (expand-home source-dir))
(target-dir (expand-home target-dir))
(source-name (basename source-dir))
(target-source-dir (string-append target-dir "/" source-name)))
;; Move the source directory into the target directory
(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 (string-append 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)
(handle-conflicts source-dir symlink-target) ;; Handle conflict if symlink or file exists
(begin
;; Create the symlink if no conflict
(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))))))
;;; Conflict resolution handler
(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)))))
;;; Function to check if a file is a symlink
(define (file-is-symlink? path)
"Check if a given file path is a symlink."
(let ((stat (lstat path)))
(eqv? (stat:type stat) 'symlink)))
;;; Helper function to build the target symlink path
(define (build-target-path source target)
"Builds the symlink path for the source file or directory under the target directory."
(string-append target "/" (basename source)))
;;; Function to handle conflicts
(define (handle-conflicts source target)
"Handle conflicts when a symlink or file already exists at the target location."
(display (color-message (format #f "Conflict detected! A file or symlink already exists at ~a.\n" target) yellow-text))
(let ((choice (prompt-user-for-action))) ;; Prompt the user for action
(cond
((eq? choice 'overwrite)
(if (file-is-symlink? target)
(begin
(delete-file target)
(display (color-message "Removed the existing symbolic link.\n" green-text))
(log-action (format #f "Removed the existing symbolic link at ~a" target))
;; Recreate the symlink after removing the old one
(create-symlink-in-parent source target))
(display (color-message "Error: Target is not a symbolic link.\n" red-text))))
((eq? choice 'skip)
;; Do nothing, log skipping the conflict
(log-action (format #f "Skipped creating symlink at ~a" target))
(display (color-message "Keeping existing symbolic link.\n" green-text)))
((eq? choice 'cancel)
;; Cancel the operation
(log-action "Operation cancelled by user.")
(display (color-message "Operation cancelled.\n" yellow-text))
(exit 0))
(else
;; Invalid input
(display (color-message "Invalid choice. Please try again.\n" red-text))
(handle-conflicts source target)))))
;;; 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 if no conflict
;;; Main entry point
(define (main args)
"Main function to parse arguments and execute the program."
(setenv "GUILE_AUTO_COMPILE" "0") ;; Disable auto-compilation to improve performance
(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 (color-message "Error: Missing required arguments.\n" red-text))
(display (color-message "Usage: stash.scm --target=<target-dir> --source=<source-dir>\n" yellow-text))
(exit 1)))))
;; Entry point for stash
(main (command-line))

317
stash2.scm
View File

@ -1,317 +0,0 @@
;;; 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))