(define-module (stash) #:use-module (ice-9 getopt-long) #:use-module (ice-9 ftw) #:use-module (ice-9 rdelim) #:use-module (stash help) #:use-module (stash colors) #:use-module (stash log) #:use-module (stash paths) #:use-module (stash conflict) #:use-module (stash file-ops) #:use-module (stash package) #:use-module (stash tree) #:use-module (srfi srfi-1) #:use-module (srfi srfi-19) #:export (main)) ;;; Command-line options (define %options '((target (value #t) (single-char #\t)) (source (value #t) (single-char #\s)) (recursive (value #f) (single-char #\r)) (interactive (value #f) (single-char #\i)) (deploy (value #f) (single-char #\d)) (restore (value #f) (single-char #\R)) (help (value #f) (single-char #\h)) (version (value #f) (single-char #\v)))) (define (main args) "Main function to parse arguments and execute the program." (setenv "GUILE_AUTO_COMPILE" "0") (let* ((options (getopt-long args %options)) (help-wanted? (option-ref options 'help #f)) (version-wanted? (option-ref options 'version #f)) (source (option-ref options 'source #f)) (target (option-ref options 'target #f)) (recursive? (option-ref options 'recursive #f)) (interactive? (option-ref options 'interactive #f)) (deploy? (option-ref options 'deploy #f)) (restore? (option-ref options 'restore #f)) (remaining-args (option-ref options '() '()))) (cond (help-wanted? (display-help) (exit 0)) (version-wanted? (display-version) (exit 0)) (deploy? (handle-deploy-mode remaining-args) #t) (restore? (handle-restore-mode source) #t) ((and source target) (handle-explicit-stash source target recursive?) #t) ((and source interactive?) (handle-interactive-stash source recursive?) #t) ;; Handle dot syntax: stash . ((and (= (length remaining-args) 1) (string=? (car remaining-args) ".")) (handle-dot-syntax) #t) ;; Handle package deployment: stash package-name ((and (= (length remaining-args) 1) (not (string=? (car remaining-args) "."))) (handle-package-deploy (car remaining-args)) #t) (else (display-help) (exit 1))))) (define (handle-explicit-stash source target recursive?) "Handle stashing with explicit source and target paths." (let* ((source-path (canonicalize-path source)) (target-base (canonicalize-path target)) (target-path (create-smart-target-path source source-path target-base))) (cond ;; Handle individual files ((file-is-regular? source-path) (handle-file-stash source-path target-path)) ;; Handle directories ((file-is-directory? source-path) (if (directory-has-symlinks? (dirname source-path)) ;; Parent directory has symlinks, use file-level stashing (handle-directory-file-level source-path target-path recursive?) ;; No symlinks in parent, use directory-level stashing (handle-directory-level source-path target-path recursive?))) (else (display (format #f "Error: ~a is not a regular file or directory\n" source-path)) (exit 1))))) (define (create-smart-target-path original-source source-path target-base) "Create intelligent target path that preserves directory structure." (let* ((home-dir (getenv "HOME")) ;; Use the original source string if it's relative, otherwise extract from absolute path (source-relative (cond ;; If original source is relative (doesn't start with /), use it directly ((not (string-prefix? "/" original-source)) original-source) ;; If source is under home directory, make it relative to home ((string-prefix? home-dir source-path) (string-drop source-path (+ (string-length home-dir) 1))) ;; Otherwise just use basename (else (basename source-path)))) ;; Remove leading dot from hidden files/dirs for cleaner organization (clean-relative (if (string-prefix? "." source-relative) (string-drop source-relative 1) source-relative))) ;; Create clean target path (string-append target-base "/" clean-relative))) (define (create-path-metadata source-path target-path) "Create metadata file to track original path structure for restoration." (let* ((metadata-file (string-append target-path ".stash-meta")) (home-dir (getenv "HOME")) (original-relative (if (string-prefix? home-dir source-path) (string-drop source-path (+ (string-length home-dir) 1)) source-path)) (timestamp (strftime "%Y-%m-%d %H:%M:%S" (localtime (time-second (current-time)))))) (call-with-output-file metadata-file (lambda (port) (write `((original-path . ,original-relative) (timestamp . ,timestamp) (stash-version . "0.2.0")) port))))) ;; Helper functions for intelligent stashing (define (file-is-regular? path) "Check if a path is a regular file." (and (file-exists? path) (not (file-is-directory? path)) (not (file-is-symlink? path)))) (define (directory-has-symlinks? dir-path) "Check if a directory contains any symlinks." (if (file-exists? dir-path) (let ((entries (scandir dir-path))) (any (lambda (entry) (and (not (member entry '("." ".."))) (file-is-symlink? (string-append dir-path "/" entry)))) entries)) #f)) (define (handle-file-stash source-path target-path) "Handle stashing of individual files." (display (format #f "Stashing file: ~a -> ~a\n" source-path target-path)) ;; Create target directory if it doesn't exist (let ((target-dir (dirname target-path))) (when (not (file-exists? target-dir)) (mkdir-p target-dir))) ;; Create metadata for restoration (create-path-metadata source-path target-path) ;; Move file to target (rename-file source-path target-path) ;; Create symlink back to original location (symlink target-path source-path) (display (format #f "Created symlink: ~a -> ~a\n" source-path target-path))) (define (handle-directory-level source-path target-path recursive?) "Handle directory-level stashing (traditional stash behavior)." (display (format #f "Directory-level stashing: ~a -> ~a\n" source-path target-path)) ;; Create target directory if it doesn't exist (let ((target-dir (dirname target-path))) (when (not (file-exists? target-dir)) (mkdir-p target-dir))) ;; Create metadata for restoration (create-path-metadata source-path target-path) ;; Move directory to target (rename-file source-path target-path) ;; Create symlink back to original location (symlink target-path source-path) (display (format #f "Created directory symlink: ~a -> ~a\n" source-path target-path))) (define (handle-directory-file-level source-path target-path recursive?) "Handle file-level stashing within a directory that has symlinks." (display (format #f "File-level stashing in directory: ~a\n" source-path)) (let ((entries (scandir source-path))) (for-each (lambda (entry) (when (not (member entry '("." ".."))) (let* ((entry-source (string-append source-path "/" entry)) (entry-target (string-append target-path "/" entry))) (cond ;; Skip existing symlinks ((file-is-symlink? entry-source) (display (format #f "Skipping existing symlink: ~a\n" entry-source))) ;; Stash regular files ((file-is-regular? entry-source) (handle-file-stash entry-source entry-target)) ;; Recursively handle subdirectories if recursive mode ((and recursive? (file-is-directory? entry-source)) (handle-directory-file-level entry-source entry-target recursive?)))))) entries))) (define (handle-recursive-stash source-path target-path) "Handle recursive stashing of directories." (let* ((base-name (basename source-path)) (ignore-patterns (read-ignore-patterns source-path)) (package (make-package base-name source-path target-path ignore-patterns))) (process-package package) #t)) (define (process-package package) "Process a single package for stashing." (let* ((tree (analyze-tree package)) (operations (plan-operations tree package))) (execute-operations operations) #t)) ;;; Enhanced handler functions for GNU Stow-like functionality (define (handle-interactive-stash source recursive?) "Handle interactive stashing where user selects target directory." (display "Interactive target selection:\n") (display (format #f "Source: ~a\n" source)) (display "Enter target directory: ") (let ((target (read-line))) (if (string-null? target) (begin (display "No target specified. Exiting.\n") (exit 1)) (handle-explicit-stash source target recursive?)))) (define (handle-dot-syntax) "Handle dot syntax: create symlink from current directory to home." (let* ((current-dir (getcwd)) (home-dir (getenv "HOME")) (relative-path (string-drop current-dir (+ (string-length home-dir) 1))) (target-path (string-append home-dir "/" relative-path))) (display (format #f "Creating symlink: ~a -> ~a\n" target-path current-dir)) (when (file-exists? target-path) (if (file-is-symlink? target-path) (delete-file target-path) (begin (display (format #f "Error: ~a already exists and is not a symlink\n" target-path)) (exit 1)))) (let ((target-dir (dirname target-path))) (when (not (file-exists? target-dir)) (mkdir-p target-dir))) (symlink current-dir target-path) (display (format #f "Created symlink: ~a -> ~a\n" target-path current-dir)))) (define (handle-package-deploy package-name) "Deploy a specific package from current directory." (let* ((package-dir (string-append (getcwd) "/" package-name)) (home-dir (getenv "HOME"))) (if (file-exists? package-dir) (deploy-package package-dir home-dir) (begin (display (format #f "Error: Package directory ~a not found\n" package-dir)) (exit 1))))) (define (handle-deploy-mode args) "Handle deploy mode: deploy all packages or specific package." (let ((current-dir (getcwd)) (home-dir (getenv "HOME"))) (if (null? args) ;; Deploy all packages in current directory (deploy-all-packages current-dir home-dir) ;; Deploy specific package (handle-package-deploy (car args))))) (define (deploy-all-packages dotfiles-dir home-dir) "Deploy all packages from dotfiles directory." (display (format #f "Deploying all packages from ~a to ~a\n" dotfiles-dir home-dir)) (let ((entries (scandir dotfiles-dir))) (for-each (lambda (entry) (let ((entry-path (string-append dotfiles-dir "/" entry))) (when (and (not (member entry '("." ".." ".git" "README.md" "collect-dotfiles.sh" "STASH_GUIDE.md"))) (file-is-directory? entry-path)) (display (format #f "Deploying package: ~a\n" entry)) (deploy-package entry-path home-dir)))) entries))) (define (deploy-package package-dir home-dir) "Deploy a single package by creating symlinks." (let ((package-name (basename package-dir))) (display (format #f "Deploying package: ~a\n" package-name)) (deploy-directory-contents package-dir home-dir))) (define (deploy-directory-contents source-dir target-base) "Recursively deploy directory contents by creating symlinks." (let ((entries (scandir source-dir))) (for-each (lambda (entry) (when (not (member entry '("." ".."))) (let* ((source-path (string-append source-dir "/" entry)) (target-path (string-append target-base "/." entry))) (cond ((file-is-directory? source-path) ;; For directories, create the directory and recurse (when (not (file-exists? target-path)) (mkdir target-path #o755)) (deploy-directory-contents source-path (dirname target-path))) (else ;; For files, create symlink (when (file-exists? target-path) (if (file-is-symlink? target-path) (delete-file target-path) (display (format #f "Warning: ~a exists and is not a symlink, skipping\n" target-path)))) (let ((target-dir (dirname target-path))) (when (not (file-exists? target-dir)) (mkdir-p target-dir))) (symlink source-path target-path) (display (format #f "Created symlink: ~a -> ~a\n" target-path source-path))))))) entries))) ;;; Restoration functionality (define (handle-restore-mode source-path) "Handle restoration of stashed files back to original locations." (if source-path (restore-stashed-item source-path) (begin (display "Error: --restore requires --source to specify what to restore\n") (exit 1)))) (define (restore-stashed-item stashed-path) "Restore a stashed file or directory back to its original location." (let* ((metadata-file (string-append stashed-path ".stash-meta")) (home-dir (getenv "HOME"))) (if (file-exists? metadata-file) (let* ((metadata (call-with-input-file metadata-file read)) (original-relative (assoc-ref metadata 'original-path)) (original-path (string-append home-dir "/" original-relative))) (display (format #f "Restoring: ~a -> ~a\n" stashed-path original-path)) ;; Remove existing symlink if it exists (when (and (file-exists? original-path) (file-is-symlink? original-path)) (delete-file original-path)) ;; Create parent directory if needed (let ((parent-dir (dirname original-path))) (when (not (file-exists? parent-dir)) (mkdir-p parent-dir))) ;; Move file/directory back (rename-file stashed-path original-path) ;; Remove metadata file (delete-file metadata-file) (display (format #f "Restored: ~a\n" original-path))) (begin (display (format #f "Error: No metadata found for ~a\n" stashed-path)) (display "Cannot restore without metadata file\n") (exit 1))))) ;; Entry point for stash (let ((result (main (command-line)))) (if result (exit 0) (exit 1)))