stash/stash.scm

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