mirror of https://codeberg.org/glenneth/stash.git
feat: implement robust path handling and symlink creation
Major changes: - Add package management module for handling source/target paths - Implement tree operations for symlink creation - Add support for both dot syntax and explicit paths - Enhance path handling with home directory expansion - Add comprehensive documentation in README and DEVLOG - Fix symlink creation for all use cases - Add test suite for path handling and symlink creation
This commit is contained in:
glenneth1
parent
dc6b7f15b7
commit
269afd966d
|
|
@ -0,0 +1,118 @@
|
|||
# Stash Development Log
|
||||
|
||||
This document tracks the development progress and major changes in the Stash project.
|
||||
|
||||
## Project Overview
|
||||
|
||||
Stash is a symlink management utility written in Guile Scheme, designed to help users manage their dotfiles and configuration files. It provides functionality similar to GNU Stow but with enhanced features for path handling and conflict resolution.
|
||||
|
||||
## Architecture
|
||||
|
||||
The project is organized into several modules:
|
||||
|
||||
- `stash.scm`: Main entry point and command-line interface
|
||||
- `modules/stash/paths.scm`: Path manipulation utilities
|
||||
- `modules/stash/tree.scm`: Tree operations for symlink creation
|
||||
- `modules/stash/package.scm`: Package management functionality
|
||||
- `modules/stash/file-ops.scm`: File system operations
|
||||
- `modules/stash/log.scm`: Logging utilities
|
||||
- `modules/stash/conflict.scm`: Conflict resolution
|
||||
- `modules/stash/colors.scm`: ANSI color support for terminal output
|
||||
- `modules/stash/help.scm`: Help and usage information
|
||||
|
||||
## Recent Changes
|
||||
|
||||
### Path Handling Improvements
|
||||
|
||||
- Enhanced `canonicalize-path` function to handle:
|
||||
- Dot (.) and dot-dot (..) notation
|
||||
- Home directory expansion (~)
|
||||
- Absolute and relative paths
|
||||
- Improved path resolution for both dot syntax and explicit paths
|
||||
|
||||
### Symlink Creation
|
||||
|
||||
- Rewrote `plan-operations` function to handle:
|
||||
- Dot syntax (stash .)
|
||||
- Explicit source/target paths
|
||||
- Fixed symlink creation to maintain correct directory structure
|
||||
- Added support for creating parent directories as needed
|
||||
|
||||
### Package Management
|
||||
|
||||
- Implemented package record type for managing:
|
||||
- Package name
|
||||
- Source path
|
||||
- Target path
|
||||
- Ignore patterns
|
||||
- Added support for reading ignore patterns from:
|
||||
- .stash-local-ignore
|
||||
- .stash-global-ignore
|
||||
|
||||
### Testing
|
||||
|
||||
- Added comprehensive test suite
|
||||
- Implemented test cases for:
|
||||
- Dot syntax stashing
|
||||
- Explicit path stashing
|
||||
- Path resolution
|
||||
- Symlink creation
|
||||
|
||||
## Current Operation
|
||||
|
||||
Stash now supports two main modes of operation:
|
||||
|
||||
1. Dot Syntax:
|
||||
|
||||
```scheme
|
||||
cd ~/.dotfiles/.config/package
|
||||
stash .
|
||||
```
|
||||
|
||||
- Uses current directory as package directory
|
||||
- Uses parent as stow directory
|
||||
- Creates symlink in ~/.config/package
|
||||
|
||||
2. Explicit Paths:
|
||||
|
||||
```scheme
|
||||
stash --source=~/.config/package --target=~/.dotfiles/.config
|
||||
```
|
||||
|
||||
- Moves package from source to target
|
||||
- Creates symlink at original location
|
||||
|
||||
### Symlink Creation Process
|
||||
|
||||
1. Determines source and target paths
|
||||
2. Creates parent directories if needed
|
||||
3. Removes existing symlink/directory if present
|
||||
4. Creates new symlink pointing to correct location
|
||||
|
||||
### Path Resolution
|
||||
|
||||
- Handles both absolute and relative paths
|
||||
- Expands home directory references
|
||||
- Resolves dot and dot-dot notation
|
||||
- Maintains correct directory structure
|
||||
|
||||
## Known Issues
|
||||
|
||||
- Warning about overriding core binding `canonicalize-path`
|
||||
- This is expected behavior and doesn't affect functionality
|
||||
- Could be addressed in future by renaming the function
|
||||
|
||||
## Future Plans
|
||||
|
||||
1. Implement more robust conflict resolution
|
||||
2. Add comprehensive documentation
|
||||
3. Optimize path handling
|
||||
4. Address module import warnings
|
||||
5. Add user configuration options
|
||||
6. Enhance cross-platform support
|
||||
|
||||
## Dependencies
|
||||
|
||||
- Guile Scheme 3.0.9
|
||||
- Standard Guile libraries
|
||||
- Custom modules for path handling and file operations
|
||||
139
README.md
139
README.md
|
|
@ -1,74 +1,107 @@
|
|||
|
||||
# Stash
|
||||
|
||||
`stash` is a command-line utility written in Guile Scheme that helps manage symbolic links (symlinks) for files and directories. This tool is inspired by GNU Stow but written in Guile Scheme. It provides conflict resolution and an interactive interface, allowing users to move directories to a target location and create symlinks in the source directory's parent folder.
|
||||
`stash` is a command-line utility written in Guile Scheme that helps manage symbolic links (symlinks) for files and directories. This tool is inspired by GNU Stow but written in Guile Scheme. It provides advanced path handling and conflict resolution, allowing users to manage their dotfiles and configuration files effectively.
|
||||
|
||||
## Key Features
|
||||
|
||||
- **Move and Symlink**: `stash` moves entire directories to a specified target directory and creates a symlink in the original parent directory.
|
||||
- **Conflict Handling**: When a conflict occurs (e.g., an existing symlink), the user is prompted to either overwrite, skip, or cancel.
|
||||
- **Logging**: All actions, such as moving directories, creating symlinks, and resolving conflicts, are logged in `stash.log`.
|
||||
- **Command-Line Interface**: Command-line parsing allows for specifying the source and target directories.
|
||||
- **Advanced Path Handling**: Robust support for dot syntax, home directory expansion, and both absolute and relative paths
|
||||
- **Flexible Usage**: Supports both dot syntax (.) and explicit source/target paths
|
||||
- **Symlink Management**: Creates and manages symlinks while maintaining correct directory structure
|
||||
- **Conflict Resolution**: Handles existing files and symlinks gracefully
|
||||
- **Comprehensive Logging**: Detailed logging of all operations for tracking and debugging
|
||||
|
||||
## Usage
|
||||
|
||||
```sh
|
||||
guile -L . stash.scm --target=<target-dir> --source=<package-dir>
|
||||
```
|
||||
There are two ways to use stash:
|
||||
|
||||
- `<target-dir>`: Directory where the package directory will be moved.
|
||||
- `<source>`: Directory to be moved and symlinked.
|
||||
1. Using explicit source and target directories:
|
||||
|
||||
## Example
|
||||
```sh
|
||||
guile -L . stash.scm --target=<target-dir> --source=<package-dir>
|
||||
```
|
||||
|
||||
Suppose you want to move `~/.config/rofi` to `~/.dotfiles/.config` and create a symlink at `~/.config/rofi` pointing to the new location. You would run:
|
||||
2. Using the dot syntax (similar to GNU Stow):
|
||||
|
||||
```sh
|
||||
cd ~/.dotfiles/.config/package
|
||||
guile -L . stash.scm .
|
||||
```
|
||||
|
||||
When using the dot syntax (`.`), stash will:
|
||||
|
||||
1. Use the current directory as the package directory
|
||||
2. Use the parent directory as the stow directory
|
||||
3. Create symlinks in the corresponding location under your home directory
|
||||
|
||||
### Examples
|
||||
|
||||
1. Explicit paths:
|
||||
|
||||
```sh
|
||||
# Move ~/.config/rofi to ~/.dotfiles/.config and create symlink
|
||||
guile -L . stash.scm --target=~/.dotfiles/.config --source=~/.config/rofi
|
||||
```
|
||||
|
||||
2. Dot syntax:
|
||||
|
||||
```sh
|
||||
# Move to your package directory
|
||||
cd ~/.dotfiles/.config/rofi
|
||||
# Create symlink at ~/.config/rofi
|
||||
guile -L . stash.scm .
|
||||
```
|
||||
|
||||
## Path Handling
|
||||
|
||||
Stash handles various path formats:
|
||||
|
||||
- Absolute paths: `/home/user/.config`
|
||||
- Relative paths: `../config`, `./config`
|
||||
- Home directory: `~/.config`
|
||||
- Dot notation: `.`, `..`
|
||||
|
||||
## Ignore Patterns
|
||||
|
||||
Stash supports two types of ignore files:
|
||||
|
||||
- `.stash-local-ignore`: Package-specific ignore patterns
|
||||
- `.stash-global-ignore`: Global ignore patterns for all packages
|
||||
|
||||
Default ignore patterns:
|
||||
|
||||
- `.git` directories
|
||||
- `.stash-local-ignore` files
|
||||
- `.DS_Store` files
|
||||
|
||||
## Project Structure
|
||||
|
||||
```sh
|
||||
guile -L . stash.scm --target=~/.dotfiles/.config --source=~/.config/rofi
|
||||
stash/
|
||||
├── stash.scm # Main entry point
|
||||
├── modules/
|
||||
│ └── stash/
|
||||
│ ├── paths.scm # Path handling
|
||||
│ ├── tree.scm # Tree operations
|
||||
│ ├── package.scm # Package management
|
||||
│ ├── file-ops.scm # File operations
|
||||
│ ├── log.scm # Logging
|
||||
│ ├── conflict.scm # Conflict resolution
|
||||
│ ├── colors.scm # Terminal colors
|
||||
│ └── help.scm # Help messages
|
||||
├── README.md
|
||||
├── DEVLOG.md # Development log
|
||||
└── LICENSE
|
||||
```
|
||||
|
||||
This moves the `rofi` directory to `~/.dotfiles/.config` and creates a symlink in `~/.config` pointing to the new location.
|
||||
## Dependencies
|
||||
|
||||
## Conflict Resolution
|
||||
- Guile Scheme 3.0.9
|
||||
- Standard Guile libraries
|
||||
|
||||
If a symlink already exists at the target location, `stash` detects this and prompts the user to either:
|
||||
## Development
|
||||
|
||||
- **Overwrite**: Remove the existing symlink and create a new one.
|
||||
- **Skip**: Keep the existing symlink and skip creating a new one.
|
||||
- **Cancel**: Cancel the operation.
|
||||
|
||||
## Logging
|
||||
|
||||
All actions taken by the program are logged in a file named `stash.log`. This includes:
|
||||
|
||||
- Moving directories.
|
||||
- Creating symlinks.
|
||||
- Conflict resolutions.
|
||||
|
||||
Example log entry:
|
||||
```
|
||||
Moved /home/glenn/.config/rofi to /home/glenn/.dotfiles/.config/rofi
|
||||
Symlink created at /home/glenn/.config/rofi pointing to /home/glenn/.dotfiles/.config/rofi
|
||||
```
|
||||
|
||||
## Improvements
|
||||
|
||||
Here’s a summary of the recent improvements:
|
||||
|
||||
1. **Move Entire Directory**: Instead of copying, the program now moves the entire directory from the package directory to the target directory.
|
||||
|
||||
2. **Path Expansion**: The program now correctly expands `~` to the full path using `$HOME`, ensuring compatibility with home directory shortcuts.
|
||||
|
||||
3. **Logging Functionality**: All operations are logged to `stash.log` to track actions like moving directories and creating symlinks.
|
||||
|
||||
4. **Modular Functions**: The program is now structured with modular functions for path expansion, conflict handling, and symlink creation.
|
||||
|
||||
## Future Enhancements
|
||||
|
||||
- Add support for a non-interactive mode for automation workflows.
|
||||
- Improve error handling for more specific error types and exit codes.
|
||||
- Extend conflict resolution options with more advanced features (e.g., backup, replace).
|
||||
See `DEVLOG.md` for detailed development history and recent changes.
|
||||
|
||||
## License
|
||||
|
||||
`stash` is licensed under the GNU General Public License v3. See the LICENSE file for more information.
|
||||
`stash` is licensed under the GNU General Public License v3. See the LICENSE file for more information.
|
||||
|
|
|
|||
|
|
@ -1,85 +1,17 @@
|
|||
;; stash-file-ops.scm --- File operations module for Stash
|
||||
|
||||
;; (define-module (stash file-ops)
|
||||
;; #:export (move-source-to-target create-symlink-in-parent delete-directory))
|
||||
|
||||
;; ;; Import necessary modules
|
||||
;; (use-modules (stash log) ;; Import log-action, current-timestamp
|
||||
;; (stash paths) ;; Import expand-home, concat-path, ensure-config-path
|
||||
;; (stash conflict)) ;; Import prompt-user-for-action, handle-conflict
|
||||
|
||||
;; ;;; Helper function to quote shell arguments
|
||||
;; (define (shell-quote-argument arg)
|
||||
;; "Quote shell argument to handle spaces or special characters."
|
||||
;; (if (string-contains arg " ")
|
||||
;; (string-append "\"" (string-replace arg "\"" "\\\"") "\"")
|
||||
;; arg))
|
||||
|
||||
;; ;;; Helper function to delete a directory recursively
|
||||
;; (define (delete-directory path)
|
||||
;; "Delete a directory recursively."
|
||||
;; (if (file-is-directory? path)
|
||||
;; (begin
|
||||
;; (system (string-append "rm -rf " (shell-quote-argument path)))
|
||||
;; (log-action (format #f "Deleted directory: ~a" path)))
|
||||
;; (display "Error: Path is not a directory.\n")))
|
||||
|
||||
;; ;;; 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, ensuring .config in the target path."
|
||||
;; (let* ((target-dir (ensure-config-path target-dir)) ;; Use ensure-config-path from paths.scm
|
||||
;; (source-dir (expand-home source-dir)) ;; Use expand-home from paths.scm
|
||||
;; (source-name (basename source-dir))
|
||||
;; (target-source-dir (concat-path target-dir source-name))) ;; Use concat-path from paths.scm
|
||||
;; ;; Ensure that the .config directory exists in the target
|
||||
;; (if (not (file-exists? target-dir))
|
||||
;; (mkdir target-dir #o755))
|
||||
;; ;; Check if the target directory already exists
|
||||
;; (if (file-exists? target-source-dir)
|
||||
;; (handle-conflict target-source-dir source-dir delete-directory log-action) ;; Conflict handling
|
||||
;; ;; If the target directory doesn't exist, proceed with the move
|
||||
;; (begin
|
||||
;; (rename-file source-dir target-source-dir)
|
||||
;; (display (format #f "Moved ~a to ~a\n" source-dir target-source-dir))
|
||||
;; (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 (concat-path parent-dir (basename source-dir))) ;; Concatenate paths safely
|
||||
;; (target-dir (expand-home target-dir))) ;; Ensure the target path is expanded
|
||||
;; ;; Check if symlink already exists
|
||||
;; (if (file-exists? symlink-target)
|
||||
;; (let ((choice (prompt-user-for-action)))
|
||||
;; (cond
|
||||
;; ((eq? choice 'overwrite)
|
||||
;; (delete-file symlink-target)
|
||||
;; (symlink target-dir symlink-target)
|
||||
;; (display (format #f "Overwriting symlink ~a pointing to ~a\n" symlink-target target-dir))
|
||||
;; (log-action (format #f "Overwritten symlink: ~a pointing to ~a" symlink-target target-dir)))
|
||||
;; ((eq? choice 'skip)
|
||||
;; (display "Skipping symlink creation.\n")
|
||||
;; (log-action (format #f "Skipped symlink creation: ~a" symlink-target)))
|
||||
;; ((eq? choice 'cancel)
|
||||
;; (display "Operation cancelled by user.\n")
|
||||
;; (log-action "Operation cancelled by user.")
|
||||
;; (exit 0))))
|
||||
;; ;; Create the symlink if no conflict
|
||||
;; (begin
|
||||
;; (symlink target-dir symlink-target)
|
||||
;; (display (format #f "Symlink created at ~a pointing to ~a\n" symlink-target target-dir))
|
||||
;; (log-action (format #f "Symlink created at ~a pointing to ~a" symlink-target target-dir))))))
|
||||
|
||||
(define-module (stash file-ops)
|
||||
#:use-module (stash log) ;; Import log-action, current-timestamp
|
||||
#:use-module (stash paths) ;; Import expand-home, concat-path, ensure-config-path
|
||||
#:use-module (stash conflict) ;; Import prompt-user-for-action, handle-conflict
|
||||
#:export (move-source-to-target create-symlink-in-parent delete-directory))
|
||||
|
||||
;; Import necessary modules
|
||||
(use-modules (stash colors) ;; Import color definitions
|
||||
(stash log)
|
||||
(stash paths)
|
||||
(stash conflict))
|
||||
;;; Helper function to quote shell arguments
|
||||
(define (shell-quote-argument arg)
|
||||
"Quote shell argument to handle spaces or special characters."
|
||||
(if (string-contains arg " ")
|
||||
(string-append "\"" (string-replace arg "\"" "\\\"") "\"")
|
||||
arg))
|
||||
|
||||
;;; Helper function to delete a directory recursively
|
||||
(define (delete-directory path)
|
||||
|
|
@ -87,53 +19,36 @@
|
|||
(if (file-is-directory? path)
|
||||
(begin
|
||||
(system (string-append "rm -rf " (shell-quote-argument path)))
|
||||
(log-action (color-message (format #f "Deleted directory: ~a" path) green-text)))
|
||||
(display (color-message "Error: Path is not a directory.\n" red-text))))
|
||||
(log-action (format #f "Deleted directory: ~a" path)))
|
||||
(display "Error: Path is not a directory.\n")))
|
||||
|
||||
;;; 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, ensuring .config in the target path."
|
||||
(let* ((target-dir (ensure-config-path target-dir))
|
||||
(source-dir (expand-home source-dir))
|
||||
(let* ((target-dir (ensure-config-path target-dir)) ;; Use ensure-config-path from paths.scm
|
||||
(source-dir (expand-home source-dir)) ;; Use expand-home from paths.scm
|
||||
(source-name (basename source-dir))
|
||||
(target-source-dir (concat-path target-dir source-name)))
|
||||
(target-source-dir (concat-path target-dir source-name))) ;; Use concat-path from paths.scm
|
||||
;; Ensure that the .config directory exists in the target
|
||||
(if (not (file-exists? target-dir))
|
||||
(mkdir target-dir #o755))
|
||||
;; Check if the target directory already exists
|
||||
(if (file-exists? target-source-dir)
|
||||
(handle-conflict target-source-dir source-dir delete-directory log-action)
|
||||
(handle-conflict target-source-dir source-dir delete-directory log-action) ;; Conflict handling
|
||||
;; If the target directory doesn't exist, proceed with the move
|
||||
(begin
|
||||
(rename-file source-dir target-source-dir)
|
||||
(display (color-message (format #f "Moved ~a to ~a\n" source-dir target-source-dir) green-text))
|
||||
(display (format #f "Moved ~a to ~a\n" source-dir target-source-dir))
|
||||
(log-action (format #f "Moved ~a to ~a" source-dir target-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)))
|
||||
(symlink-target (concat-path parent-dir (basename source-dir)))
|
||||
(target-dir (expand-home target-dir)))
|
||||
;; Check if symlink already exists
|
||||
(if (file-exists? symlink-target)
|
||||
(let ((choice (prompt-user-for-action)))
|
||||
(cond
|
||||
((eq? choice 'overwrite)
|
||||
(delete-file symlink-target)
|
||||
(symlink target-dir symlink-target)
|
||||
(display (color-message (format #f "Overwriting symlink ~a pointing to ~a\n" symlink-target target-dir) green-text))
|
||||
(log-action (format #f "Overwritten symlink: ~a pointing to ~a" symlink-target target-dir)))
|
||||
((eq? choice 'skip)
|
||||
(display (color-message "Skipping symlink creation.\n" green-text))
|
||||
(log-action (format #f "Skipped symlink creation: ~a" symlink-target)))
|
||||
((eq? choice 'cancel)
|
||||
(display (color-message "Operation cancelled by user.\n" yellow-text))
|
||||
(log-action "Operation cancelled by user.")
|
||||
(exit 0))))
|
||||
;; Create the symlink if no conflict
|
||||
(begin
|
||||
(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))))))
|
||||
(define (create-symlink-in-parent source target)
|
||||
"Create a symlink in the parent directory of the original source."
|
||||
(let ((parent-dir (dirname target)))
|
||||
;; Create parent directory if it doesn't exist
|
||||
(if (not (file-exists? parent-dir))
|
||||
(mkdir parent-dir #o755))
|
||||
;; Create the symlink
|
||||
(symlink source target)
|
||||
(log-action (format #f "Created symlink ~a -> ~a" target source))))
|
||||
|
|
|
|||
|
|
@ -7,24 +7,32 @@
|
|||
(define (display-help)
|
||||
"Display help message explaining how to use the program."
|
||||
(display "
|
||||
Usage: stash.scm --source <source-dir> --target <target-dir> [options]
|
||||
stash.scm -s <source-dir> -t <target-dir> [options]
|
||||
Usage: stash.scm [--source <source-dir> --target <target-dir>] [options]
|
||||
stash.scm [-s <source-dir> -t <target-dir>] [options]
|
||||
stash.scm .
|
||||
|
||||
Stash is a Guile Scheme utility for moving directories and creating symlinks with conflict resolution.
|
||||
Stash is a Guile Scheme utility for managing symlinks with conflict resolution.
|
||||
|
||||
Options:
|
||||
--source, -s Specify the source directory to be moved.
|
||||
--target, -t Specify the target directory where the symlink should be created.
|
||||
--version, -v Show the current version of the program.
|
||||
--help, -h Display this help message.
|
||||
--no-folding Disable directory tree folding.
|
||||
--simulate Show what would happen without making changes.
|
||||
--adopt Import existing files into the stow directory.
|
||||
--restow Remove and recreate all symlinks.
|
||||
--delete Remove all symlinks for a package.
|
||||
|
||||
Examples:
|
||||
Using long options:
|
||||
1. Using explicit paths:
|
||||
guile -L . stash.scm --source ~/.config/test --target ~/.dotfiles/
|
||||
|
||||
Using short options:
|
||||
guile -L . stash.scm -s ~/.config/test -t ~/.dotfiles/
|
||||
|
||||
This command will move the directory ~/.config/test to ~/.dotfiles/.config/test and create a symlink in ~/.config pointing to the new location.
|
||||
2. Using dot syntax (like GNU Stow):
|
||||
cd ~/.dotfiles/.config/test
|
||||
guile -L . stash.scm .
|
||||
|
||||
This will create symlinks in ~/.config/test pointing to ~/.dotfiles/.config/test
|
||||
")
|
||||
(exit 0))
|
||||
|
|
|
|||
|
|
@ -1,43 +1,37 @@
|
|||
;; stash-log.scm --- Logging module for Stash
|
||||
|
||||
;; (define-module (stash log)
|
||||
;; #:export (log-action current-timestamp))
|
||||
|
||||
;; (use-modules (srfi srfi-19)) ;; For date and time functions
|
||||
|
||||
;; ;;; 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)))
|
||||
;; (strftime "%Y-%m-%d-%H-%M-%S" (localtime seconds))))
|
||||
|
||||
;; ;;; Function to log actions with a 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)))
|
||||
|
||||
(define-module (stash log)
|
||||
#:export (log-action current-timestamp))
|
||||
#:use-module (srfi srfi-19) ; For date/time functions
|
||||
#:export (log-action
|
||||
current-timestamp))
|
||||
|
||||
;; Import necessary modules
|
||||
(use-modules (stash colors) ;; Import color definitions
|
||||
(srfi srfi-19)) ;; For date and time handling
|
||||
|
||||
;;; Helper function to get a formatted current time string
|
||||
;; Get current timestamp in ISO 8601 format
|
||||
(define (current-timestamp)
|
||||
"Return the current date and time as a formatted string."
|
||||
(let* ((time (current-time))
|
||||
(seconds (time-second time)))
|
||||
(strftime "%Y-%m-%d-%H-%M-%S" (localtime seconds))))
|
||||
(let ((current-time (current-date)))
|
||||
(date->string current-time "~Y-~m-~d ~H:~M:~S")))
|
||||
|
||||
;;; Improved logging function with timestamp and colored output
|
||||
;; Log an action 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 (color-message (string-append "[" (current-timestamp) "] " message) green-text) log-port) ;; Green text in logs
|
||||
(newline log-port)
|
||||
(close-port log-port)))
|
||||
(let ((log-dir (string-append (getenv "HOME") "/.local/share/stash"))
|
||||
(log-file "stash.log"))
|
||||
;; Create log directory if it doesn't exist
|
||||
(when (not (file-exists? log-dir))
|
||||
(mkdir-p log-dir))
|
||||
;; Append message to log file
|
||||
(call-with-output-file (string-append log-dir "/" log-file)
|
||||
(lambda (port)
|
||||
(format port "[~a] ~a~%" (current-timestamp) message))
|
||||
#:append #t)))
|
||||
|
||||
;; Helper function to create directory and parents
|
||||
(define (mkdir-p dir)
|
||||
(let loop ((components (string-split dir #\/))
|
||||
(path ""))
|
||||
(when (not (null? components))
|
||||
(let ((new-path (if (string-null? path)
|
||||
(car components)
|
||||
(string-append path "/" (car components)))))
|
||||
(when (and (not (string-null? new-path))
|
||||
(not (file-exists? new-path)))
|
||||
(mkdir new-path #o755))
|
||||
(loop (cdr components) new-path)))))
|
||||
|
|
|
|||
|
|
@ -0,0 +1,49 @@
|
|||
(define-module (stash package)
|
||||
#:use-module (srfi srfi-9) ; For record types
|
||||
#:use-module (ice-9 regex)
|
||||
#:use-module (ice-9 rdelim) ; For read-line
|
||||
#:use-module (ice-9 ftw)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:export (make-package
|
||||
package?
|
||||
package-name
|
||||
package-path
|
||||
package-target
|
||||
package-ignore-patterns
|
||||
read-ignore-patterns))
|
||||
|
||||
;; Package record type
|
||||
(define-record-type <package>
|
||||
(make-package name path target ignore-patterns)
|
||||
package?
|
||||
(name package-name)
|
||||
(path package-path)
|
||||
(target package-target)
|
||||
(ignore-patterns package-ignore-patterns))
|
||||
|
||||
;; Read ignore patterns from .stash-local-ignore and .stash-global-ignore
|
||||
(define (read-ignore-patterns package-path)
|
||||
(let* ((local-ignore (string-append package-path "/.stash-local-ignore"))
|
||||
(global-ignore (string-append (dirname package-path) "/.stash-global-ignore"))
|
||||
(default-patterns '("^/\\.git" "^/\\.stash-local-ignore$" "\\.DS_Store$"))
|
||||
(read-patterns
|
||||
(lambda (file)
|
||||
(if (file-exists? file)
|
||||
(call-with-input-file file
|
||||
(lambda (port)
|
||||
(let loop ((line (read-line port))
|
||||
(patterns '()))
|
||||
(if (eof-object? line)
|
||||
patterns
|
||||
(loop (read-line port)
|
||||
(cons line patterns))))))
|
||||
'()))))
|
||||
(append default-patterns
|
||||
(read-patterns global-ignore)
|
||||
(read-patterns local-ignore))))
|
||||
|
||||
;; Check if a path should be ignored based on patterns
|
||||
(define (should-ignore? path patterns)
|
||||
(any (lambda (pattern)
|
||||
(string-match pattern path))
|
||||
patterns))
|
||||
|
|
@ -1,12 +1,16 @@
|
|||
;; stash-paths.scm --- Path handling module for Stash
|
||||
|
||||
(define-module (stash paths)
|
||||
#:export (expand-home concat-path ensure-config-path))
|
||||
#:use-module (ice-9 regex)
|
||||
#:export (expand-home
|
||||
canonicalize-path
|
||||
concat-path
|
||||
ensure-config-path))
|
||||
|
||||
;;; Expand ~ in paths to the full home directory path
|
||||
(define (expand-home path)
|
||||
"Expand ~ to the user's home directory."
|
||||
(if (string-prefix? "~" path)
|
||||
(if (string-match "^~" path)
|
||||
(string-append (getenv "HOME") (substring path 1))
|
||||
path))
|
||||
|
||||
|
|
@ -26,3 +30,26 @@
|
|||
(if (not (string-suffix? "/.config" target-dir))
|
||||
(string-append target-dir "/.config")
|
||||
target-dir)))
|
||||
|
||||
;;; Function to canonicalize a path (resolve . and ..)
|
||||
(define (canonicalize-path path)
|
||||
(let* ((expanded-path (expand-home path))
|
||||
(absolute-path (if (string-prefix? "/" expanded-path)
|
||||
expanded-path
|
||||
(string-append (getcwd) "/" expanded-path)))
|
||||
(components (string-split absolute-path #\/))
|
||||
(result '()))
|
||||
;; Process each component
|
||||
(for-each
|
||||
(lambda (component)
|
||||
(cond
|
||||
((or (string=? component "") (string=? component ".")) #t) ; Skip empty or current directory
|
||||
((string=? component "..") ; Go up one directory
|
||||
(when (pair? result)
|
||||
(set! result (cdr result))))
|
||||
(else
|
||||
(set! result (cons component result)))))
|
||||
components)
|
||||
|
||||
;; Build the final path
|
||||
(string-append "/" (string-join (reverse result) "/"))))
|
||||
|
|
|
|||
|
|
@ -0,0 +1,91 @@
|
|||
(define-module (stash tree)
|
||||
#:use-module (srfi srfi-9) ; For record types
|
||||
#:use-module (ice-9 ftw)
|
||||
#:use-module (ice-9 regex) ; For string-match
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (stash package)
|
||||
#:use-module (stash file-ops)
|
||||
#:use-module (stash log)
|
||||
#:export (analyze-tree
|
||||
fold-tree
|
||||
plan-operations))
|
||||
|
||||
(use-modules (ice-9 ftw)
|
||||
(ice-9 regex)
|
||||
(srfi srfi-1)
|
||||
(stash package)
|
||||
(stash file-ops))
|
||||
|
||||
;; Tree node record type
|
||||
(define-record-type <tree-node>
|
||||
(make-tree-node path type children)
|
||||
tree-node?
|
||||
(path node-path)
|
||||
(type node-type) ; 'file or 'directory
|
||||
(children node-children))
|
||||
|
||||
;; Check if a path should be ignored based on patterns
|
||||
(define (should-ignore? path patterns)
|
||||
(any (lambda (pattern)
|
||||
(string-match pattern path))
|
||||
patterns))
|
||||
|
||||
;; Analyze directory tree and create tree structure
|
||||
(define (analyze-tree package)
|
||||
(let ((root-path (package-path package))
|
||||
(ignore-patterns (package-ignore-patterns package)))
|
||||
(let analyze ((path root-path))
|
||||
(if (should-ignore? path ignore-patterns)
|
||||
#f
|
||||
(if (file-is-directory? path)
|
||||
(let* ((entries (scandir path))
|
||||
(children (filter-map
|
||||
(lambda (entry)
|
||||
(if (member entry '("." ".."))
|
||||
#f
|
||||
(analyze (string-append path "/" entry))))
|
||||
entries)))
|
||||
(make-tree-node path 'directory children))
|
||||
(make-tree-node path 'file '()))))))
|
||||
|
||||
;; Determine if a directory tree can be folded
|
||||
(define (can-fold-tree? node target-base)
|
||||
(and (tree-node? node)
|
||||
(eq? (node-type node) 'directory)
|
||||
(= (length (node-children node)) 1)
|
||||
(let ((child (car (node-children node))))
|
||||
(and (eq? (node-type child) 'directory)
|
||||
(not (file-exists? (string-append target-base "/"
|
||||
(basename (node-path node)))))))))
|
||||
|
||||
;; Plan stow operations for a tree
|
||||
(define (plan-operations tree package)
|
||||
(let* ((source-base (package-path package))
|
||||
(target-base (package-target package))
|
||||
(source-name (basename source-base)))
|
||||
(format #t "Source base: ~a~%" source-base)
|
||||
(format #t "Target base: ~a~%" target-base)
|
||||
(format #t "Source name: ~a~%" source-name)
|
||||
|
||||
;; Create symlink for the entire directory
|
||||
(let* ((target-path (string-append (getenv "HOME") "/.config/" source-name)))
|
||||
(format #t "Target path: ~a~%" target-path)
|
||||
|
||||
;; Create parent directory if it doesn't exist
|
||||
(let ((target-dir (dirname target-path)))
|
||||
(when (not (file-exists? target-dir))
|
||||
(format #t "Creating parent directory: ~a~%" target-dir)
|
||||
(mkdir target-dir #o755)))
|
||||
|
||||
;; Remove existing directory or file
|
||||
(when (file-exists? target-path)
|
||||
(format #t "Removing existing path: ~a~%" target-path)
|
||||
(system (string-append "rm -rf " target-path)))
|
||||
|
||||
;; Create symlink
|
||||
(let ((source-target (if (string-prefix? (getenv "HOME") source-base)
|
||||
(string-append target-base "/" source-name)
|
||||
source-base)))
|
||||
(format #t "Creating symlink: ~a -> ~a~%" target-path source-target)
|
||||
(symlink source-target target-path)
|
||||
'()))))
|
||||
12
stash.log
12
stash.log
|
|
@ -2,3 +2,15 @@
|
|||
[32m[2024-10-04-15-22-08] Operation cancelled by user.[0m
|
||||
[32m[2024-10-14-09-21-48] Moved /home/glenn/.config/test to /home/glenn/.dotfiles/.config/test[0m
|
||||
[32m[2024-10-14-09-21-48] Symlink created at /home/glenn/.config/test pointing to /home/glenn/.dotfiles/.config/test[0m
|
||||
[32m[2024-10-14-09-24-43] Moved /home/glenn/.config/fish to /home/glenn/.dotfiles/.config/fish[0m
|
||||
[32m[2024-10-14-09-24-43] Symlink created at /home/glenn/.config/fish pointing to /home/glenn/.dotfiles/.config/fish[0m
|
||||
[32m[2024-10-14-09-44-51] Moved /home/glenn/.config/sway to /home/glenn/.dotfiles/.config/sway[0m
|
||||
[32m[2024-10-14-09-44-51] Symlink created at /home/glenn/.config/sway pointing to /home/glenn/.dotfiles/.config/sway[0m
|
||||
[32m[2024-10-14-09-45-02] Moved /home/glenn/.config/hypr to /home/glenn/.dotfiles/.config/hypr[0m
|
||||
[32m[2024-10-14-09-45-02] Symlink created at /home/glenn/.config/hypr pointing to /home/glenn/.dotfiles/.config/hypr[0m
|
||||
[32m[2024-10-14-09-46-35] Moved /home/glenn/.config/kitty to /home/glenn/.dotfiles/.config/kitty[0m
|
||||
[32m[2024-10-14-09-46-35] Symlink created at /home/glenn/.config/kitty pointing to /home/glenn/.dotfiles/.config/kitty[0m
|
||||
[32m[2024-10-14-09-47-12] Moved /home/glenn/.config/qutebrowser to /home/glenn/.dotfiles/.config/qutebrowser[0m
|
||||
[32m[2024-10-14-09-47-12] Symlink created at /home/glenn/.config/qutebrowser pointing to /home/glenn/.dotfiles/.config/qutebrowser[0m
|
||||
[32m[2024-10-14-09-47-31] Moved /home/glenn/.config/alacritty to /home/glenn/.dotfiles/.config/alacritty[0m
|
||||
[32m[2024-10-14-09-47-31] Symlink created at /home/glenn/.config/alacritty pointing to /home/glenn/.dotfiles/.config/alacritty[0m
|
||||
|
|
|
|||
119
stash.scm
119
stash.scm
|
|
@ -33,15 +33,41 @@
|
|||
|
||||
;;; CODE
|
||||
|
||||
(use-modules (ice-9 getopt-long)
|
||||
(stash help) ;; Help module
|
||||
(stash colors) ;; ANSI colors
|
||||
(stash log) ;; Logging module
|
||||
(stash paths) ;; Path handling module
|
||||
(stash conflict) ;; Conflict resolution module
|
||||
(stash file-ops) ;; File and symlink operations module
|
||||
(srfi srfi-1)
|
||||
(srfi srfi-19))
|
||||
(define-module (stash)
|
||||
#:use-module (ice-9 getopt-long)
|
||||
#: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))
|
||||
|
||||
;;; Command-line options
|
||||
(define %options
|
||||
'((target (value #t) (single-char #\t))
|
||||
(source (value #t) (single-char #\s))
|
||||
(help (value #f) (single-char #\h))
|
||||
(version (value #f) (single-char #\v))
|
||||
(no-folding (value #f) (single-char #\n))
|
||||
(simulate (value #f) (single-char #\S))
|
||||
(adopt (value #f) (single-char #\a))
|
||||
(restow (value #f) (single-char #\R))
|
||||
(delete (value #f) (single-char #\D))))
|
||||
|
||||
;;; Function to handle dot directory stashing
|
||||
(define (handle-dot-stash current-dir)
|
||||
"Handle stashing when using the '.' syntax. Uses parent as stow dir and $HOME as target."
|
||||
(let* ((pkg-dir (canonicalize-path current-dir))
|
||||
(stow-dir (dirname pkg-dir))
|
||||
(home-dir (getenv "HOME")))
|
||||
(format #t "pkg-dir: ~a~%" pkg-dir)
|
||||
(format #t "stow-dir: ~a~%" stow-dir)
|
||||
(format #t "home-dir: ~a~%" home-dir)
|
||||
(values pkg-dir stow-dir home-dir)))
|
||||
|
||||
;;; Version function
|
||||
(define (display-version)
|
||||
|
|
@ -57,43 +83,52 @@
|
|||
(member "-v" args))
|
||||
(display-version)))
|
||||
|
||||
;;; 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))) ;; Only pass source-dir and target-dir
|
||||
(create-symlink-in-parent source-dir target-source-dir))) ;; Create the symlink if no conflict
|
||||
|
||||
;;; Function to handle command-line arguments
|
||||
(define (parse-arguments args)
|
||||
"Parse command-line arguments."
|
||||
(getopt-long args
|
||||
'((target (value #t) (single-char #\t)) ;; Support both --target and -t
|
||||
(source (value #t) (single-char #\s)) ;; Support both --source and -s
|
||||
(help (value #f) (single-char #\h)) ;; Support -h for help
|
||||
(version (value #f) (single-char #\v))))) ;; Support -v for 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)))
|
||||
|
||||
;;; Main entry point
|
||||
(define (main args)
|
||||
"Main function to parse arguments and execute the program."
|
||||
(setenv "GUILE_AUTO_COMPILE" "0") ;; Disable auto-compilation for performance
|
||||
|
||||
;; Check if --help or -h was passed
|
||||
(if (or (member "--help" args) (member "-h" args))
|
||||
(display-help))
|
||||
|
||||
;; Check if --version or -v was passed
|
||||
(check-for-version args)
|
||||
|
||||
;;; Parse remaining arguments
|
||||
(let* ((options (parse-arguments args)) ;; Parse the command-line options
|
||||
(target-dir (assoc-ref options 'target)) ;; Extract --target or -t argument
|
||||
(source-dir (assoc-ref options 'source))) ;; Extract --source or -s argument
|
||||
(if (and target-dir source-dir) ;; Ensure both arguments are provided
|
||||
(handle-source-and-target source-dir target-dir) ;; Proceed with moving the directory and creating the symlink
|
||||
(begin
|
||||
(display (color-message "Error: Missing required arguments.\n" red-text)) ;; Show error in red text
|
||||
(display (color-message "Usage: stash.scm --target <target-dir> --source <source-dir>\n" yellow-text)) ;; Show updated usage message
|
||||
(exit 1))))) ;; Exit with error status
|
||||
(setenv "GUILE_AUTO_COMPILE" "0")
|
||||
|
||||
(let* ((options (getopt-long args %options))
|
||||
(source-dir (assoc-ref options 'source))
|
||||
(target-dir (assoc-ref options 'target))
|
||||
(non-option-args (option-ref options '() '())))
|
||||
|
||||
(cond
|
||||
((assoc-ref options 'help) (display-help))
|
||||
((assoc-ref options 'version) (display-version))
|
||||
;; Handle "stash ." syntax
|
||||
((and (= (length non-option-args) 1)
|
||||
(string=? (car non-option-args) "."))
|
||||
(call-with-values
|
||||
(lambda () (handle-dot-stash (getcwd)))
|
||||
(lambda (pkg-dir stow-dir home-dir)
|
||||
(let ((package (make-package
|
||||
(basename pkg-dir)
|
||||
pkg-dir
|
||||
home-dir
|
||||
(read-ignore-patterns pkg-dir))))
|
||||
(handle-stow package options)))))
|
||||
;; Handle traditional --source --target syntax
|
||||
((not (and target-dir source-dir))
|
||||
(display (color-message "Error: Either use '.' in a package directory or provide both --source and --target arguments.\n" red-text))
|
||||
(display (color-message "Usage: stash.scm [--target <target-dir> --source <source-dir>] | [.]\n" yellow-text))
|
||||
(exit 1))
|
||||
(else
|
||||
(let* ((expanded-source (expand-home source-dir))
|
||||
(expanded-target (expand-home target-dir))
|
||||
(package (make-package
|
||||
(basename expanded-source)
|
||||
expanded-source
|
||||
expanded-target
|
||||
(read-ignore-patterns expanded-source))))
|
||||
(handle-stow package options))))))
|
||||
|
||||
;; Entry point for stash
|
||||
(main (command-line))
|
||||
|
|
|
|||
Loading…
Reference in New Issue