/*
 * 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
 */

/* A parser for BibTeX authors */

%{
#include "beastie.h"
#include "core.h"
#include "util.h"

#include "parse-authors.h"

static void authorserror(YYLTYPE* locp, authors_extra_t, s7_pointer* ignored, yyscan_t scanner, const char* msg);

static s7_pointer scheme_false;

    // Put R(1), etc, at the beginning of each action to do coverage checking
#if 1
#define R(id)
#else
#include <stdio.h>
void trace_coverage(const char* s) { fprintf(stderr, "@ %s\n", s); }
#define R(id) trace_coverage(#id);
#endif
%}

%locations
%define parse.error verbose
%define api.pure
%lex-param {yyscan_t scanner}
%parse-param {authors_extra_t extra_info}
%parse-param {s7_pointer* parse_result}
%parse-param {yyscan_t scanner}


%initial-action
{
    scheme_false = s7_f(S7);
    s7_gc_protect(S7, scheme_false);
}

%token CAPNAME
%token LCNAME
%token BRACED_STRING
%token AND
%token OTHERS

%%

// Parse the input into a list of authorlist structures,
// or such a list followed by the symbol 'others
input: list.of.names		{R(1.1)
    *parse_result = GCP(s7_reverse(S7, $1));
  }
  | list.of.names AND OTHERS	{R(1.2)
    *parse_result = GCP(s7_reverse(S7, GCP(s7_cons(S7, s7_make_symbol(S7, "others"), $1))));
  }

list.of.names:
    name			{R(2.1) $$ = scheme_make_list($1, NULL); }
  | list.of.names AND name	{R(2.2) $$ = GCP(s7_cons(S7, $3, $1)); }

