stash/stash.scm

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

;;; CODE

;; 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))