(use-modules (guix utils))
(use-modules (guix build utils))
(use-modules (ice-9 binary-ports))
(use-modules (ice-9 match))
(use-modules (srfi srfi-1))
(use-modules (srfi srfi-9))
(use-modules (srfi srfi-71))

(define-record-type <iter-pos>
    (make-iter-pos port name str version eof?)
    iter-pos?
    (port    iter-pos-port)
    (name    iter-pos-name)
    (str     iter-pos-str)
    (version iter-pos-version)
    (eof?    iter-pos-eof?))

(define-values (a-filename b-filename)
  (match (command-line)
    ((self a-file b-file) (values a-file b-file))))

(define (peek-operation port proc)
  (let ((org-pos (ftell port)))
    (call-with-values
      proc	
      (lambda vals
	(seek port org-pos SEEK_SET)
	(apply values vals)))))

(define (peek-rest port)
  (peek-operation port (λ ∅ (get-bytevector-all port))))

(define a-port (open-input-file a-filename))
(define out-port (open-io-file b-filename))
(define b-port (open-bytevector-input-port
		(peek-rest out-port)))

(define (git-commit msg)
  (sync)
  (invoke "git" "commit" "-a" "-m" msg))

(define (git-commit-new-package a)
  (define name (iter-pos-name a))
  (git-commit
   (string-append "gnu: Add " name "\n\n* gnu/packages/" b-filename
		  " (" name "): New varible.")))

(define (git-commit-update-package a)
  (let ((name (iter-pos-name a))
	(version (iter-pos-version a)))
    (git-commit
     (string-append "gnu: " name ": Upgrade to " version "\n\n* gnu/packages/" b-filename
		    " (" name "): Upgrade to " version))))

(define (file-iter port)
  (λ ∅
    (let* ((start (ftell port))
	   (sexp (read port))
	   (end (ftell port))
	   (str (begin
		  (seek port start SEEK_SET)
		  (get-bytevector-n port (- end start))))
	   (name version
		 (match sexp
		   (('define-public name
		      (or
		       ('package ('name _) ('version version) . _)
		       ('let _ ('package ('name _) ('version version) . _))))
		    (values (symbol->string name) version))
		   (_ (values #f #f))))
	   (eof? (eof-object? sexp)))
      (make-iter-pos port name str version eof?))))

(define* (insert-before a b out #:optional replace)
  (let ((a-str (iter-pos-str a))
	(b-str (iter-pos-str b))
	(b-rest (peek-rest
		 (iter-pos-port b))))

    (put-bytevector out-port a-str)
    (peek-operation
     out-port (λ ∅ 
		(unless replace
		  (put-bytevector out-port b-str))
		;; read the rest of port-b
		(put-bytevector out-port b-rest)))))

(define (merge-iter a-iter b-iter out-port)
  (let lp ((a (a-iter))
	   (b (b-iter)))
    (unless (iter-pos-eof? a)
      (let ((a-name (iter-pos-name a))
	    (b-name (iter-pos-name b))
	    (a-str  (iter-pos-str a))
	    (b-str  (iter-pos-str b)))
	(cond
	 ((not b-name)
	  (begin
	    (put-bytevector out-port (iter-pos-str b))
	    (lp a (b-iter))))
	 ((string<? a-name b-name)
	  (begin
	    (insert-before a b out-port)
	    (git-commit-new-package a)
	    (lp (a-iter) b)))
	 ((string>? a-name b-name)
	  (lp a (b-iter)))
	 (#t
	  (begin ;; else the names are equal
	    ;; make sure the action are idenpotent
	    (unless (equal? b-str a-str)
	      (insert-before a b out-port #t)
	      (git-commit-update-package a))
	    (lp (a-iter) (b-iter)))))))))

(merge-iter
 (file-iter a-port) (file-iter b-port) out-port)