// Parse a name into an authorlist structure (as created by authors:make)
// where each of the elements can have multiple words.
// An {Organisation} will be deemed to be a 'last name'.
//
// From btxdoc:
//
//    To summarize, BibTEX allows three possible forms for the name:
//         "First von Last"
//         "von Last, First"
//         "von Last, Jr, First"
//
// The author objects are generated by function authors:make, which
// expects its arguments to be in reverse order.
name:
    list.of.capnames			{R(5)
    // First Last
    s7_pointer cdr = GCP(s7_cdr($1));
    $$ = scheme_eval("authors:make",
                     GCP(s7_is_null(S7, cdr) ? s7_f(S7) : cdr),
                     scheme_false,
                     scheme_make_list(s7_car($1), NULL),
                     scheme_false, NULL);
  }
  | list.of.capnames list.of.lcnames list.of.anynames {R(6)
    // First von Last or First von Last1 und Last2
    $$ = scheme_eval("authors:make",
                     $1,
                     $2,
                     $3,
                     scheme_false, NULL);
  }
  | list.of.capnames list.of.anynames {R(7)
    // The important thing here is that we match a name where the last
    // token is a lowercase surname ('lowercase-last')
    // Eg "Luciano dell'Agnello".
    // The special case here is not that we're accepting particular
    // name forms, but that BibTeX will always produce a Last name,
    // even if it starts with a lowercase letter.
    //
    // Here and in the next rule we are matching list.of.anynames so
    // that we can match all possibilities.  We presume that this
    // list will be all lowercase names, and it's not obvious if we
    // should do something special if it isn't.
    if (s7_list_length(S7, $2) == 1) {R(8.1)
        $$ = scheme_eval("authors:make",
                         $1,
                         scheme_false,
                         $2,
                         scheme_false, NULL);
    } else {R(8.2)
        // An unusual variant: this is something like Myles na gCopaleen,
        // where the last tokens, plural, are lowercase.  Interpret
        // this (as BibTeX does) as 'gCopaleen' being the last name,
        // and the previous lowercase tokens are the von-particles.
        $$ = scheme_eval("authors:make",
                         $1,
                         GCP(s7_cdr($2)),
                         GCP(s7_list(S7, 1, s7_car($2))),
                         scheme_false, NULL);
    }
  }
  | list.of.capnames list.of.lcnames list.of.anynames ',' list.of.anynames {R(9)
  // Another unusual case ('spanish-and'): Ruiz y Picasso, Pablo.
  // The 'y' is not a von-part here.
  $$ = scheme_eval("authors:make",
                   $5,
                   scheme_false,
                   GCP(s7_append(S7,
                                 $3,
                                 s7_append(S7, $2, $1))),
                   scheme_false, NULL);
  }
  | list.of.capnames list.of.lcnames list.of.anynames ',' list.of.anynames ',' list.of.anynames {R(10)
    // A 'spanish-and' variant, which includes a Junior part (which I
    // don't think actually happens).
    $$ = scheme_eval("authors:make",
                     $5,
                     scheme_false,
                     GCP(s7_append(S7,
                                   $3,
                                   s7_append(S7, $2, $1))),
                     $7, NULL);
  }
  | list.of.capnames ',' list.of.anynames	{R(11)
    // Last, First
    $$ = scheme_eval("authors:make",
                     $3,
                     scheme_false,
                     $1,
                     scheme_false, NULL);
  }
  | list.of.capnames list.of.anynames ',' list.of.anynames {R(12)
    // Smith dell'Agnello, First ('lowercase-last')
    $$ = scheme_eval("authors:make",
                     $4,
                     scheme_false,
                     GCP(s7_append(S7, $2, $1)),
                     scheme_false, NULL);
  }
  | list.of.capnames ',' list.of.anynames ',' list.of.anynames	{R(13)
    // Last, Jr, First
    $$ = scheme_eval("authors:make",
                     $5,
                     scheme_false,
                     $1,
                     $3, NULL);
  }
  | list.of.capnames list.of.anynames ',' list.of.anynames ',' list.of.anynames {R(14)
    // Smith dell'Agnello, First, Jr ('lowercase-last')
    $$ = scheme_eval("authors:make",
                     $4,
                     scheme_false,
                     GCP(s7_append(S7, $2, $1)),
                     $6, NULL);
  }
  | list.of.lcnames list.of.anynames {R(15)
    // von Last (slightly unusual, but not wrong)
    $$ = scheme_eval("authors:make",
                     scheme_false,
                     $1,
                     $2,
                     scheme_false, NULL);
  }
  | list.of.lcnames {R(16)
    // bell hooks
    $$ = scheme_eval("authors:make",
                     GCP(s7_cdr($1)),
                     scheme_false,
                     GCP(s7_list(S7, 1, s7_car($1))),
                     scheme_false, NULL);
  }
  | list.of.lcnames list.of.anynames ',' list.of.anynames {R(18)
    // von Last, First
    // Note: $2 is list.of.anynames rather than list.of.capnames so that we
    // will match everything (?), but I don't know what
    // "von Last du Last2, First" should parse to
    $$ = scheme_eval("authors:make",
                     $4,
                     $1,
                     $2,
                     scheme_false, NULL);
  }
  | list.of.lcnames ',' list.of.anynames {
    // dell'Agnello, Luciano, so the _surname_ starts with a lowercase letter
    if (s7_list_length(S7, $1) == 1) {R(17.1)
        $$ = scheme_eval("authors:make",
                         $3,
                         scheme_false,
                         $1,
                         scheme_false, NULL);
    } else {R(17.2)
        // Unusual ('lowercase-last')
        $$ = scheme_eval("authors:make",
                         $3,
                         s7_cdr($1),
                         GCP(s7_list(S7, 1, s7_car($1))),
                         scheme_false, NULL);
    }
  }
  | list.of.lcnames list.of.anynames ',' list.of.anynames ',' list.of.anynames	{R(19)
    // von Last, Jr, First
    $$ = scheme_eval("authors:make",
                     $6,
                     $1,
                     $2,
                     $4, NULL);
  }
  | list.of.lcnames ',' list.of.anynames ',' list.of.anynames {
    // Unusual ('lowercase-last')
    // dell'Agnello, Jr, Luciano or
    // na gCopaleen, XIV, Myles
    // (this will botch "dell'Agnello del'Angelus, Jr, Bill", but
    // that's a made-up case, so I don't think I need to worry about
    // it now).
    if (s7_list_length(S7, $1) == 1) {R(20.1)
        $$ = scheme_eval("authors:make",
                         $5,
                         scheme_false,
                         $1,
                         $3, NULL);
    } else {R(20.2)
        $$ = scheme_eval("authors:make",
                         $5,
                         s7_cdr($1),
                         GCP(s7_list(S7, 1, s7_car($1))),
                         $3, NULL);
    }
  }

