(use yaml matchable srfi-1)
(define (get-timeline)
(let* ((inp (open-input-pipe "fossil json timeline checkin -n 0"))
(res (yaml-load inp)))
(close-input-pipe inp)
res))
(define (get-val data key)
(alist-ref key data equal?))
(define (any->string val)
(if (string? val)
val
(conc val)))
(define (branch-match branches tags)
(if (list? tags)
(any (lambda (x)
(member x branches))
tags)
(member tags branches)))
(define (refdb-set-value dbname sheetname row col value)
(let ((pid (process-run "refdb" `("set" ,dbname ,sheetname ,row ,col ,value))))
(let-values (((a b c)(process-wait pid)))
b)))
(define (seconds->std-time-str sec)
(time->string
(seconds->local-time sec)
"%Y-%m-%d %H:%M:%S"))
(define (gen-refdb dbname branches)
(if (not (file-exists? (conc dbname "/sheet-names.cfg")))
(begin
(print "ERROR: You must precreate the refdb with \"refdb edit <dbname>\"")
(exit 1)))
(print "Getting data from timeline...")
(let* ((data (get-timeline))
(branches (string-split branches ",")))
(print "Got data from timeline...")
(let* ((timeline (get-val (get-val data "payload") "timeline")))
(print "Got " (length timeline) " timeline records. Filling refdb...")
(for-each
(lambda (rec)
(let ((uuid (get-val rec "uuid")))
(if (branch-match branches (get-val rec "tags"))
(let ((tagnum 0)
(tags (get-val rec "tags")))
(print "uuid: " uuid " tags: " (get-val rec "tags"))
;; First the tags so they are visible to left
(for-each
(lambda (tagv)
(refdb-set-value dbname "timeline" uuid (conc "tag" tagnum) tagv)
(set! tagnum (+ tagnum 1)))
(if (list? tags)
tags
(list tags)))
(for-each
(lambda (key)
(refdb-set-value dbname "timeline" uuid key (any->string (get-val rec key))))
'("user" "comment"))
(refdb-set-value dbname "extra" uuid "parents" (string-intersperse (get-val rec "parents") ","))
(refdb-set-value dbname "timeline" uuid "timestamp" (seconds->std-time-str (get-val rec "timestamp")))
(refdb-set-value dbname "timeline" uuid "timestamp_sec" (any->string (get-val rec "timestamp")))
))))
timeline))))
(define help
"fossilrebase - register commits in a refdb, edit them by hand then execute them
WARNING: It is highly recommended you do this on a disconnected copy of your fossil database!!
Usage: fossilrebase cmd [params ...]
where cmd is one of:
genrefdb fname b1,b2... : generate a refdb of all the commits for branches matching patterns listed, edit with \"refdb edit fname\"
dumpcmds fname : from refdb fname dump fossil commands to implement the rebase you want to do.
")
(define (main)
(if (< (length (command-line-arguments)) 1)
(begin
(print help)
(exit 1))
(match (command-line-arguments)
(("genrefdb" fname branches) (gen-refdb fname branches))
(("dumpcmds" fname) (dump-cmds))
(else
(print "Sorry, didn't know what to do with \"" (string-intersperse (command-line-arguments) " ") "\"")
(exit 1)))))
(main)