;; Copyright (c) 2000-2001 Thien-Thi Nguyen
;; This program is released under GNU GPL v2.

;; usage: guile -s go.scm
(define file-write-stamp "time-stamp: <2001-08-14 19:03:50 ttn>")

(debug-enable 'debug 'backtrace)
;(set! %load-verbosely #t)

(set! %load-path (cons "/home/ttn/build/guile-projects" %load-path))

(use-modules (proj-list db)
             (proj-list db-meta)
             (proj-list spewer))

(define (use-play-db!)
  (let ((actual "/home/ttn/build/guile-projects/DB")
        (play "/home/ttn/build/guile-projects/tmp/PLAY-DB"))
    (and (>                             ; newer
          (stat:mtime (stat actual))
          (or (false-if-exception (stat:mtime (stat play))) 0))
         (copy-file actual play))
    ;; by side effect, sets `*db*' to the entire alist database
    (db-connect play)))

(use-modules (ice-9 common-list)
             (ttn echo)
             (proj-list entry))

;; broken out for web page
(load "/home/ttn/build/guile-projects/tmp/ndb-config.scm")

(define (ndb-display-table-configs)
  (for-each (lambda (mgr)
              (echo "TABLE" (mgr 'table-name))
              (for-each echo (mgr 'defs))
              (echo))
            all-table-managers))

(define (ndb-reset-all-tables!)
  (echo "dropping all tables...")
  (for-each (lambda (mgr) (echo ((mgr 'drop)) mgr))   all-table-managers)
  (echo "creating all tables...")
  (for-each (lambda (mgr) (echo ((mgr 'create)) mgr)) all-table-managers))

(define (canon-marked-up-field ls note-markup)
  (if (not ls)
      '(())
      (let loop ((ls ls) (acc '()))
        (if (null? ls)
            (reverse acc)
            (loop (cdr ls)
                  (let ((elem (car ls)))
                    (cons
                     (cond ((string? elem) (list elem))
                           ((eq? 'url (car elem))
                            (apply note-markup m:url (cdr elem))
                            `("url" ,(cadr elem)))
                           ((eq? 'email (car elem))
                            (note-markup m:email
                                         (list-ref elem 2)
                                         (list-ref elem 1))
                            `("email" ,(list-ref elem 2)))
                           (else (error "bad marked-up field:" ls)))
                     acc)))))))

;; todo: insert specs should be changed from (MGR VALUES ...)
;; to something like: (MGR (COL-NAME VALUE) ...)
(define (alist-db-entry->insert-specs alist-db-entry)
  (let* ((first-elem (lambda (field)
                       (false-if-exception
                        (car (assq-ref alist-db-entry field)))))
         (all-elems (lambda (field)
                      (or (false-if-exception
                           (assq-ref alist-db-entry field))
                          '())))
         (name (first-elem 'name))
         (markups '())
         (canon (lambda (field)
                  (canon-marked-up-field (assq-ref alist-db-entry field)
                                         (lambda (mgr . vals)
                                           (set! markups
                                                 (cons (cons mgr vals)
                                                       markups))))))
         (entry (list                   ; do here for side effects :-/
                 m:entry
                 name
                 (assq-ref alist-db-entry 'gnu)
                 (first-elem 'license)
                 (canon 'location)
                 (canon 'description)
                 (canon 'maintainer)
                 (canon 'status)
                 (canon 'mailing-list)
                 (canon 'authors)
                 (canon 'requires)
                 (first-elem 'password)))
         (category `(,m:category ,(first-elem 'category) ,name))
         (keywords (map (lambda (keyword)
                          `(,m:keyword ,keyword ,name))
                        (all-elems 'keywords))))
    (echo "*" (first-elem 'name))
    `(,entry ,category ,@keywords ,@markups)))

(define (ndb-insert-alist-db-entry! alist-db-entry)
  ;;(for-each echow alist-db-entry)
  (let ((insert-specs (alist-db-entry->insert-specs alist-db-entry)))
    ;;(for-each echow insert-specs)
    (for-each (lambda (insert-spec)
                (apply (lambda (mgr . vals)
                         (echo (procedure-name mgr)
                               (apply (mgr 'insert-values)
;                                (mgr 'insert-col-values)
;                                      (map def:col-name
;                                           (remove-if
;                                            (lambda (def)
;                                              (eq? 'serial
;                                                   (def:type-name def)))
;                                            (mgr 'defs)))
                                      vals)))
                       insert-spec))
              insert-specs))
  (echo))

(define (ndb:insert-all! alist-db)
  (echo "inserting everything!")
  (for-each ndb-insert-alist-db-entry! alist-db))

(define (ndb:display-all)
  (echo "tables in PostgreSQL database `guile_projects':")
  (for-each (lambda (args)
              (apply (lambda (msg mgr sel)
                       (echo)
                       (echo ">>>" msg "<<<")
                       (display-table
                        (tuples-result->table ((mgr 'select) sel))))
                     args))
            `(("entry (name gnu)" ,m:entry (name gnu))
              ("category"         ,m:category "*")
              ("url"              ,m:url "*")
              ("email"            ,m:email "*")
              ("keyword"          ,m:keyword "*")
              )))

(define (main)
  (echo "program written:" file-write-stamp)
  (echo "time now:" (strftime "%Y-%m-%d %H:%M:%S" (localtime (current-time))))
  (ndb-display-table-configs)
  (ndb-reset-all-tables!)
  (use-play-db!)
  (ndb:insert-all! *db*)
  (ndb:display-all)
  )

(exit (main))