Vastly updated program options, started adding makefile and man page (unfinished)
This commit is contained in:
parent
c97fac3c52
commit
c1a6156a2c
22
Makefile
Normal file
22
Makefile
Normal file
@ -0,0 +1,22 @@
|
||||
BINARY := solo
|
||||
PREFIX := /usr/local
|
||||
EXEC_PREFIX := ${PREFIX}
|
||||
BINDIR := ${EXEC_PREFIX}/bin
|
||||
DATAROOTDIR := ${PREFIX}/share
|
||||
LIBDIR := ${PREFIX}/lib
|
||||
MANDIR := ${DATAROOTDIR}/man
|
||||
MAN1DIR := ${MANDIR}/man1
|
||||
|
||||
install-bin: ${BINARY}
|
||||
install -d ${DESTDIR}${BINDIR}
|
||||
install -m 0755 ./${BINARY} ${DESTDIR}${BINDIR}
|
||||
|
||||
install-man: ${BINARY}.1
|
||||
gzip -k ./${BINARY}.1
|
||||
install -d ${DESTDIR}${MAN1DIR}
|
||||
install -m 0644 ./${BINARY}.1.gz ${DESTDIR}${MAN1DIR}
|
||||
|
||||
.PHONY: clean
|
||||
clean:
|
||||
rm -f ./${BINARY}.1.gz 2> /dev/null
|
||||
|
17
README.md
17
README.md
@ -1,6 +1,6 @@
|
||||
# solo
|
||||
|
||||
A simple, single branch, version control system for individuals.
|
||||
A simple, <s>single branch</s>, version control system for individuals.
|
||||
|
||||
|
||||
## Who is this for?
|
||||
@ -12,19 +12,22 @@ No one, really... me _maaaaybe_? It has been an educational exercise. However, i
|
||||
|
||||
solo essentially takes full backups of the current work tree and copies them to snapshots/commits in the `.solo` directory of a repository. It can then do a few simple things with those commits. All commands must be run from the repository root. The available commands are as follows:
|
||||
|
||||
### `solo init`
|
||||
### `solo create [[repo-description]]`
|
||||
|
||||
Initializes a directory tree as a solo directory. The command takes no arguments and mostly just sets up the needed file tree.
|
||||
Creates a `.solo` directory inside the current directory, making the CWD a solo repository. It builds the necessary file structure and configuration files (all within the `.solo` directory)
|
||||
|
||||
|
||||
### `solo commit [[commit-message]]`
|
||||
### `solo snap [snap-description]`
|
||||
|
||||
This commits a new snapshot to the `.solo/snapshots` folder. Unlike `git`, solo is a bit inefficient (but also more understandable to mere mortals) and always saves the full working tree... not just changes. As such, there is no need to `add` or `remove`. The concept of an `ignore` list may be added later. The commit message is optional but highly recommended.
|
||||
Takes a new snapshot of the current working directory and saves it on the current branch's work tree. Unlike `git`, solo is a bit inefficient (but also more understandable to mere mortals) and always saves the full working tree... not just changes. As such, there is no need to `add` or `remove`. The commit message is _required_
|
||||
|
||||
### `solo tag`
|
||||
|
||||
### `solo tag [[commit] [tag-name]]`
|
||||
Lists all tags
|
||||
|
||||
Tags a given commit with the given tag name. If no arguments are given the available tags will be listed. Tags can be recalled with `use` exactly like a commit but server as way to document meaningful commits like major version releases, etc.
|
||||
### `solo tag [tag-name] [tag-description]`
|
||||
|
||||
Tags HEAD with the given tag name and description. Tags can be recalled with `use` exactly like a commit but server as way to document meaningful commits like major version releases, etc.
|
||||
|
||||
|
||||
### `solo pick [commit] [file] [[to-file]]`
|
||||
|
20
flow.md
20
flow.md
@ -68,14 +68,22 @@ The branch list is the branch name and whether or not it is a tag
|
||||
remote, then we are done. No changes.
|
||||
2. If there are snaps, but we have all of them locally. We
|
||||
are done, but display a message enumerating how many
|
||||
snaps ahead of remote we are.
|
||||
3. If there are some missing from local, download them
|
||||
into a temporary branch
|
||||
1. Adjust the meta for each so that the new branch
|
||||
snaps ahead of remote we are
|
||||
3. If there are snaps missing in local, but local has no
|
||||
snaps that remote does not: pull all and update the
|
||||
local head [fast forward merge]. Report how many
|
||||
snaps ahead we moved
|
||||
3. If there are snaps missing from both: download the
|
||||
remotes into a temporary branch
|
||||
1. Adjust the meta for each snap so that the new branch
|
||||
references itself for the given commits, but still
|
||||
links back to the original branch once they would
|
||||
join up
|
||||
2. Merge the temporary branch into the current branch
|
||||
join up (re: parent branch)
|
||||
2. Add the temp branch/id to the "heads" key of the conf
|
||||
file
|
||||
3. Merge the temporary branch into the current branch
|
||||
4. Delete the temp branch files and remove it from the
|
||||
'heads' key of the conf file
|
||||
3. The user will need to resolve any merge conflicts
|
||||
2. Leave a file: `last-pull` in the branch root in the tree
|
||||
containing `[["head" 12312312312]]`, so that a push cannot
|
||||
|
740
new.solo.slo
740
new.solo.slo
@ -1,740 +0,0 @@
|
||||
;; `create` creates a solo repo in the current directory,
|
||||
;; an optional string can be passed to add a description to
|
||||
;; the repository
|
||||
(define create (lambda (...)
|
||||
(if (is-repo? #t)
|
||||
(error-exit "A solo repository has already been initialized in this directory"))
|
||||
(mkdir (path-join (pwd) ".solo" "tree" "master") 0755 #t)
|
||||
(conf [
|
||||
["heads" []]
|
||||
["branch" "master"]
|
||||
["tags" []]
|
||||
["description" (if (null? ...) "" (car ...))]
|
||||
["author" (user@host)]
|
||||
["version" solo-version]
|
||||
["remote" #f]])
|
||||
(mkdir (path-join (pwd) ".solo" "tags") 0755 #t)))
|
||||
|
||||
;; `revert` undoes any changes since the last commit
|
||||
;; but does not remove new files (it will add back deleted
|
||||
;; files)
|
||||
(define revert (lambda ()
|
||||
(is-repo? #f)
|
||||
(define c (conf))
|
||||
(if (and
|
||||
(positive? (length (assoc c "heads")))
|
||||
(zero? (length (filter
|
||||
(lambda (i)
|
||||
(not (equal? (car i) ".")))
|
||||
(files-changed "snap" devnull (assoc (assoc c "heads") (assoc c "branch")))))))
|
||||
(error-exit "There is nothing to revert"))
|
||||
(branch #f #f (assoc c "branch"))))
|
||||
|
||||
;; `diff` outputs the changes between each file between the current work
|
||||
;; tree and HEAD
|
||||
(define diff (lambda ()
|
||||
(is-repo? #f)
|
||||
(define c (conf))
|
||||
(files-changed "diff" stdout (assoc (assoc c "heads") (assoc c "branch")))))
|
||||
|
||||
;; `combine` merges the given branch's HEAD into the current working area
|
||||
;; returns the number of issues/conflicts encountered while combining
|
||||
(define combine (lambda (branch)
|
||||
(is-repo? #f)
|
||||
(define merge-dummy (path-join (pwd) ".solo" "merge-dummy"))
|
||||
(define c (conf))
|
||||
(define head-id (assoc (assoc c "heads") branch))
|
||||
(define head-data-path (path-join (pwd) ".solo" "tree" branch head-id "data"))
|
||||
(define files (path-glob (path-join head-data-path "**")))
|
||||
(if (not (path-exists? head-data-path))
|
||||
(error-exit (append "The branch " branch " does not exist")))
|
||||
|
||||
; Make sure the merge dummy exists
|
||||
(close (file-create merge-dummy))
|
||||
|
||||
; Remove directories, they will be added if need be
|
||||
(set! files
|
||||
(filter
|
||||
(lambda (p)
|
||||
(not (path-is-dir? p)))
|
||||
files))
|
||||
|
||||
; Make the file list be relative
|
||||
(set! files
|
||||
(map
|
||||
(lambda (p)
|
||||
(string-replace p (append head-data-path "/") ""))
|
||||
files))
|
||||
|
||||
(define issue-count 0)
|
||||
|
||||
; Merge each
|
||||
(for-each
|
||||
(lambda (p)
|
||||
(if (not (path-exists? (path-dir (path-join (pwd) p))))
|
||||
(mkdir (path-dir (path-join (pwd) p)) 0755 #t))
|
||||
|
||||
(define shared
|
||||
(find-common-snap
|
||||
[
|
||||
["branch" (assoc c "branch")]
|
||||
["id" (assoc (assoc c "heads") (assoc c "branch"))]
|
||||
["path" p]]
|
||||
[
|
||||
["branch" branch]
|
||||
["id" (assoc (assoc c "heads") branch)]
|
||||
["path" p]]))
|
||||
(define old-path (path-join (pwd) "tree" (assoc shared "branch") (assoc shared "snap") "data" p))
|
||||
(if (not (path-exists? old-path))
|
||||
(set! old-path merge-dummy))
|
||||
|
||||
; Copy the file or diff3 merge it
|
||||
(if (path-exists? (path-join (pwd) p))
|
||||
(begin
|
||||
(define out (string-make-buf))
|
||||
(define res
|
||||
(subprocess
|
||||
[
|
||||
"diff3"
|
||||
"-m"
|
||||
"-E"
|
||||
"--label=base-branch"
|
||||
"--label=common-ancestor"
|
||||
"--label=incoming-branch"
|
||||
(path-join (pwd) p)
|
||||
old-path
|
||||
(path-join head-data-path p)]
|
||||
out
|
||||
out))
|
||||
(case res
|
||||
(0
|
||||
(close (write (read-all out) (file-create (path-join (pwd) p)))))
|
||||
(1
|
||||
(begin
|
||||
(set! issue-count (+ 1 issue-count))
|
||||
(display "\033[1mConflict\033[0m: " p "\n")
|
||||
(close (write (read-all out) (file-create (path-join (pwd) p))))))
|
||||
(2
|
||||
(begin
|
||||
(set! issue-count (+ 1 issue-count))
|
||||
(display "\033[1mMerge Error\033[0m: " p "\n"))))
|
||||
(cp (path-join head-data-path p) (path-join (pwd) p)))))
|
||||
files)
|
||||
issue-count))
|
||||
|
||||
;; `url` displays or sets the remote url that hosts the
|
||||
;; repository
|
||||
(define url (lambda (...)
|
||||
(is-repo? #f)
|
||||
(define c (conf))
|
||||
(if (null? ...)
|
||||
(display (if (assoc c "remote") (assoc c "remote") "N/A") "\n")
|
||||
(conf (assoc c "remote" (car ...))))))
|
||||
|
||||
;; `status` displays the current branch and any files that have
|
||||
;; changed in the cwd since HEAD
|
||||
(define status (lambda ()
|
||||
(is-repo? #f)
|
||||
(define c (conf))
|
||||
(if (null? (assoc c "heads"))
|
||||
(error-exit "There are no snapshots available. Create one with `solo snap [message]`"))
|
||||
(define out (files-changed "status" devnull (assoc (assoc c "heads") (assoc c "branch"))))
|
||||
(display "Currently on branch: " (assoc c "branch") "\n\n")
|
||||
(apply display-lines
|
||||
(map
|
||||
(lambda (p) (append "\033[32m Added: \033[0m" (car (cdr p))))
|
||||
(filter (lambda (p) (equal? (car p) "+")) out)))
|
||||
(apply display-lines
|
||||
(map
|
||||
(lambda (p) (append "\033[31mDeleted: \033[0m" (car (cdr p))))
|
||||
(filter (lambda (p) (equal? (car p) "-")) out)))
|
||||
(apply display-lines
|
||||
(map
|
||||
(lambda (p) (append "\033[33mChanged: \033[0m" (car (cdr p))))
|
||||
(filter (lambda (p) (equal? (car p) "~")) out)))
|
||||
(if (zero? (length (filter (lambda (p) (not (equal? (car p) "."))) out)))
|
||||
(write "There are no uncommitted changes\n" stderr))))
|
||||
|
||||
;; `branch` creates or views branches
|
||||
(define branch (lambda (delete? new? ...)
|
||||
(is-repo? #f)
|
||||
(define c (conf))
|
||||
(cond
|
||||
; Errors
|
||||
((and delete? new?) (error-branch "Cannot both delete and create a branch at the same time"))
|
||||
((and new? (null? ...))
|
||||
(error-branch "No branch name was given for branch creation"))
|
||||
((and delete? (null? ...))
|
||||
(error-branch "No branch name was given for branch deletion"))
|
||||
|
||||
; Display branches
|
||||
((null? ...)
|
||||
(begin
|
||||
(apply display-lines
|
||||
(map
|
||||
(lambda (h)
|
||||
(append (if (equal? (car h) (assoc c "branch")) "-> " " ") (car h) ))
|
||||
(list-sort (assoc c "heads"))))
|
||||
(exit 0)))
|
||||
|
||||
; Deletion error - active branch
|
||||
((and delete? (equal? (car ...) (assoc c "branch")))
|
||||
(error-exit "Cannot delete the active branch, switch to another branch and try again"))
|
||||
|
||||
; Deletion error - branch does not exist
|
||||
((and delete?
|
||||
(not (member? (map (lambda (x) (car x)) (assoc c "heads")) (car ...))))
|
||||
(error-exit "A branch that does not exist cannot be deleted"))
|
||||
|
||||
; New error - branch already exists
|
||||
((and new?
|
||||
(member? (map (lambda (x) (path-base x)) (path-glob ".solo/tree/*")) (car ...)))
|
||||
(error-exit "There is already a history for this branch in the tree, choose another name"))
|
||||
|
||||
; Delete the given branch
|
||||
(delete?
|
||||
(conf
|
||||
(assoc c "heads"
|
||||
(filter
|
||||
(lambda (x) (not (equal? (car x) (car ...))))
|
||||
(assoc c "heads")))))
|
||||
|
||||
; Create a new branch
|
||||
(new?
|
||||
(snap (append "Branch init from '" (assoc c "branch") "'") (car ...)))
|
||||
|
||||
; Move to an existing branch/tag
|
||||
(else
|
||||
(cond
|
||||
; The name given is a branch
|
||||
((member? (map (lambda (x) (car x)) (assoc c "heads")) (car ...))
|
||||
(begin
|
||||
(activate-commit
|
||||
(car
|
||||
(filter
|
||||
(lambda (x) (equal? (car ...) (car x)))
|
||||
(assoc c "heads"))))
|
||||
(conf (assoc c "branch" (car ...)))))
|
||||
; The name given is a tag
|
||||
((member? (assoc c "tags") (car ...))
|
||||
(begin
|
||||
(define t (read-tag (car ...)))
|
||||
(activate-commit
|
||||
(car t)
|
||||
(car (cdr t)))
|
||||
(conf (assoc c "branch" (car t)))))
|
||||
(else (error-exit (append "Unknown branch or tag " (car ...)))))))))
|
||||
|
||||
;; `tag` adds a tag for the currently checked out branch/commit
|
||||
(define tag (lambda (name msg ...)
|
||||
(is-repo? #f)
|
||||
(define c (conf))
|
||||
(if (member? (assoc c "tags") name)
|
||||
(error-exit "A tag already exists with the given name"))
|
||||
(define branch (assoc c "branch"))
|
||||
(define commit (assoc (assoc c "heads") (assoc c "branch")))
|
||||
(if (not (null? ...))
|
||||
(begin
|
||||
(set! branch (car ...))
|
||||
(set! commit (car (cdr ...)))
|
||||
(if (not (path-exists? (path-join (pwd) ".solo" "tree" branch commit)))
|
||||
(error-exit (append "The requested branch/commit do not exist")))))
|
||||
(define f (file-create (path-join ".solo" "tags" name)))
|
||||
(if f
|
||||
(close
|
||||
(write
|
||||
[
|
||||
branch
|
||||
commit
|
||||
msg]
|
||||
f))
|
||||
(error-exit "Could not open tag file for writing"))
|
||||
(conf (assoc c "tags" (append (assoc c "tags") name)))))
|
||||
|
||||
;; `list-tags` prints a list of the current tags
|
||||
(define list-tags (lambda ()
|
||||
(is-repo? #f)
|
||||
(define c (conf))
|
||||
(apply display-lines (assoc c "tags"))))
|
||||
|
||||
;; `snap` creates a snapshot for the given working directory
|
||||
;; in the work tree. It maps it to the parent branch/commit
|
||||
(define snap (lambda (msg new-branch?)
|
||||
(is-repo? #f)
|
||||
(define config (conf))
|
||||
(if (and
|
||||
(positive? (length (assoc config "heads")))
|
||||
(zero? (length (filter
|
||||
(lambda (i)
|
||||
(not (equal? (car i) ".")))
|
||||
(files-changed "snap" devnull (assoc (assoc config "heads") (assoc config "branch")))))))
|
||||
(if (not new-branch?)
|
||||
(error-exit "There are no changes to take a snapshot of")))
|
||||
(define meta [
|
||||
["message" msg]
|
||||
["user" (user@host)]
|
||||
["time" (date)]])
|
||||
(set! meta
|
||||
(assoc meta "id"
|
||||
(string->md5
|
||||
(append
|
||||
(assoc meta "time")
|
||||
(assoc meta "user")
|
||||
(assoc meta "message")))))
|
||||
(set! meta (assoc meta "parent-branch" (assoc config "branch")))
|
||||
(set! meta (assoc meta "parent-commit"
|
||||
(if (has-key? (assoc config "heads") (assoc config "branch"))
|
||||
(assoc (assoc config "heads") (assoc config "branch"))
|
||||
"")))
|
||||
(define folder
|
||||
(path-join ".solo" "tree"
|
||||
(if new-branch?
|
||||
new-branch?
|
||||
(assoc config "branch"))
|
||||
(assoc meta "id")))
|
||||
(mkdir (path-join folder "data") 0755 #t)
|
||||
(close (write meta (file-create (path-join folder "meta"))))
|
||||
(for-each
|
||||
(lambda (fp)
|
||||
(cp fp (string-replace fp (append (pwd) "/") (append (path-join folder "data") "/"))))
|
||||
(cwd-paths))
|
||||
(if new-branch?
|
||||
(set! config (assoc config "branch" new-branch?)))
|
||||
(set! config (assoc config "heads" (assoc (assoc config "heads") (assoc config "branch") (assoc meta "id"))))
|
||||
(conf config)))
|
||||
|
||||
;; `pick` selects a file or files to move from a given commit
|
||||
;; and branch into the current workspace
|
||||
(define pick (lambda (branch commit ...)
|
||||
(is-repo? #f)
|
||||
(if (null? ...) (exit))
|
||||
(define c (conf))
|
||||
|
||||
(define commit-path (path-abs (path-join ".solo" "tree" branch commit "data")))
|
||||
(if (not (path-exists? (path-abs commit-path)))
|
||||
(error-exit "The given branch/commit pair do not exist"))
|
||||
|
||||
(for-each
|
||||
(lambda (p)
|
||||
(set! p (string-replace p (append (pwd) "/") "" 1))
|
||||
(if (path-exists? (path-join commit-path p))
|
||||
(cp (path-join commit-path p) (path-join (pwd) p))
|
||||
(write (append "Could not find: " p "\n") stderr)))
|
||||
...)))
|
||||
|
||||
|
||||
;; `history` provides history output starting at the
|
||||
;; current HEAD
|
||||
(define history (lambda ()
|
||||
(is-repo? #f)
|
||||
(define buf (string-make-buf))
|
||||
(define c (conf))
|
||||
|
||||
(define loop (lambda (buffer branch id head?)
|
||||
(define p (path-join (pwd) ".solo" "tree" branch id "meta"))
|
||||
(define data (if (path-exists? p) (open-read-close p) p))
|
||||
(if data (set! data (eval data #t)))
|
||||
|
||||
(define panic-mode? (exception-mode-panic?))
|
||||
|
||||
(if (pair? data)
|
||||
(begin
|
||||
(if panic-mode? (exception-mode-pass))
|
||||
(write (append id " [" branch "]"(if head? " \033[1m<--HEAD\033[0m" "")"\n") buf)
|
||||
(write (append "Author: " (assoc data "user") "\n") buf)
|
||||
(write (append "Date : " (assoc data "time") "\n") buf)
|
||||
(write (append (assoc data "message") "\n") buf)
|
||||
(write ".\n" buf)))
|
||||
|
||||
(if (~bool (assoc data "parent-commit"))
|
||||
(begin0
|
||||
(loop buffer (assoc data "parent-branch") (assoc data "parent-commit") #f)
|
||||
(if panic-mode? (exception-mode-panic)))
|
||||
(if panic-mode? (exception-mode-panic)))))
|
||||
|
||||
(loop buf (assoc c "branch") (assoc (assoc c "heads") (assoc c "branch")) #t)
|
||||
|
||||
(define tmpfile (file-create-temp "solo-log-*"))
|
||||
(if tmpfile
|
||||
(begin
|
||||
(write (read-all buf) tmpfile)
|
||||
(close tmpfile)
|
||||
(subprocess ["less" "-FXR" (file-name tmpfile)]))
|
||||
(write (read-all buf) stdout))))
|
||||
|
||||
|
||||
;; `help` prints the help information
|
||||
(define help (lambda (...)
|
||||
(display
|
||||
"\033[7msolo vcs" (list->string solo-version ".") "\033[0m\n\n")
|
||||
(if (null? ...)
|
||||
(begin
|
||||
(display-lines
|
||||
"Available help topics (\033[3msolo help [topic]\033[0m):\n"
|
||||
"branch" "create" "diff" "help"
|
||||
"revert" "snap" "status" "tag" "url" "version" "")
|
||||
(exit)))
|
||||
(case (car ...)
|
||||
("branch"
|
||||
(display
|
||||
"\033[1mbranch\033[0m"
|
||||
"\n\n Displays the available branches and indicates the current branch\n\n"
|
||||
"\033[1mbranch [name]\033[0m"
|
||||
"\n\n Switches the current work tree will to the HEAD of the given branch name\n\n"
|
||||
"\033[1mbranch [-n|--new] [name]\033[0m"
|
||||
"\n\n Creates a new branch with the given name based on the current work tree, and switches to that branch\n\n"
|
||||
"\033[1mbranch [-d|--delete] [name]\033[0m"
|
||||
"\n\n Deletes the branch with the given name (it will cease to be an available branch, but its snap history will remain)\n"))
|
||||
("create"
|
||||
(display
|
||||
"\033[1mcreate [[description]]\033[0m"
|
||||
"\n\n Creates a new solo project for the current directory with an optional description of the repository\n"))
|
||||
("diff"
|
||||
(display
|
||||
"\033[1mdiff\033[0m"
|
||||
"\n\n Displays the changes within files between HEAD and the current work tree\n"))
|
||||
("help"
|
||||
(display
|
||||
"\033[1mhelp [[topic]]\033[0m"
|
||||
"\n\n Displays helpful information about the given topic. Can be run with no topic for a list of available topics\n"))
|
||||
("history"
|
||||
(display
|
||||
"\033[1mhistory\033[0m"
|
||||
"\n\n Displays the commit history starting at HEAD. Will attempt to display the history using $PAGER, displaying on stdout if $PAGER is not available\n"))
|
||||
("pick"
|
||||
(display
|
||||
"\033[1mpick [branch] [snap] [file(s)...]\033[0m"
|
||||
"\n\n Moves the given files from the given branch/commit into the current work tree, clobbering any existing files with the same name(s)\n"))
|
||||
("revert"
|
||||
(display
|
||||
"\033[1mrevert\033[0m"
|
||||
"\n\n Discards any unsnapped changes in the current work tree\n"))
|
||||
("snap"
|
||||
(display
|
||||
"\033[1msnap [message]\033[0m"
|
||||
"\n\n Takes a snapshot of the current working directory with the given message (required)\n"))
|
||||
("status"
|
||||
(display
|
||||
"\033[1mstatus\033[0m"
|
||||
"\n\n Displays the current branch and any changed files since the last snap\n"))
|
||||
("tag"
|
||||
(display
|
||||
"\033[1mtag\033[0m"
|
||||
"\n\n Displays the available tags\n\n"
|
||||
"\033[1mtag [name] [message]\033[0m"
|
||||
"\n\n Creates a new tag with the given name and description/message, associated with the current branch/HEAD\n\n"
|
||||
"\033[1mtag [name] [message] [branch] [snap]\033[0m"
|
||||
"\n\n Creates a new tag with the given name and description/message, associated with the given branch and snap\n"))
|
||||
("url"
|
||||
(display
|
||||
"\033[1murl\033[0m"
|
||||
"\n\n Displays the current remote URL (if any)\n\n"
|
||||
"\033[1murl [URL]\033[0m"
|
||||
"\n\n Sets/updates the remote URL\n\n"))
|
||||
("version"
|
||||
(display
|
||||
"\033[1mversion\033[0m"
|
||||
"\n\n Displays the solo version\n"))
|
||||
("else" (error-exit (append "There is no helpful information for " (car ...)))))))
|
||||
|
||||
;; `conf` writes and reads to the solo.conf file inside of the .solo directory
|
||||
;; If nothing is passed it will read the existing file. If data is passed, it will be
|
||||
;; written to the file and clobber the old data
|
||||
(define conf (lambda (...)
|
||||
(define sf-path (path-join (pwd) ".solo" "solo.conf"))
|
||||
(if (null? ...)
|
||||
(begin
|
||||
(define data (open-read-close sf-path))
|
||||
(if data
|
||||
(eval data #t)
|
||||
(error-exit "Could not read solo configuration file. Are you in the repo root? Is the file corrupt?")))
|
||||
(begin
|
||||
(define sf (file-create sf-path))
|
||||
(if sf
|
||||
(close (write (car ...) sf))
|
||||
(error-exit "Error writing solo configuration"))))))
|
||||
|
||||
;; `error-exit` prints 'msg' to stderr and exits with a
|
||||
;; non-zero exit code
|
||||
(define error-exit (lambda (msg)
|
||||
(write (append "" msg "\n") stderr)
|
||||
(exit 1)))
|
||||
|
||||
;; `open-read-close` opens a file, reads all of the data,
|
||||
;; closes the file, and returns the data
|
||||
(define open-read-close (lambda (path)
|
||||
(define f (file-open-read path))
|
||||
(if f
|
||||
(begin0
|
||||
(read-all f)
|
||||
(close f))
|
||||
#f)))
|
||||
|
||||
;; 'activate-commit' moves files from the tree or tags
|
||||
;; to the working directory. It does not check for
|
||||
;; branch/tag name errors or id errors, nor for a solo
|
||||
;; repo root. That should be done by the caller or above.
|
||||
;; It also does not check for pending changes
|
||||
(define activate-commit (lambda (data)
|
||||
(define data-dir (path-join ".solo" "tree" (car data) (car (cdr data)) "data"))
|
||||
(define file-list
|
||||
(filter
|
||||
(lambda (x) (not (equal? x (append data-dir "/"))))
|
||||
(path-glob (path-join data-dir "**"))))
|
||||
|
||||
(for-each
|
||||
(lambda (fp)
|
||||
(cp
|
||||
fp
|
||||
(string-replace fp data-dir (pwd))))
|
||||
file-list)))
|
||||
|
||||
;; `read-tag` opens a tag file and reads the contents
|
||||
(define read-tag (lambda (tag)
|
||||
(eval (open-read-close (path-join ".solo" "tags" tag)) #t)))
|
||||
|
||||
;; `is-repo?` checks whether or not the current directory is
|
||||
;; the root of a solo repo. If 'return?' is #t then a bool will
|
||||
;; be returned. If 'return?' is #f an exception will be raised
|
||||
;; if the directory is not a repo root
|
||||
(define is-repo? (lambda (return?)
|
||||
(define solo-root (path-join (pwd) ".solo"))
|
||||
(if (path-exists? solo-root)
|
||||
(if
|
||||
(and (path-exists? (path-join solo-root "solo.conf"))
|
||||
(path-exists? (path-join solo-root "tree" "master")))
|
||||
#t
|
||||
(if return?
|
||||
#f
|
||||
(error-exit "The current directory is set up as a solo repository root, but is corrupt")))
|
||||
(if return?
|
||||
#f
|
||||
(error-exit "The current directory is not a solo repository root")))))
|
||||
|
||||
;; `user@host` returns a string with the user and hostname
|
||||
(define user@host (lambda ()
|
||||
(define b (string-make-buf))
|
||||
(if (not (zero? (subprocess ["id" "-u" "n"] b devnull)))
|
||||
(begin
|
||||
(string-buf-clear b)
|
||||
(write (env "USER") b)))
|
||||
(write "@" b)
|
||||
(write (hostname) b)
|
||||
(read-all b)))
|
||||
|
||||
;; `solo-version` is a verion list (maj, min, patch) for the current
|
||||
;; version of solo
|
||||
(define solo-version [0 2 0])
|
||||
|
||||
;; `files-changed` creates a list of all of the files between
|
||||
;; two snaps and defines them as added, changed, removed, or unchanged
|
||||
(define files-changed (lambda (caller out-io ...)
|
||||
(define path-one #f)
|
||||
(define path-two (pwd))
|
||||
(define compare-vs-cwd? #t)
|
||||
(define branch (assoc (conf) "branch"))
|
||||
(case (length ...)
|
||||
(0 (error-exit (string-format "'%v' expects a commit to compare against" caller)))
|
||||
(1 (set! path-one (path-join (pwd) ".solo" "tree" branch (car ...) "data")))
|
||||
(else (begin
|
||||
(set! compare-vs-cwd? #f)
|
||||
(set! path-one (path-join (pwd) ".solo" "tree" branch (car ...) "data"))
|
||||
(set! path-two (path-join (pwd) ".solo" "tree" branch (car (cdr ...)) "data")))))
|
||||
|
||||
(define list-one (filter
|
||||
(lambda (p) (not (equal? p (append path-one "/"))))
|
||||
(map
|
||||
(lambda (p)
|
||||
(slice p (+ (length path-one) 1)))
|
||||
(path-glob (path-join path-one "**")))))
|
||||
(define list-two
|
||||
(filter
|
||||
(lambda (p)
|
||||
(and
|
||||
(not (equal? p (append path-two "/")))
|
||||
(if compare-vs-cwd?
|
||||
(and
|
||||
(not (zero?
|
||||
(string-index-of p ".solo")))
|
||||
(not (zero?
|
||||
(string-index-of p ".git"))))
|
||||
#t)))
|
||||
(map
|
||||
(lambda (p)
|
||||
(slice p (+ (length path-two) 1)))
|
||||
(path-glob (path-join path-two "**")))))
|
||||
|
||||
(define out (map
|
||||
(lambda (p)
|
||||
(cond
|
||||
((path-is-dir? p) ["." p])
|
||||
((not (member? list-one p)) ["+" p])
|
||||
(else (case (do-diff (path-join path-one p) (path-join path-two p) out-io)
|
||||
(0 ["." p])
|
||||
(1 ["~" p])
|
||||
(2 ["-" p])))))
|
||||
list-two))
|
||||
(for-each
|
||||
(lambda (p)
|
||||
(if (and (not (member? list-two p)) (not (equal? "" (string-trim-space p))))
|
||||
(set! out (append out ["-" p]))))
|
||||
list-one)
|
||||
out))
|
||||
|
||||
(define do-diff (lambda (file-one file-two io-out)
|
||||
(subprocess ["diff" "-u" "-b" "-B" "--color=always" file-one file-two] io-out devnull)))
|
||||
|
||||
;; `has-key?` checks for the presence of the given key
|
||||
;; if a non-assoc value is passed as 'a' #f will be returned
|
||||
(define has-key? (lambda (a k)
|
||||
(if (assoc? a)
|
||||
(positive? (length (filter (lambda (i) (equal? k (car i))) a)))
|
||||
#f)))
|
||||
|
||||
;; `find-common-snap` takes two associative arrays representing files
|
||||
;; contiaining the keys: 'branch', 'id', and 'path'. It outputs an assoc
|
||||
;; contining 'branch' and 'id' of the common ancestor
|
||||
(define find-common-snap (lambda (one two)
|
||||
(define list-one
|
||||
(get-history (assoc one "branch") (assoc one "id")))
|
||||
(define list-two
|
||||
(get-history (assoc two "branch") (assoc two "id")))
|
||||
(define loop (lambda (l1 l2)
|
||||
(cond
|
||||
((member? l1 (car l2))
|
||||
(car l1))
|
||||
((null? (cdr l2))
|
||||
#f)
|
||||
(else
|
||||
(loop l1 (cdr l2))))))
|
||||
(loop list-one list-two)))
|
||||
|
||||
;; `history` provides history output starting at the
|
||||
;; current HEAD
|
||||
(define get-history (lambda (branch snap)
|
||||
(define out [])
|
||||
(define loop (lambda (b s)
|
||||
(define p (path-join (pwd) ".solo" "tree" b s "meta"))
|
||||
(define data (if (path-exists? p) (open-read-close p) p))
|
||||
(if data (set! data (eval data #t)))
|
||||
(define panic-mode? (exception-mode-panic?))
|
||||
(set! out (append out [["branch" b] ["snap" s]]))
|
||||
|
||||
(if (~bool (assoc data "parent-commit"))
|
||||
(begin0
|
||||
(loop (assoc data "parent-branch") (assoc data "parent-commit"))
|
||||
(if panic-mode? (exception-mode-panic)))
|
||||
(if panic-mode? (exception-mode-panic)))))
|
||||
|
||||
(loop branch snap)
|
||||
out))
|
||||
|
||||
|
||||
;; `get-history` builds a list of associative lists containing the
|
||||
;; keys: 'branch' and 'id'. In order of most recent to furthest back
|
||||
; (define get-history (lambda (branch id path)
|
||||
; (define loop (lambda (branch id b-id-list)
|
||||
; (define meta-path (path-join (pwd) ".solo" "tree" branch id "meta"))
|
||||
; (define data
|
||||
; (if (path-exists? meta-path) (open-read-close meta-path) #f))
|
||||
; (if data (set! data (eval data #t)))
|
||||
; (define panic-mode? (exception-mode-panic?))
|
||||
; (if (~bool (assoc data "parent-commit"))
|
||||
; (begin0
|
||||
; (loop (assoc data "parent-branch") (assoc data "parent-commit") (cons [["branch" branch]["id" id]] b-id-list))
|
||||
; (if panic-mode? (exception-mode-panic)))
|
||||
; (begin0
|
||||
; b-id-list
|
||||
; (if panic-mode? (exception-mode-panic))))))
|
||||
;
|
||||
; (loop branch id [])))
|
||||
|
||||
;; `cp` copies a file from one path to another
|
||||
(define cp (lambda (from to)
|
||||
(if (path-is-dir? from)
|
||||
(mkdir (path-abs to) 0775 #t)
|
||||
(begin
|
||||
(define in (file-open-read from))
|
||||
(define out (file-create to))
|
||||
(if (and in out (not (assoc (file-stat from) "is-dir?")))
|
||||
(begin
|
||||
(write (read-all in) out)
|
||||
(close in)
|
||||
(close out)
|
||||
(chmod to (assoc (file-stat from) "mode"))))))))
|
||||
|
||||
;; `cwd-paths` builds a list of paths in the cwd
|
||||
;; it excludes the .solo directory and excludes any
|
||||
;; .git directory that might be present
|
||||
(define cwd-paths (lambda ()
|
||||
(filter
|
||||
(lambda (f)
|
||||
(and
|
||||
(not (equal? f (pwd)))
|
||||
(negative? (string-index-of f "/.solo"))
|
||||
(negative? (string-index-of f "/.git"))
|
||||
(not (equal? f (append (pwd) "/")))))
|
||||
(map path-abs (path-glob (path-join (pwd) "**"))))))
|
||||
|
||||
;; `main` is the router/entry point to the program
|
||||
(define main (lambda ()
|
||||
(set! sys-args (cdr sys-args))
|
||||
(if
|
||||
(or
|
||||
(null? sys-args)
|
||||
(and (equal? (car sys-args) "help") (null? (cdr sys-args)))
|
||||
(member? sys-args "-h")
|
||||
(member? sys-args "--help"))
|
||||
(help))
|
||||
(case (car sys-args)
|
||||
("create"
|
||||
(if (null? (cdr sys-args))
|
||||
(create)
|
||||
(create (car (cdr sys-args)))))
|
||||
("snap"
|
||||
(if (null? (cdr sys-args))
|
||||
(error-exit "A snapshot message is required")
|
||||
(snap (car (cdr sys-args)) #f)))
|
||||
("status" (if (null? (cdr sys-args)) (status) (error-exit "Unknown arguments to 'solo status'")))
|
||||
("branch" (begin
|
||||
(define new? (or (member? sys-args "-n") (member? sys-args "--new")))
|
||||
(define delete? (or (member? sys-args "-d") (member? sys-args "--delete")))
|
||||
(apply
|
||||
branch
|
||||
(list-join
|
||||
[delete? new?]
|
||||
(filter
|
||||
(lambda (x)
|
||||
(not (equal? "-" (ref x 0))))
|
||||
(cdr sys-args))))))
|
||||
("revert" (revert))
|
||||
("help" (help (car (cdr sys-args))))
|
||||
("tag" (case (length (cdr sys-args))
|
||||
(0 (list-tags))
|
||||
(2 (tag (ref sys-args 1) (ref sys-args 2)))
|
||||
(4 (apply tag (cdr sys-args)))
|
||||
(else
|
||||
(error-exit
|
||||
(append
|
||||
"\033[1mInvalid tag format\033[0m\n\n"
|
||||
" List tags:\n\tsolo tag\n"
|
||||
" Tag HEAD:\n\tsolo tag [tag-name] [description]\n"
|
||||
"Tag a snap:\n\tsolo tag [tag-name] [description] [branch] [snap]")))))
|
||||
("history" (history))
|
||||
("diff" (diff))
|
||||
("url"
|
||||
(if (null? (cdr sys-args))
|
||||
(url)
|
||||
(url (car sys-args))))
|
||||
("pick"
|
||||
(if (< (length (cdr sys-args)) 3)
|
||||
(error-exit "'pick' requires a branch, a commit, and at least one file")
|
||||
(apply pick (cdr sys-args))))
|
||||
("combine"
|
||||
(if (null? (cdr sys-args))
|
||||
(error-exit "A branch name is required for merging")
|
||||
(combine (car (cdr sys-args)))))
|
||||
("sync" (display "Coming soon...")) ; A combined pull/push
|
||||
(else (write (append "Unknown command: " (car sys-args) "\n") stderr)))))
|
||||
|
||||
(main)
|
16
solo.1
Normal file
16
solo.1
Normal file
@ -0,0 +1,16 @@
|
||||
.TH "solo" 1 "04 OCT 2022" "" "General Operation Manual"
|
||||
.SH NAME
|
||||
\fBsolo\fP - version control for solo developers
|
||||
.SH SYNOPSIS
|
||||
.nf
|
||||
.fam C
|
||||
\fBsolo\fP [\fIoptions\fP] [\fIcommand\fP] [[\fIargs...\fP]]
|
||||
.fam T
|
||||
.fi
|
||||
.SH DESCRIPTION
|
||||
\fBsolo\fP is a version control system oriented toward single users that work alone but still want to share their code with others. \fBsolo\fP can automatically generate a website for a given repository, securely push code to a remote location (via scp), create snapshots and branches, view project history and create release tags.
|
||||
.SH COMMANDS
|
||||
.TP
|
||||
.B
|
||||
\fBthing\fP
|
||||
stuff
|
Loading…
Reference in New Issue
Block a user