;; Author wrangling.
;;
;; This manages the parsing of both author lists and format strings.
;;
;; 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

(define *requires-implementation-functions*
  '(parse-fmtstring**))

(module 'utils 'klipspringer 'unicode 'subtex*)
(define-macro (%module-verbosity-flag%) 4)

;;;; Author processing
;;
;; This processes authors by manipulating them as bstrings. This means
;; that we naturally respect things being enclosed within braces, at
;; the cost of some equivocation between ustrings and bstrings in this
;; module.  The procedure `parse-author-list/klipspringer` expects a
;; string or ustring, and parsed it into a bstring, and the procedure
;; `format-name` assembles a bstring and then converts it to a ustring
;; for return.
;;
;; It's possible to simplify the contents of this a little, by
;; handling ustrings all the way through (and I did switch to that at
;; one point; see the revision of 2026-07-01), but it ends up with
;; different edge-cases if we want to respect braces.

;; Make an author object: each of the arguments is a list of bstring?
(define-values (make-author author?)
  (let ((*tag* "author"))
    (values
     (λ (first vons surnames juniors)
       (vector *tag* first vons surnames juniors))
     (λ (x)
       #"""`author? : any -> boolean?` : Returns true if this is an author structure?
      An author structure contains a list of first names, surnames, von-particles
      and 'junior' particles, as described in the BibTeX documetnation.

      See `parse-author-list`."""
       (and (vector? x)
            (= (vector-length x) 5)
            (eq? (vector-ref x 0) *tag*))))))

(module-provide author?)

(define (author-first* a)
  "`author-first* : author? -> (listof bstring?)` : Returns the first names of the given author as a list of bstrings."
  (vector-ref a 1))
(define (author-von* a)
  "`author-von* : author? -> (listof bstring?)` : Returns the von-components of the given author, as a list of bstrings."
  (vector-ref a 2))
(define (author-last* a)
  "`author-last* : author? -> (listof bstring?)` : Returns the last names of the given author, as a list of bstrings."
  (vector-ref a 3))
(define (author-junior* a)
  "`author-junior* : author? -> (listof bstring?)` : Returns the 'junior' components of the given author, as a list of bstrings."
  (vector-ref a 4))

(define (to-ustrings* tss)
  (map bstring->ustring tss))
(define/provide (author-first a)
  "`author-first : author? -> (listof ustring?)` : Returns the first names of the given author as a list of ustrings."
  (cond ((not (author? a))
         (error 'wrong-type-arg "author-first: expected author, got ~s" a))
        ((vector-ref a 1) => to-ustrings*)
        (else #f)))
(define/provide (author-von a)
  "`author-von : author? -> (listof ustring?)` : Returns the von-components of the given author, as a list of ustrings."
  (cond ((not (author? a))
         (error 'wrong-type-arg "author-von: expected author, got ~s" a))
        ((vector-ref a 2) => to-ustrings*)
        (else #f)))
(define/provide (author-last a)
  "`author-last : author? -> (listof ustring?)` : Returns the last names of the given author, as a list of ustrings."
  (cond ((not (author? a))
         (error 'wrong-type-arg "author-last: expected author, got ~s" a))
        ((vector-ref a 3) => to-ustrings*)
        (else #f)))
(define/provide (author-junior a)
  "`author-junior : author? -> (listof ustring?)` : Returns the 'junior' components of the given author, as a list of ustrings."
  (cond ((not (author? a))
         (error 'wrong-type-arg "author-junior: expected author, got ~s" a))
        ((vector-ref a 4) => to-ustrings*)
        (else #f)))

(define/provide (author->list a) ; mostly for debugging
  "Show the contents of the author structure, for debugging"
  ;; turn bstrings into strings for readability
  (map (λ (cpt)
         (and cpt
              (map (λ (ts)
                     (ustring->string (bstring->ustring ts #f) :display))
                   cpt)))
       (cdr (vector->list a))))

(define/provide (parse-author-list author-list)
  "`parse-author-list string? -> (listof author?)` : parse a string to a list of `author?` objects"
  (if author-list
                                        ;(parse-author-list** author-list #f)
      (parse-author-list/klipspringer author-list)
      '()))

;; FORMAT-NAME : list? author? -> bstring?
;; Format an author structure for display.
;;
;; NOTE: this is intended to be only rather basic support, right now.
;; The syntax here does not yet support some uf the subtleties
;; mentioned in the btxhak document.
(define/provide (format-name fmt name)
  #"""
`format-name : list? author? -> bstring?` :
Format an author structure for display.

In `(format-name fmt name)`, `name` is an author structure.
`fmt` is a list containing either strings or lists, such as

    '((von nbsp?) (last) (", " junior) (", " first/i) "?")

which corresponds to btxhak

    "{vv~}{ll}{, jj}{, f}?"

Strings 'format' to themselves, symbols format to a list of the
elements of the corresponding name component.

The strings are copied to the output.
The sub-lists contain either strings or symbols.
The elements of the lists are separated by spaces, though this may be
changed by including the keyword `sep` to indicate an alternative
separator, thus `(first :sep ":")` would format a sequence of forenames
as `Name1:Name2:...` if that were useful for some reason.
When 'evaluating' the format sub-lists, the symbols are replaced with
elements of the name, but if the name element is missing, then the
list evaluates to #f, and is omitted from the result.

Note that this format specification permits eg `'((von last))`,
with two format elements in an inner spec.
This isn't countenanced by the .bst spec, and I'm not sure it makes sense.

Beastie respects the presence of ties – the tildes – in format specs,
as described in the `btxhak.pdf` document.  In there, we find that
BibTeX will put in ties ‘if it thinks there’s a need for one’; Beastie
respects that, but sometimes thinks differently.

The behaviour here is intended to closely match that of
bibtex-the-program, while feeling free to make slightly different
choices in certain edge-cases."""

  (cond ((eqv? name 'others) #"et al.")  ;magic 'name', indicating et al
        ((not (author? name))
         (beastie-error "format-name: name must be author?, not ~s" name))
        ((not (list? fmt))
         (beastie-error "format-name: format must be a list, not ~s" fmt))
        (else
         (bstring->ustring
          (apply bstring-append
                 (map (lambda (f)
                        (cond ((string? f) (string->bstring f))
                              ((list? f) (or (format-name-part* f name) ""))
                              (else
                               (beastie-error "format-name: malformed format: ~s" f))))
                      fmt))))))

(define *empty-bstring* (string->bstring ""))
(define *tie-tilde* (string->bstring "~"))
(define *tie-space* (string->bstring " "))
(define *tie-dot-hyphen* (string->bstring ".-"))
(define *tie-dot-tilde* (string->bstring ".~"))
(define *tie-dot-space* (string->bstring ". "))

;; Helper for format-name.
;;
;;   ((list? (or/c string? symbol?)) author? -> ???)
;;
;; NAME-FORMAT is a list of strings or symbols, where the symbols are
;; either first/last/..., which refer to elements of the name, or the
;; symbols nbsp/nbsp?, which refer to a mandatory or optional tie (and
;; which should appear only at the end).
(define (format-name-part* name-format name)

  (define (add-needed-ties bstrings tie no-tie)
    ;; (listof bstring?) -> (listof bstring?)
    (define (short-string-in-part? ts)   ;our definition of a 'short' string
      (< (bstring-length ts) 3)
      #;(and (< (length s) 3)
           (not (any char-space? (string->list s)))))

    ;; Add ties between alternate 'short' strings.
    ;; This is rather heuristic, but should broadly match the
    ;; BibTeX algorithm (without obsessing about it)
    (let loop ((cpts (cdr bstrings))
               (odd? #t)
               (res (list (car bstrings))))
      (cond ((null? cpts) (reverse! res))
            ((and (short-string-in-part? (car cpts))
                  (or odd? (null? (cdr cpts))))
             (loop (cdr cpts)
                   (not odd?)
                   `(,(car cpts) ,tie . ,res)))
            (else
             (loop (cdr cpts)
                   (not odd?)
                   `(,(car cpts) ,no-tie . ,res))))))

  (define (get-initials ss/false)
    ;; (listof bstring?) -> (listof bstring?)
    ;;
    ;; Get the name component as a set of initials.
    ;; We respect hyphenated names, so "Jean-Paul" turns into "J.-P"
    ;; (as btxdoc demands).
    ;;
    ;; Note that the inclusion of this hyphen is insensitive to the
    ;; inter-token separator.  It turns out that bibtex puts a
    ;; non-default separator in here, too, so that `{f{.}}` turns
    ;; ‘Jean-Paul Sartre’ into `J.P`, which, losing the hyphen, is
    ;; surely wrong.  So I'm not going to follow BibTeX there.
    ;; Should I completely ignore a non-default separator here, or perhaps
    ;; re-insert the hyphen (so for example `{f{x}}` would produce `Jx-P`)?
    ;;
    ;; The only text covering this in btxdoc is Sect.2.1, item 5,
    ;; which _illustrates_ this by saying ‘and if you’re using the
    ;; abbrv style [which uses "{f.~}{vv}{ll}"], then the result is
    ;; “J.-P. Sartre”’, but doesn't say what's supposed to happen if
    ;; you're using a different f-format.
    ;;
    ;; The relevant test-case in test-authorlist.scm checks that this
    ;; produces my version.
    (and ss/false
         (map (λ (s)
                (let ((names (bstring-tokenize s
                                            (λ (c)
                                              (not (= c #x2d))))))
                  ;; names is a list of ustrings
                  ;; which is one item long for all unhyphenated names
                  (if (= (length names) 1)
                      (bstring-create (bstring-car s))
                      (bstring-join (map (λ (i)
                                           (bstring-create (bstring-car i)))
                                         names)
                                    *tie-dot-hyphen*))))
              ss/false)))

  (define (expand-fmt name-part-symbol forced-sep)
    ;; name-part-symbol is first, first/i, etc.
    ;; If this component is present in the name,
    ;; then return a bstring ready for output;
    ;; if not, then return #f
    ;;
    ;; Procedures author-first* (etc) produce a list of names.
    ;; The names in this list are joined with suitable strings,
    ;; including non-breaking or ordinary spaces as appropriate.
    ;; If forced-sep is non-#f, however, then this is used to join them instead.
    (let ((cpt+sep
           (case name-part-symbol
             ((first)	(cons (author-first* name)			'nbsp?))
             ((first/i)	(cons (get-initials (author-first* name))	'dot-nbsp?))
             ((von)	(cons (author-von* name) 			'nbsp?))
             ((von/i)	(cons (get-initials (author-von* name))		'dot-nbsp?))
             ((last)	(cons (author-last* name)			'nbsp?))
             ((last/i)	(cons (get-initials (author-last* name))		'dot-nbsp?))
             ((junior)	(cons (author-junior* name)			'nbsp?))
             ((junior/i) (cons (get-initials (author-junior* name))	'dot-nbsp?))
             (else
              (print-warning "garbled format: unexpected selector ~s" name-part-symbol)
              #f))))
      (and (car cpt+sep)
           (cond (forced-sep (bstring-join (car cpt+sep) forced-sep))
                 ((eqv? (cdr cpt+sep) 'nbsp?)
                  (apply bstring-append
                         (add-needed-ties (car cpt+sep) *tie-tilde* *tie-space*)))
                 ((eqv? (cdr cpt+sep) 'dot-nbsp?)
                  (apply bstring-append
                         (add-needed-ties (car cpt+sep) *tie-dot-tilde* *tie-dot-space*)))
                 (else                  ; shouldn't be possible
                  (beastie-error "very unexpected item in author format list: ~s" cpt+sep))))))

  (define (append-for-output l)
    ;; l is a list of bstrings, 'nbsp and 'nbsp?
    ;; concatenate these, turning 'nbsp into "~",
    ;; non-final 'nbsp? into "~",
    ;; and final 'nbsp? into "~" or " " depending on how many characters precede it
    ;; (or &nbsp; character?)
    (if (null? l)                       ;trivial case
        ""
        (let loop ((cpts l)
                   (res '())
                   (reslen 0))
          (cond ((null? cpts)           ;finish
                 (apply bstring-append (reverse! res)))
                ((null? (cdr cpts))     ;1-item list: last item around
                 (case (car cpts)
                   ((nbsp)  (loop '() (cons *tie-tilde* res) 0))
                   ((nbsp?) (loop '()
                                  (cons (if (> reslen 3)
                                            *tie-space*
                                            *tie-tilde*)
                                        res)
                                  0))
                   (else    (loop '() (cons (car cpts) res) 0))))
                ((symbol? (car cpts))  ; the symbol is 'nbsp or 'nbsp?
                 (loop (cdr cpts) (cons *tie-tilde* res) (+ reslen 1)))
                (else
                 (loop (cdr cpts)
                       (cons (car cpts) res)
                       (+ reslen
                          (bstring-length (car cpts)))))))))

  (define (extract-sep fmt)
    ;; find any :sep "foo" in the list,
    ;; and the rest of the list, and that sep or false, as multiple values
    (let ((sep-bit (memq :sep fmt)))    ;sublist starting (:sep ...)
      (cond ((not sep-bit)              ;nothing to do
             (values fmt #f))
            ((null? (cdr sep-bit))      ;ooops
             (beastie-error "format-name: :sep provided without argument"))
            (else
             (values (append (take fmt (- (length fmt) (length sep-bit)))
                             (cddr sep-bit))
                     (string->bstring (cadr sep-bit)))))))

  (receive (name-format-bare sep)
      (extract-sep name-format)
    (let ((for-output
           (map (λ (item)
                  (cond ((symbol? item)
                         (case item
                           ((nbsp nbsp?) item)
                           (else (expand-fmt item sep)))) ;-> string? or #f
                        ((string? item)
                         (string->bstring item))
                        (else
                         (beastie-error "unexpected item in author format list: ~s" item))))
                name-format-bare)))
      (if (every values for-output)
          (append-for-output for-output)
          *empty-bstring*))))

;; PARSE-FMTSTRING : string? format-spec
;;
;; The input string is that described in the BibTeX btxhak document.
;; The format-spec is suitable for FORMAT-NAME.
;; This calls parse-fmtstring**, which is what calls the actual parser,
;; but the return from that needs to be conditioned in ways it seems
;; complicated to capture in a yacc parser.
;;
;; Specifically, we want to flatten all sublists of strings into just
;; strings, _unless_ the last item in the list is a list containing
;; a string, which we take to be the separator argument.
;;
;; This is primarily to service functions in bst.scm, but it is
;; defined here (a) because the parse-fmtstring** is defined in core.c,
;; and (b) because it might turn out that the BibTeX style syntax is a
;; nicer way of creating format-strings than the one that format-name
;; expects.
;;
;; Note that the btxhak document is ambiguous about whether the
;; brace-level-2 item is the last item in the spec or the first one
;; after a fvlj token.  The text suggests the latter, but the former
;; also makes sense.
(define/provide (parse-fmtstring s)
  #"""`parse-fmtstring : (or/c string? ustring?) -> list` :
Parse a BibTeX-style name-formatting string.

The input string is that described in the BibTeX btxhak document.
The format-spec is suitable for `format-name`.

This is primarily to service functions in bst.scm, but it is
defined here because it might turn out that the BibTeX style syntax is a
nicer way of creating format-strings than the one that format-name
expects.

Note that the btxhak document is ambiguous about whether the
brace-level-2 item is the last item in the spec or the first one
after a `fvlj` token.  The text suggests the latter, but the former
also makes sense."""

  ;; parse-fmtstring** is currently written to work on strings, but
  ;; it's convenient to allow both string? and ustring? here

  (or (parse-fmtstring**
       (cond ((string? s) s)
             ((ustring? s) (ustring->string s :display))
             (else
              (error 'wrong-type-arg "parse-fmtstring: requires string? or ustring? argument"))))
      ;; If we fail here, then we've already printed a warning
      ;; (in parse-fmtstring.y), but return a default value:
      ;; '((first)(von)(last)(", " junior))
      '((first) (von) (last) (", " junior))))

;;;; parsing author lists

(define-macro (define/description p desc def)
  `(begin
     (define ,p ,def)
     (set-parser-description! ,p ,desc)))

#;(define/description $ustring
  "ustring"
  (satisfy ustring?))

(define/description $bstring
  "bstring"
  (satisfy bstring?))

(define/description $comma
  "comma"
  (parser-seq (~ $wordbreak)
              (char #\,)
              (~ $wordbreak)))

(define/description $and
  "\"and\""
  (parser-seq (~ $wordbreak)
              (string "and")
              (~ $wordbreak1)))

(define/description $others
  "\"others\""
  (parser-seq (~ $wordbreak)
              (string "others")
              (~ (<or> $wordbreak1 $eof))))

;; Test if we are looking at something which matches pred?.
;;
;; First apply pred? directly (x is likely to be a codepoint integer).
;; If that fails, and x is a bstring, then examine bstring-car instead.
(define (starts-with? x pred?)
  (or (pred? x)
      (and (bstring? x)
           (pred? (bstring-car x)))))

;; any character which is not a wordbreak character
(define wordchar
  (satisfy/char
   (λ (c)
     (not (or (char-wordbreak? c)
              (and (char? c) (char=? c #\,))
              (and (integer? c) (= c #x2c))))))) ;comma

(define nbsp-flag
  (satisfy (λ (x) (eqv? x 'nbsp))))

;; Here and in lcname below, the $ustring is because the lexeme string
;; is that produced by ustring-iterator/braces, below in
;; parse-author-list/klipspringer.  The ustrings in question will
;; represent material within braces, and will include those braces
;; (thus (starts-with? ... char-upper?) will always be false).
(define/description capname
  "capname"
  (parser-seq (~ $wordbreak)
              (satisfy (λ (x)
                         (starts-with? x char-upper?)))
              (many (<or> wordchar
                               nbsp-flag
                          $bstring))
              :combine-with (λ (initial-cap other-chars)
                              (apply bstring-create
                                     (cons initial-cap other-chars)))))

(define/description lcname
  "lcname"
  (<!> (<or> $and $others $comma)
       (parser-seq (~ $wordbreak)
                   (satisfy (λ (x)
                              (not (starts-with? x char-upper?))))
                   (many (<or> wordchar
                               nbsp-flag
                               $bstring))
                   :combine-with (λ (initial-char other-chars)
                                   (apply bstring-create
                                          (cons initial-char other-chars))))))

(define capnames1 (many1 capname))
(define capnames0 (many capname))
(define lcnames1 (many1 lcname))

(define/description author-name-component
  "author-component"
  ;; returns ((first1 ...) [ ((von1 ...) . (last1 ...)) ... ])
  ;; (car result) is non-null
  (parser-seq capnames1
              (many (parser-seq lcnames1 capnames0 :combine-with cons))
              :combine-with cons))

;; we need two cases here, combined with <or> below, because
;; the parser seems to get itself into a loop if we simply replace
;; capnames1 with capnames0 above
(define/description author-name-component-von
  "author-component/von"
  ;; returns (() ((von1 ...) . (last1 ...)) ... )
  ;; (cdr result) and (cadr result) are both non-null
  (>>= (many1 (parser-seq lcnames1 capnames0 :combine-with cons))
       (λ (von+lasts)
         ;(eprintf "von+lasts=~s~%" von+lasts)
         (return (cons '() von+lasts)))))

;; Given vl of the form (((von ...) . (last ...)) ...)
;; the vons list is (caar vl),
;; and the lasts part is everything else.
;;
;; In the simple case where vl is of length 1,
;; the vons are (caar vl) and the lasts (cdar vl);
;; otherwise the lasts include all of the
;; subsequent ((von) . (last))... .
;; Yes, the first branch of this 'if' is redundant,
;; but the intricacy of the second does my head in.
(define (lasts-from-combined-vons* vl)
  (if (= (length vl) 1)
      (cdar vl)
      (append (cdar vl)
              (flatten (cdr vl)))))

(define/description one-author-name
  "one-author"
  (>>= (sepBy1 (<or> author-name-component
                     author-name-component-von)
               $comma)
       (λ (authors)
         ;(eprintf "authors=~s~%" authors)
         (return
          (case (length authors)
            ((1)
             (let ((ff (caar authors))  ;list of first names
                   (vl (cdar authors))) ;list of ((von1 ...) . (last1 ...)) ...
               (cond ((null? vl)        ;eg, "Joe Bloggs"
                      (receive (firsts last)
                          (split-at ff (- (length ff) 1))
                        ;(eprintf "firsts=~s  last=~s~%" firsts last)
                        (make-author (if (null? firsts)
                                         #f
                                         firsts)
                                     #f
                                     last
                                     #f)))
                     ((and (null? ff)
                           (= (length vl) 1)
                           (null? (cdar vl)))
                      ;; rather special case: name is "modest" or "bell hooks",
                      ;; no first names or last names,
                      ;; but with a von-part
                      (let ((vons (caar vl)))
                        (if (= (length vons) 1)
                            (make-author #f #f vons #f)
                            (receive (firsts last)
                                (split-at vons (- (length vons) 1))
                              (make-author firsts #f last #f)))))
                     (else
                      ;; In the simple case where vl is of length 1,
                      ;; the vons are (caar vl) and the lasts (cdar vl);
                      ;; otherwise the lasts include all of the
                      ;; subsequent ((von) . (last))... .
                      ;; Yes, the first branch of this 'if' is redundant,
                      ;; but the intricacy of the second does my head in.
                      ;(eprintf "[ vl=~s ]~%" vl)
                      (let ((firsts (if (null? ff)
                                        #f
                                        ff))
                            (vons (caar vl)) ;eg, "von Neumann"
                            (lasts (lasts-from-combined-vons* vl))
                            #;(lasts (if (= (length vl) 1)
                                       (cdar vl)
                                       (apply append
                                              (cons (cdar vl)
                                                    (flatten (cdr vl))
                                                    #;(map (λ (p)
                                                           (append (car p) (cdr p)))
                                                         (cdr vl)))))))
                        ;(eprintf "first=~s  vons=~s  lasts=~s~%" firsts vons lasts)
                        (if (null? lasts)
                            (let ((new-vons  (drop-right vons 1))
                                  (new-lasts (take-right vons 1)))
                              ;; Promote the last von to a last.
                              ;; This happens if the last name looks like a von:
                              ;; eg, "{von Beethoven}, Ludwig"
                              ;; or "Myles na gCopaleen"
                              (make-author firsts ;anomaly: "Bill von" -- make von the last name
                                           (if (null? new-vons) #f new-vons)
                                           new-lasts
                                           #f))
                            (make-author firsts
                                         vons
                                         lasts
                                         #f)))))))
            ((2)
             ;; [von] last names, first names
             ;; -> ( ((first ...) ((von ...) . (last ...)) ...)
             ;;      ((first ...) ((von ...) . (last ...)) ...) )
             ;;
             ;; In the car of this, either (first ...) is non-null,
             ;; or (von ...) is non-null.
             ;; In the first case, the entire car is the list of last names
             (let ((firsts (flatten (cadr authors)))) ;everything in (cadr authors), appended
               (receive (vons lasts)
                   (if (null? (caar authors))
                       (let ((vl (cdar authors)))
                         (values (caar vl)
                                 (lasts-from-combined-vons* vl)))
                       (values #f
                               (flatten (car authors))))
                 ;(eprintf "(cdar authors)=~s  vons=~s  lasts=~s~%" (cdar authors) vons lasts)
                 (if (null? lasts)
                     (let ((new-vons  (drop-right vons 1))
                           (new-lasts (take-right vons 1)))
                       ;; promote a von to a last, as above
                       (make-author firsts
                                    (if (null? new-vons) #f new-vons)
                                    new-lasts
                                    #f))
                     (make-author firsts vons lasts #f)))))
            (else
             ;; [von] last names, jr, first names
             ;; -> ( ((first ...) ((von ...) . (last ...)) ...)
             ;;      ((first ...) ((von ...) . (last ...)) ...)
             ;;      ((first ...) ((von ...) . (last ...)) ...) )
             ;;
             ;; Very similar to the (2) case
             (when (> (length authors) 3)
               (print-warning "Malformed author with four parts (extra parts ~s ignored)"
                              (flatten (drop authors 3))))
             (let ((firsts (flatten (caddr authors))) ;everything in (cadr authors), appended
                   (jrs    (flatten (cadr authors))))
               (receive (vons lasts)
                   (if (null? (caar authors))
                       (let ((vl (cdar authors)))
                         (values (caar vl)
                                 (lasts-from-combined-vons* vl)))
                       (values #f
                               (flatten (car authors))))
                 ;; promote a von to a last, as above
                 (if (null? lasts)
                     (let ((new-vons  (drop-right vons 1))
                           (new-lasts (take-right vons 1)))
                       (make-author firsts
                                    (if (null? new-vons) #f new-vons)
                                    new-lasts
                                    jrs))
                     (make-author firsts vons lasts jrs))))))))))

(define/description list-of-author-names
  "author-list"
  ;; this is sepBy rather than sepBy1,
  ;; so that we don't fail when presented with an empty input string,
  ;; but can instead produce a warning
  (parser-seq (sepBy one-author-name $and)
              (many (parser-seq $and $others))
              :combine-with (λ (namelist others)
                              ;; this will accept "... and others and others"
                              ;; and return only a single 'others
                              (cond ((null? namelist)
                                     (print-warning "No authors found in input")
                                     '()) ;best response?
                                    ((null? others)
                                     namelist)
                                    (else
                                     (append namelist (list 'others)))))))

(define (parse-author-list/klipspringer author-list)
  (parse-result list-of-author-names
                (ustring-iterator/bstrings author-list)))