Megatest

(use yaml matchable srfi-1 sqlite3 regex)

(define (get-timeline)
  (let* ((inp (open-input-pipe "fossil json timeline checkin -n 0"))
	 (res (yaml-load inp)))
    (close-input-pipe inp)
    res))

		'("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 (escape-string-for-bash str)
  (string-substitute "'" "''" str #t))

;; tag0 tag1 tag2 cherrypick backout hide usedate recomment user
;; comment timestamp timestamp_sec
;;
(define (get-node-details db node-id)
  (let* ((result #f)
	 (count  0))
    (for-each-row

			 (tag0       . ,tag0)
			 (cherrypick . ,cherrypick)
			 (do-commit  . ,do-commit)
			 (usedate    . ,usedate)
			 (comment    . ,comment)
			 (recomment  . ,recomment))
		       res)))
     db ;; sort desc and the cons puts it back in correct order
     "SELECT rowkey,tag0,cherrypick,do_commit,usedate,comment,recomment FROM timeline WHERE cherrypick != '' AND cherrypick NOT NULL ORDER BY timestamp_sec DESC;")
    res))

;; always private and same time as parent node + 1 second
;;
;; fossil branch new BRANCH-NAME BASIS ?OPTIONS?
;; 
;;        Create a new branch BRANCH-NAME off of check-in BASIS.

	       (parent-user (alist-ref 'user      parent-info)))
	  (print "fossil branch new " branch-name " " parent-node " --private --date-override '" parent-date "'")
	  ;; (print "Creating private branch " branch-name " from node " parent-node)
	  ;; (pp parent-info)
	  ;; (print "")
	  ))))

(define (do-cherrypick db cherrypick dbfname)
  (let* ((tag0    (alist-ref 'tag0 cherrypick))
	 (uuid    (alist-ref 'uuid cherrypick))
	 (nodeinf (get-node-details db uuid))
	 (nodedate (alist-ref 'timestamp nodeinf))
	 (user     (alist-ref 'user      nodeinf))
	 (targ    (alist-ref 'cherrypick cherrypick)) ;; do fossil up to this node
	 (do-commit  (alist-ref 'do-commit     cherrypick)) ;; if yes do a commit
	 (usedate (alist-ref 'usedate    cherrypick)) ;; if no use current time
	 (comment (alist-ref 'comment    cherrypick))
	 (recomment (alist-ref 'recomment cherrypick)))
    (print "#======= Start of cherrypick for " uuid "=======")
    (print "fossil up " targ)
    (print "fossil merge --cherrypick " uuid)
    (if #t ;;(member do-commit '("x" "yes"))
	(print "fossil commit -m '" (escape-string-for-bash comment) "' "
	       (if (equal? usedate "no")
		   ""
		   (conc " --date-override '" nodedate "'"))
	       " --user-override " user
	       " --private"))
    (print "if [[ $(fossil status | grep CONFLICT | wc -l) -gt 0 ]];then")
    (print "  echo HAVE CONFLICT - STOPPING")
    (print "  exit 1")
    (print "else")
    (print "  echo GOOD, marking node " uuid " as DONE")
    (print "  refdb set " dbfname " timeline " uuid " status DONE")
    (print "fi")
    (print "#======= end of cherrypick for " uuid "=======")
    (print "")
    ))
		   
;; 
(define (gen-rebase-commands dbname)
  (let* ((sqldbname (conc "/tmp/" (current-user-name) "-" dbname ".db"))
	 (dbfname   (conc (current-directory) "/" dbname))) ;; want the fully qualified path so we can call the generated script from anywhere
    (print "Create sqlite db " sqldbname "...")
    (system (conc "refdb dump2sqlite3 " dbname " " sqldbname))
    (let* ((db (open-database sqldbname))
	   (branches (get-new-branches db))
	   (cherrypicks (get-cherry-picks db)))
      ;; create the branches
      (for-each
       (lambda (branchdat)
	 (create-branch db
			(alist-ref 'branch branchdat)
			(alist-ref 'node   branchdat)))
       branches)

      ;; create the cherrypicks
      (for-each
       (lambda (cherrypick)
	 (do-cherrypick db cherrypick dbfname))
       cherrypicks)
      )))

(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!!