slope-lang/solo
1
0
Fork 0
Code Issues Releases Activity

Vastly updated program options, started adding makefile and man page (unfinished)

Browse Source
This commit is contained in:
sloum 2022-10-04 14:45:28 -07:00
parent c97fac3c52
commit c1a6156a2c
6 changed files with 853 additions and 1113 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
Makefile Normal file
View 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
View File

@ -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
View File

@ -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
View File

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

1151
solo
View File

File diff suppressed because it is too large Load Diff

16
solo.1 Normal file
View 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