;; Convert a .bib file into a SQL database.
;;
;; An alternative route to this is via [bibclean](http://www.math.utah.edu/pub/bibclean/)
;; and [bibtosql](http://www.math.utah.edu/pub/bibsql/).  That almost
;; works, but the post-processing required is slightly different from
;; this version.  Another minor advantage of doing this this way is
;; that we don't require any tools other than BibTeX.
;;
;; This works with beastie v0.6.
;; The functions it uses may change with later versions.
;;
;; This file is part of Beastie <https://purl.org/nxg/dist/beastie>
;; SPDX-FileCopyrightText: 2023 Norman Gray <https://nxg.me.uk>
;; SPDX-License-Identifier: BSD-2-Clause

(module 'bibtex 'authors)

(unless (= (length *command-line*) 2)
  (eprintf "Convert a .bib file into .sql~%~%Usage:~%    beastie ~a database.bib~%~%Respects the value of $BIBINPUTS~%"
           (car *command-line*))
  (eprintf )
  (exit 1))

(define *bibtex-database*
  ;; resolve-file throws an error if it can't find a file
  (resolve-file (cadr *command-line*) ".bib"))

(define max-authors 6)

(define (lookup-month m)
  (case m
    ((jan) "January")
    ((feb) "February")
    ((mar) "March")
    ((apr) "April")
    ((may) "May")
    ((jun) "June")
    ((jul) "July")
    ((aug) "August")
    ((sep) "September")
    ((oct) "October")
    ((nov) "November")
    ((dec) "December")
    (else (and m (stringify m)))))

(define fields '(author
                 editor
                 booktitle
                 title
                 crossref
                 chapter
                 journal
                 volume
                 type
                 number
                 institution
                 organization
                 publisher
                 school
                 address
                 edition
                 pages
                 day
                 month
                 monthnumber
                 year
                 coden
                 doi
                 isbn
                 isbn13
                 issn
                 issnl
                 lccn
                 mrclass
                 mrnumber
                 mrreviewer
                 bibdate
                 bibsource
                 bibtimestamp
                 note
                 series
                 url
                 abstract
                 fjournal
                 keywords
                 language
                 remark
                 subject
                 toc
                 zmnumber
                 acknowledgement
                 advisor
                 affiliation
                 affiliationaddress
                 ajournal
                 annote
                 authordates
                 bookdoi
                 bookurl
                 bookpages
                 classcodes
                 corpsource
                 editordates
                 eprint
                 howpublished
                 journalurl
                 journalabr
                 key
                 onlinedate
                 reviewer
                 subjectdates
                 thesaurus
                 treatment
                 zmclass
                 issue
                 rawabstract
                 rawauthor
                 rawbooktitle
                 raweditor
                 rawnote
                 rawtitle
                 shorttoc
                 rawshorttoc
                 rawtoc
                 orcid
                 adsurl))
(define fields/set (make-set/eqv fields))

(define schema
  (apply string-append
         `(#"""DROP TABLE IF EXISTS bibtab;
           CREATE TABLE bibtab (
               label        TEXT PRIMARY KEY,
               authorcount  INTEGER,
               editorcount  INTEGER,
               pagecount    INTEGER,
               bibtype      TEXT,
               filename     TEXT"""
           ,@(map (lambda (fieldname)
                    (sprintf ",~%  ~a  TEXT" fieldname))
                  fields)
           #""");
           DROP TABLE IF EXISTS authors;
           CREATE TABLE authors (
             givenname TEXT,
             surname TEXT,
             ref  TEXT,
             num  INTEGER,
             UNIQUE (ref, num));""")))

(define (format-authorlist* fmt1 fmtrest al)
  (let ((alf1 (format-name fmt1 (car al)))
        (alfrest (map (lambda (a)
                        (format-name fmtrest a))
                      (if (> (length al) max-authors)
                          (take (cdr al) max-authors)
                          (cdr al)))))
    (cond ((null? alfrest) alf1)
          ((> (length al) max-authors)
           (sprintf "~a et al."
                    (string-join (cons alf1 (take alfrest (- max-authors 1))) ", ")))
          ((eqv? (list-ref al (- (length al) 1)) 'others)
           (sprintf "~a et al."
                    (string-join (cons alf1 (drop-right alfrest 1)) ", ")))
          (else
           (sprintf "~a and ~a"
                    (string-join (cons alf1 (drop-right alfrest 1)) ", ")
                    (list-ref alfrest (- (length alfrest) 1)))))))

;; format authors for the bibliography
(define (format-authorlist/text authorlist)
  (format-authorlist* '((von "~") (last) (", " first))
                      '((first " ") (von "~") (last))
                      authorlist))

(define (entry->sql e)
  (let ((key (entry-key e))
        (type (entry-type e))
        (fields
         (let loop ((ff (entry-fields e))
                    (res '()))
           (cond ((null? ff) res)
                 ((eqv? (caar ff) 'author) (loop (cdr ff) res))
                 ((fields/set (caar ff)) (loop (cdr ff) (cons (car ff) res)))
                 (else
                  (print-warning "Unfamiliar field in ~s (ignored)" (car ff))
                  (loop (cdr ff) res)))))
        (authorstring (entry-field e 'author)))
    (if authorstring
        (let ((authors (parse-author-list authorstring)))
          (printf "INSERT INFO bibtab (label,bibtype,~a) VALUES ('~a','~a',~a);~%"
                  (string-join
                   (map (lambda (kv)
                          (symbol->string (car kv)))
                        fields)
                   ",")
                  key type
                  (string-join
                   (map (lambda (kv)
                          (sprintf "'~a'" (cdr kv)))
                        fields)
                   ","))
          (let loop ((aa authors)
                     (n 1))
            (unless (null? aa)
              (printf "INSERT INTO authors (ref,givenname,surname,num) VALUES ('~a','~a','~a',~a);~%"
                      key (author-first (car aa)) (author-last (car aa)) n)
              (loop (cdr aa) (+ n 1))))
          (printf "UPDATE bibtab SET authorcount = ~a WHERE label='~a';~%"
                 (length authors) key)
          (printf "UPDATE bibtab SET author = '~a' WHERE label='~a';~%~%"
                  (format-authorlist/text authors) key))
        (print-warning "No author for entry ~a" key))))

(printf "~a~%BEGIN TRANSACTION;~%" schema)
(for-each entry->sql (parse-bibtex-file *bibtex-database*))
(printf "~%END TRANSACTION;~%")