;; This is a _very_ preliminary implementation of
;; a 'plain' bibliography style.
;;
;; Usage:
;;
;;     (module "plain.scm")
;;     ...
;;     (assemble-bibliography refs bibfiles)
;;
;; This script exports a single function, for use by other ones of the
;; example scripts.  It's currently aimed at generating HTML
;; bibliographies (and uses the CITATION? structure, which can be
;; queried using a CITATION-HTML function, both defined in module
;; 'bibtex.  This has therefore ended up quite specific to HTML
;; output, and so is ripe for some significant reorganisation.
;;
;; The exported function is
;;
;;    assemble-bibliography : (listof symbol?) (listof string?)
;;      -> (listof citation?)
;;
;; The first argument of ASSEMBLE-BIBLIOGRAPHY is a list of citation
;; keys, as symbols, the second is a list of strings indicating .bib
;; files.  We parse the bib files, and produce a list of CITATION? objects,
;; where (CITATION-KEY c) is the citation key/symbol of object C,
;; CITATION-REFERENCE returns a string such as "Gray 1999",
;; and CITATION-HTML an xexpr `(li ...)` which contains the
;; reference entry.
;;
;; This uses functions from beastie 0.14; it may not work with other versions.
;;
;; This file is part of Beastie <https://purl.org/nxg/dist/beastie>
;; SPDX-FileCopyrightText: 2024 Norman Gray <https://nxg.me.uk>
;; SPDX-License-Identifier: BSD-2-Clause

(module 'bibtex 'authors 'unicode 'bst 'subtex)

(define max-authors 3)

(define (format-authorlist* fmt1 fmtrest al)
  (if (null? al)
      "[no author]"
      (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."
                        (ustring-join (cons alf1 (take alfrest (- max-authors 1))) ", ")))
              ((eqv? (list-ref al (- (length al) 1)) 'others)
               (sprintf "~a et al."
                        (ustring-join (cons alf1 (drop-right alfrest 1)) ", ")))
              (else
               (sprintf "~a and ~a"
                        (ustring-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))

;; format authors for the citation -- author-year
(define (format-authorlist/ref authorlist)
  (format-authorlist* '((last)) '((last)) authorlist))

(for-each (λ (p)
            (bib-string-table-set! (car p) (cdr p)))
          '(("jan" . "January")
            ("feb" . "February")
            ("mar" . "March")
            ("apr" . "April")
            ("may" . "May")
            ("jun" . "June")
            ("jul" . "July")
            ("aug" . "August")
            ("sep" . "September")
            ("oct" . "October")
            ("nov" . "November")
            ("dec" . "December")))

;; helper functions
(define extract-doi*
  (let ((%doi% (regexp "^(https?://(dx\\.)?doi\\.org/)?(10.*)")))
    (λ (doi)
      (cond ((not doi) #f)
            ((ustring? doi) (extract-doi* (ustring->string doi :display)))
            ((not (string? doi))
             (error 'wrong-type-arg
                    "extract-doi*: works on string? or ustring?, not ~s"
                    doi))
            ((regexp-match %doi% doi) => cadddr)
            (else #f)))))

(define (format-doi doi)
  (cond ((not doi) '())
        ((extract-doi* doi)
         => (λ (bare-doi)
              `(span "DOI" nbsp
                     (a ((href ,(string-append "https://doi.org/" bare-doi)))
                        ,bare-doi))))
        (else
         (print-warning "Malformed DOI URL? ~a" doi)
         '())))
(define (format-url url)
  (maybe-list/qq span "URL" nbsp (a ((href ,url)) (code ,url))))

;; Consider suppressing URL if DOI exists?  Configurable?
(define* (format-links doi url (prefer-doi? #f))
  (let ((span-doi (format-doi doi))
        (span-url (format-url url)))
    ;; we could be cleverer with the following test, within
    ;; (sentence ...), but it would be hard to read
    (if (and (truthy span-doi) prefer-doi?)
        (sentence ,span-doi)
        (sentence ,span-doi
                  ,(and doi url ", ")
                  ,span-url))))

;; Each of the format-entry-foo functions takes an entry and evaluates to a
;; citation? object.

(define (author-year authorlist month year)
  (sprintf "~a (~a)"
           (if authorlist
               (format-authorlist/ref authorlist)
               "[no author]")
           (or (maybe-sprintf "~a ~a" month year)
               year
               "n.d.")))

(define (format-entry-article e)
  (with-fields-from-entry e
      (author title journal year)
      (volume month number pages doi note url)
    (let ((al (parse-author-list author)))
      (make-citation
       e
       (author-year al month year)
       (untexify-string-or-list
        `(li ,@(sentence
                (a ((name ,(symbol->string (entry-key e))))
                   ,(format-authorlist/text al))
                ,(sprintf " (~a), " year)
                "‘" ,(titlecase-string/bst title) "’, "
                (em ,journal)
                ,(or (maybe-sprintf " (~a)" number) ", ")
                ,(maybe-list 'strong (stringify/true volume) ", ")
                                        ;alternatively ,@(maybe-list `(strong ,(stringify/true volume)))
                ,@(maybe-list/qq " pp." nbsp ,(en-dashify pages)))
             ,@(format-links doi url)
             ,@(sentence ,note)))))))

(define (format-entry-misc e)
  (with-fields-from-entry e
      ()
      (author title howpublished month year doi url note)
      (let ((al (and author
                     (parse-author-list author))))
      (make-citation
       e
       (author-year al month year)
       (untexify-string-or-list
        `(li ,@(sentence
                (a ((name ,(symbol->string (entry-key e))))
                   ,(if author
                        (format-authorlist/text al)
                        "[no authors]"))
                ": "
                ,@(maybe-list/qq " ‘" ,(titlecase-string/bst title) "’")
                ,(or (maybe-sprintf " (~a ~a)" month year)
                     (maybe-sprintf " (~a)" year)
                     " (n.d.)"))
             ,@(format-links doi url)
             ,@(sentence ,note)))))))

(define (format-entry-book e)
  (with-fields-from-entry e
      (title publisher year)
      (author editor isbn doi url note month)
    (let ((al (parse-author-list (or author editor))))
      (make-citation
       e
       (author-year al month year)
       (untexify-string-or-list
        `(li ,@(sentence
                (a ((name ,(symbol->string (entry-key e))))
                   ,(format-authorlist/text al))
                ,(sprintf " (~a), ‘" year)
                ,(titlecase-string/bst title) "’, "
                ,publisher
                ,@(maybe-list/qq ", ISBN" nbsp ,isbn))
             ,@(format-links doi url)
             ,@(sentence ,note)))))))

(define (format-entry-techreport e)
  (with-fields-from-entry e
      (author title institution year)
      (type number address month note doi url)
    (let ((al (parse-author-list author)))
      (make-citation
       e
       (author-year al month year)
       (untexify-string-or-list
        `(li ,@(sentence
                (a ((name ,(symbol->string (entry-key e))))
                   ,(format-authorlist/text al))
                ,(maybe-sprintf " (~a)" year)
                ,(maybe-sprintf " ~a" institution)
                ,(or (maybe-sprintf ", ~a no.~a" type number)
                     (maybe-sprintf ", ~a" type))
                ", ‘" ,(titlecase-string/bst title) "’")
             ,@(format-links doi url)
             ,@(sentence ,note)))))))

(define (format-entry-default e)
  (with-fields-from-entry e
      ()
      (author month year note doi url)
    (let ((al (parse-author-list author)))
      (make-citation
       e
       (author-year al month year)
       (untexify-string-or-list
        `(li ,@(sentence
                (a ((name ,(symbol->string (entry-key e))))
                   (em ,(or (maybe-sprintf "~a" (entry-field e 'author))
                            "[No author]")
                       ,(sprintf " (~a)" (entry-type e))))
                ,@(maybe-list ": " (entry-field e 'title)))
             ,@(format-links doi url)
             ,@(sentence ,note)))))))

;; turn an entry into bibliographic information:
;; (entry? -> citation?)
(define (entry->bibliography e)
  (case (entry-type e)
    ((article) (format-entry-article e))
    ((techreport) (format-entry-techreport e))
    ((misc) (format-entry-misc e))
    ((book) (format-entry-book e))
    (else (format-entry-default e))))

;; Given a list of citation keys (or 'all), and a list of .bib files, parse the
;; BibTeX files and produce (listof citation?)
(define/provide (assemble-bibliography citations/list bibdatas)
  (define (authors->sortable author-list)
    (ustring->string
     (apply ustring-append
            (map (λ (a)
                   (format-name '((last "-") (first/i)) a))
                 author-list))))

  (define (entry<? a b)
    (let ((year/a (stringify (entry-field a 'year)))
          (year/b (stringify (entry-field b 'year))))
      (if (string=? year/a year/b)
          (let ((author/a (cond ((entry-field a 'author)
                                 => (λ (aut)
                                      (authors->sortable (parse-author-list aut))))
                                (else "")))
                (author/b (cond ((entry-field b 'author)
                                 => (λ (aut)
                                      (authors->sortable (parse-author-list aut))))
                                (else ""))))
            (string<? author/a author/b))
          (string<? year/a year/b))))

  ;; The following is a dummy DOI extraction, to avoid a crash.  There
  ;; appears to be a bug in Apple's libc regexec (reported; seen in
  ;; 26.5.2) which results in this DOI regexp causing a crash after
  ;; the sixth successive successful match, _unless_ there's also been an
  ;; unsuccessful match.  So leave this here until I have some
  ;; evidence this has been fixed on this platform.
  (extract-doi* "foo")

  (unless (or (list? citations/list)
              (eqv? citations/list 'all))
    (beastie-error "assemble-bibliography: unexpected citation list (should be list or 'all)"))
  (unless (list? bibdatas)
    (beastie-error "assemble-bibliography: bibdatas argument must be a list, not ~s" bibdatas))

  (let ((citations (if (eqv? citations/list 'all)
                       #f
                       (make-set/eqv citations/list)))
        (bib
         (map cdr
              (apply append
                     (map (λ (f)
                            ;; expand control sequences in notes,
                            ;; as well as default '(author editor title)
                            ;(parse-bibtex-file f '(author editor title note))
                            (parse-bibtex-file f))
                          bibdatas)))))
    (map entry->bibliography
         (sort!
          (if citations
              (filter (lambda (e)
                        (citations (entry-key e)))
                      bib)
              bib)
          entry<?))))