mirror of https://codeberg.org/glenneth/stash.git
197 lines
7.6 KiB
Scheme
197 lines
7.6 KiB
Scheme
;;; stash.scm --- A Guile script for moving directories and creating symlinks with conflict resolution
|
|
;;;
|
|
;;; Author: Glenn Thompson <glenn@kirstol.org>
|
|
;;; Version: 0.1.0-alpha.1
|
|
;;; Created: 2024-12-03
|
|
;;; Compatibility: Guile 3.0.9
|
|
;;; Keywords: symlink, file management, conflict resolution, backup
|
|
;;;
|
|
;;; 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, back up, 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, backup, skip, or cancel).
|
|
;;; - 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 project is licensed under the GNU General Public License v3.
|
|
;;;
|
|
|
|
;;; CODE
|
|
|
|
(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))
|
|
|
|
;;; Color constants
|
|
(define blue-text "\x1b[0;34m")
|
|
(define yellow-text "\x1b[0;33m")
|
|
(define red-text "\x1b[0;31m")
|
|
|
|
;;; 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))
|
|
(help (value #f) (single-char #\h))
|
|
(version (value #f) (single-char #\v))))
|
|
|
|
;;; Function to handle dot directory stashing
|
|
(define (handle-dot-stash)
|
|
"Handle stashing when using the '.' syntax. Uses parent directory as target."
|
|
(let* ((current-dir (canonicalize-path (getcwd)))
|
|
(pkg-dir (if (file-is-symlink? current-dir)
|
|
(canonicalize-path (readlink current-dir))
|
|
current-dir))
|
|
(pkg-name (basename pkg-dir))
|
|
(stow-dir (dirname pkg-dir))
|
|
(target-dir (dirname stow-dir))
|
|
(ignore-patterns (read-ignore-patterns pkg-dir)))
|
|
(format #t "Package directory: ~a~%" pkg-dir)
|
|
(format #t "Stow directory: ~a~%" stow-dir)
|
|
(format #t "Target directory: ~a~%" target-dir)
|
|
(if (file-is-symlink? current-dir)
|
|
(format #t "Directory is already stashed at: ~a~%" pkg-dir)
|
|
(let ((package (make-package pkg-name pkg-dir target-dir ignore-patterns)))
|
|
(process-package package)))))
|
|
|
|
;;; Version function
|
|
(define (display-version)
|
|
"Display the current version of the program."
|
|
(newline)
|
|
(display "Stash version 0.1.0-alpha.1\n")
|
|
(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)))
|
|
|
|
;;; Main function to handle stowing operations
|
|
(define (handle-stow package options)
|
|
(let* ((tree (analyze-tree package))
|
|
(simulate? (assoc-ref options 'simulate))
|
|
(no-folding? (assoc-ref options 'no-folding)))
|
|
(plan-operations tree package)))
|
|
|
|
;;; Prompt user for target directory path
|
|
(define (prompt-for-target source-path)
|
|
"Prompt user for target directory path."
|
|
(display (color-message (string-append "\nSource directory: " source-path "\n") blue-text))
|
|
(display (color-message "Enter target directory path (where files will be stashed): " yellow-text))
|
|
(let ((input (read-line)))
|
|
(if (string-null? input)
|
|
(begin
|
|
(display (color-message "Target directory cannot be empty. Please try again.\n" red-text))
|
|
(prompt-for-target source-path))
|
|
(canonicalize-path (expand-home input)))))
|
|
|
|
;;; Main entry point
|
|
(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))
|
|
(recursive? (option-ref options 'recursive #f))
|
|
(interactive? (option-ref options 'interactive #f))
|
|
(source (option-ref options 'source #f))
|
|
(target (option-ref options 'target #f)))
|
|
|
|
(cond
|
|
(help-wanted? (display-help) (exit 0))
|
|
(version-wanted? (display-version) (exit 0))
|
|
|
|
;; Handle dot syntax
|
|
((and (= (length (option-ref options '() '())) 1)
|
|
(string=? (car (option-ref options '() '())) "."))
|
|
(handle-dot-stash))
|
|
|
|
;; Handle interactive mode
|
|
((and source interactive?)
|
|
(let ((target-path (prompt-for-target (canonicalize-path source))))
|
|
(handle-explicit-stash source target-path recursive?)))
|
|
|
|
;; Handle explicit paths with optional recursion
|
|
((and source target)
|
|
(handle-explicit-stash source target recursive?))
|
|
|
|
(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-path (canonicalize-path target))
|
|
(package-name (basename source-path))
|
|
(ignore-patterns (read-ignore-patterns source-path)))
|
|
(if recursive?
|
|
(handle-recursive-stash source-path target-path)
|
|
(let ((package (make-package package-name source-path target-path ignore-patterns)))
|
|
(process-package package)))))
|
|
|
|
(define (handle-recursive-stash source target)
|
|
"Recursively process directories under source."
|
|
(let* ((source-path (canonicalize-path source))
|
|
(target-path (canonicalize-path target))
|
|
(source-name (basename source-path))
|
|
(target-config-path (string-append target-path "/" source-name))
|
|
(entries (if (file-is-directory? source-path)
|
|
(scandir source-path)
|
|
(list (basename source-path))))
|
|
(valid-entries (filter (lambda (entry)
|
|
(and (not (member entry '("." "..")))
|
|
(file-is-directory? (string-append source-path "/" entry))))
|
|
entries)))
|
|
;; First ensure the config directory exists in target
|
|
(if (not (file-exists? target-config-path))
|
|
(mkdir-p target-config-path))
|
|
;; Then process each subdirectory
|
|
(for-each
|
|
(lambda (entry)
|
|
(let* ((source-dir (string-append source-path "/" entry))
|
|
(package-name entry)
|
|
(ignore-patterns (read-ignore-patterns source-dir)))
|
|
(let ((package (make-package package-name source-dir target-config-path ignore-patterns)))
|
|
(process-package package))))
|
|
valid-entries)))
|
|
|
|
(define (process-package package)
|
|
"Process a single package for stashing."
|
|
(let* ((tree (analyze-tree package))
|
|
(operations (plan-operations tree package)))
|
|
(execute-operations operations)))
|
|
|
|
;; Entry point for stash
|
|
(main (command-line))
|