(module gnu-elpa-git-to-db ()

(import scheme)
(import (chicken base))
(import (chicken format))
(import (chicken irregex))
(import (chicken port))
(import (chicken process-context))
(import (chicken string))
(import (chicken time posix))
(import (srfi 1))
(import scsh-process)
(import sql-de-lite)

(define stderr (current-error-port))

;;; time

(define time/seconds 0)
(define time/minutes 1)
(define time/hours 2)

(define duration/day (* 24 60 60))

(define (adjust-date date amount)
  (seconds->utc-time (+ (utc-time->seconds date) amount)))

(define (copy-date date)
  (adjust-date date 0))

(define (adjust-date-to-end-of-day! date)
  (vector-set! date time/seconds 59)
  (vector-set! date time/minutes 59)
  (vector-set! date time/hours 23))

(define (time->git-string date) (time->string date "%Y-%m-%d %H:%M:%S %z"))

(define (time->date-string date) (time->string date "%Y-%m-%d"))
(define (date-string->time string) (string->time string "%Y-%m-%d"))

(define (make-comparator comp key)
  (lambda (a b) (comp (key a) (key b))))

(define date>=? (make-comparator string>=? time->date-string))
(define date>? (make-comparator string>? time->date-string))

;;; git

(define (repo-file-at repo-path commit file)
  (run/string (git -C ,repo-path show ,(format "~a:~a" commit file))))

(define (repo-rev-list repo-path from to path)
  (let ((from-arg (format "--after=~a" (time->git-string from)))
        (to-arg (format "--before=~a" (time->git-string to))))
    (map (lambda (line)
           (let ((parts (string-split line)))
             (cons (seconds->utc-time (string->number (car parts)))
                   (cadr parts))))
         (run/strings (git -C ,repo-path rev-list "--pretty=format:%ct %H"
                           --first-parent ,from-arg ,to-arg
                           --no-commit-header @ -- ,path)))))

(define (repo-rev-list-loop proc repo-path from to path)
  (let loop ((date (copy-date to))
             (revs (repo-rev-list repo-path from to path)))
    (adjust-date-to-end-of-day! date)
    (let ((revs (find-tail (lambda (rev) (date>=? date (car rev))) revs)))
      (when revs
        (proc date (car revs))
        (when (date>? date from)
          (loop (adjust-date date (- duration/day)) revs))))))

;;; stats

(define archive "gnu")

(define (pkglist-count archive-contents)
  (length (call-with-input-string archive-contents read)))

(define (archive-count-for db date-label)
  (query fetch-value
         (sql db "SELECT package_count
                    FROM archive_counts
                   WHERE archive = ? AND date = ?")
         archive date-label))

(define (insert-archive-count! db date-label count)
  (exec (sql db "INSERT INTO archive_counts(archive, date, package_count)
                 VALUES(?, ?, ?)")
        archive date-label count))

(define main
  (case-lambda
   ((repo-path db-path)
    (call-with-database db-path
      (lambda (db)
        ;; now-20201218: recipes are stored as one sexp in elpa-packages
        (with-transaction db
          (lambda ()
            (let ((path "elpa-packages")
                  (from (date-string->time "2020-12-18"))
                  (to (seconds->utc-time)))
              (repo-rev-list-loop
               (lambda (date rev)
                 (let ((date-label (time->date-string date))
                       (commit (cdr rev)))
                   (when (not (archive-count-for db date-label))
                     (let* ((contents (repo-file-at repo-path commit path))
                            (count (pkglist-count contents)))
                       (insert-archive-count! db date-label count)
                       (printf "~a ~a: ~a\n" date-label archive count)))))
               repo-path from to path))
            'commit)))))
   (_
    (fprintf stderr "usage: ~a <elpa.git> <db>\n" (program-name))
    (exit 1))))

(apply main (command-line-arguments))

)