/*
 * ADS formats "Lidia van Driel-Gesztelyi" as "{Driel-Gesztelyi}, Lidia van".
 * I assert that they're wrong about this (and I've reported it to
 * them), but it would be nice not to fail in this case, and we should
 * probably produce the same result as BibTeX, which parses this as
 * surname "{Driel-Gesztelyi}" and _forenames_ "Lidia van" (as can be
 * confirmed with some .bst hacking and `format.name$`).  HOWEVER, this
 * turns out to be hard, given the grammar we currently (revision
 * 77205b9) have.  I should note that Beebe's bibclean program
 * normalises the backwards form into the sensible one.
 *
 * This is a separate question from what the analysis _should_ be here, in
 * language terms rather than BibTeX ones, since the surname here is
 * a hyphenated combination of a Dutch name with a von-particle, and
 * a Hungarian name without.
 */

list.of.capnames:
    capname				{R(21.1) $$ = scheme_make_list($1, NULL); }
  | list.of.capnames ' ' capname	{R(21.2) $$ = GCP(s7_cons(S7, $3, $1)); }
  | list.of.capnames ' '		{R(21.3) $$ = $1; }


list.of.lcnames:
    lcname				{R(22.1) $$ = scheme_make_list($1, NULL); }
  | list.of.lcnames ' ' lcname		{R(22.2) $$ = GCP(s7_cons(S7, $3, $1)); }
  | list.of.lcnames ' '			{R(22.3) $$ = $1; }

list.of.anynames:
    list.of.capnames
  | list.of.lcnames
  | list.of.anynames list.of.capnames	{R(23.3)
        // the string "von der Last1 Last2" will appear here as lists
        // ("der" "von") and ("Last2" "Last1"), so we have to append
        // them apparently the wrong way around
        $$ = GCP(s7_append(S7, $2, $1));
  }
  | list.of.anynames list.of.lcnames	{R(23.4) $$ = GCP(s7_append(S7, $2, $1));}

/* capname can be "Vall{\'e}e",
 * which is (CAPNAME BRACED_STRING LCNAME)
 *
 * Note that the grammar here is ambiguous, since
 * lcname capname . CAPNAME
 * could reduce (lcname capname) to lcname,
 * or shift the CAPNAME on to the capname.  We depend on Bison choosing the latter.
 * The same is true for BRACED_STRING.
 */
capname:
    CAPNAME
  | BRACED_STRING
  | capname CAPNAME			{R(24.3) $$ = scheme_eval("string-append", $1, $2, NULL); }
  | capname BRACED_STRING		{R(24.4) $$ = scheme_eval("string-append", $1, $2, NULL); }
  | capname LCNAME			{R(24.5) $$ = scheme_eval("string-append", $1, $2, NULL); }

/* Similarly, lcname can be "d{\'e}l" or "d{\'e}L"
 * which are (LCNAME BRACED_STRING LCNAME) and (LCNAME BRACED_STRING CAPNAME) respectively.
 * We want both of these to turn into 'lcname'.
 * We can never have a LCNAME followed by another LCNAME, or directly by a CAPNAME,
 * only by a 'capname' which is a sequence starting with BRACED_STRING.
 */
lcname:
    LCNAME
  | LCNAME capname			{R(25.2) $$ = scheme_eval("string-append", $1, $2, NULL); }

%%

// We could be more sophisticated about this, and include error tokens
// in the grammar, but we don't want to do anything more sophisticated
// than give up at this point.
static void authorserror(YYLTYPE* locp,
                         authors_extra_t extra_info, s7_pointer* ignored, yyscan_t scanner,
                         const char* msg)
{
    scheme_eval("print-warning",
                s7_make_string(S7, "unable to parse as authorlist: ~s (~a)"),
                s7_make_string(S7, extra_info->current_string),
                //get_parse_authorlist_argument(),
                s7_make_string(S7, msg),
                NULL);
}

// It's useful to note that a way of debugging name parsing is
// ./beastie -d4 -mauthors -e '(write (parse-author-list "Bloggs, Fred"))'