/* A JSON parser.
 * See RFC 8259 (which obsoletes RFC 7159)
 *
 * The goal here is to parse valid JSON correctly;
 * we don't try to deal with pathologically invalid input,
 * and support no extensions.
 *
 * See
 *   - https://www.ietf.org/rfc/rfc8259.txt
 *   - https://www.ietf.org/rfc/rfc7159.txt
 *   - http://seriot.ch/parsing_json.php (article ‘Parsing JSON is a Minefield’)
 *   - https://github.com/nst/JSONTestSuite (test-suite associated with that)
 *   - https://github.com/douglascrockford/JSON-c (validator)
 *
 * This file is part of Beastie <https://purl.org/nxg/dist/beastie>
 * SPDX-FileCopyrightText: 2025 Norman Gray <https://nxg.me.uk>
 * SPDX-License-Identifier: BSD-2-Clause
 */


%{
#include "beastie.h"
#include "parse-json.h"
#include "util.h"
#include "unicode-scm.h"

static void jsonerror(YYLTYPE* locp, json_extra_t, s7_pointer*, yyscan_t, const char* msg);
%}

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

%token STRING
%token NUMBER
%token JSON_FALSE
%token JSON_NULL
%token JSON_TRUE
 /* error return from lexer... */
%token BAD_LEXEME

%%

 /* A JSON string must contain exactly one value */
input: value	{ *parse_result = s7_cons(S7, s7_t(S7), $1); }
  | BAD_LEXEME	{ *parse_result = s7_cons(S7, s7_f(S7), $1); }

value:    JSON_FALSE
        | JSON_NULL
        | JSON_TRUE
        | NUMBER
        | STRING
        | object
        | array

object: '{' '}' {
    $$ = GCP(s7_make_hash_table(S7, 1));
  }
  | '{' list.of.kv '}' 		{ $$ = $2; }

list.of.kv: kv			{
    $$ = GCP(s7_make_hash_table(S7, 8));
    s7_hash_table_set(S7, $$, s7_car($1), s7_cdr($1));
  }
  | list.of.kv ',' kv		{
    s7_hash_table_set(S7, $1, s7_car($3), s7_cdr($3));
    $$ = $1;
  }

kv: STRING ':' value		{
    // STRING is a ustring?
    s7_pointer string_len = ustring_length_proc(S7, s7_list(S7, 1, $1));
    if (s7_integer(string_len) == 0) {
        // This is a somewhat pathological case, of a zero-length string as key.
        // This is valid JSON, and s7 doesn't actually object to a
        // zero-length symbol name (!), but that doesn't seem useful.
        // I think it's up to us what we do here, but using a key of '_
        // seems not unreasonable.
        $$ = s7_cons(S7, s7_make_symbol(S7, "_"), $3);
    } else {
        $$ = s7_cons(S7, ustring_to_symbol_proc(S7, s7_list(S7, 1, $1)), $3);
    }
  }

array: '[' ']'			{ $$ = s7_nil(S7); }
  | '[' list.of.value ']'	{ $$ = s7_reverse(S7, $2); }

list.of.value: value		{ $$ = GCP(s7_cons(S7, $1, s7_nil(S7))); }
  | list.of.value ',' value	{ $$ = GCP(s7_cons(S7, $3, $1)); }

%%

static void jsonerror(YYLTYPE* locp, json_extra_t extra, s7_pointer* parse_result, yyscan_t scanner, const char* const msg)
{
    // the result is an error message,
    // and a non-zero status returned from jsonparse()
    *parse_result = scheme_eval("sprintf",
                                s7_make_string(S7, "error parsing JSON at ~a:~a: ~a"),
                                s7_make_string(S7, (extra->path == NULL ? "<unknown>" : extra->path)),
                                s7_make_integer(S7, jsonget_lineno(scanner)),
                                s7_make_string(S7, msg),
                                NULL);
}