1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2007-2025, University of Amsterdam
    7                              VU University Amsterdam
    8                              CWI, Amsterdam
    9                              SWI-Prolog Solutions b.v.
   10    All rights reserved.
   11
   12    Redistribution and use in source and binary forms, with or without
   13    modification, are permitted provided that the following conditions
   14    are met:
   15
   16    1. Redistributions of source code must retain the above copyright
   17       notice, this list of conditions and the following disclaimer.
   18
   19    2. Redistributions in binary form must reproduce the above copyright
   20       notice, this list of conditions and the following disclaimer in
   21       the documentation and/or other materials provided with the
   22       distribution.
   23
   24    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   25    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   26    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   27    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   28    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   29    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   30    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   31    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   32    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   33    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   34    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   35    POSSIBILITY OF SUCH DAMAGE.
   36*/
   37
   38:- module(json,
   39          [ json_read/2,                % +Stream, -JSONTerm
   40            json_read/3,                % +Stream, -JSONTerm, +Options
   41            atom_json_term/3,           % ?Atom, ?JSONTerm, +Options
   42            json_write/2,               % +Stream, +Term
   43            json_write/3,               % +Stream, +Term, +Options
   44            is_json_term/1,             % @Term
   45            is_json_term/2,             % @Term, +Options
   46                                        % Version 7 dict support
   47            json_read_dict/2,           % +Stream, -Dict
   48            json_read_dict/3,           % +Stream, -Dict, +Options
   49            json_write_dict/2,          % +Stream, +Dict
   50            json_write_dict/3,          % +Stream, +Dict, +Options
   51            atom_json_dict/3,           % ?Atom, ?JSONDict, +Options
   52            json/4                      % {|json(Var,...)||JSON|}
   53          ]).   54:- use_module(library(record)).   55:- use_module(library(error)).   56:- use_module(library(option)).   57:- use_module(library(lists)).   58:- use_module(library(apply)).   59:- use_module(library(quasi_quotations)).   60
   61:- use_foreign_library(foreign(json)).   62
   63:- multifile
   64    json_write_hook/4,                  % +Term, +Stream, +State, +Options
   65    json_dict_pairs/2.                  % +Dict, -Pairs
   66
   67:- predicate_options(json_read/3, 3,
   68                     [ null(ground),
   69                       true(ground),
   70                       false(ground),
   71                       end_of_file(ground),
   72                       value_string_as(oneof([atom,string])),
   73                       qqdict(list(compound(=(atom,var))))
   74                     ]).   75:- predicate_options(json_write/3, 3,
   76                     [ indent(nonneg),
   77                       step(positive_integer),
   78                       tab(positive_integer),
   79                       width(nonneg),
   80                       null(ground),
   81                       true(ground),
   82                       false(ground),
   83                       serialize_unknown(boolean)
   84                     ]).   85:- predicate_options(json_read_dict/3, 3,
   86                     [ tag(atom),
   87                       default_tag(atom),
   88                       pass_to(json_read/3, 3)
   89                     ]).   90:- predicate_options(json_write_dict/3, 3,
   91                     [ tag(atom),
   92                       pass_to(json_write/3, 3)
   93                     ]).   94:- predicate_options(is_json_term/2, 2,
   95                     [ null(ground),
   96                       true(ground),
   97                       false(ground)
   98                     ]).   99:- predicate_options(atom_json_term/3, 3,
  100                     [ as(oneof([atom,string,codes])),
  101                       pass_to(json_read/3, 3),
  102                       pass_to(json_write/3, 3)
  103                     ]).  104
  105/** <module> Reading and writing JSON serialization
  106
  107This module supports reading and  writing   JSON  objects.  This library
  108supports two Prolog representations (the   _new_  representation is only
  109supported in SWI-Prolog version 7 and later):
  110
  111  - The *classical* representation is provided by json_read/3 and
  112    json_write/3.  This represents a JSON object as json(NameValueList),
  113    a JSON string as an atom and the JSON constants =null=, =true= and
  114    =false= as @(null), @(true) and @false.
  115
  116  - The *new* representation is provided by json_read_dict/3 and
  117    json_write_dict/3. This represents a JSON object as a dict, a JSON
  118    string as a Prolog string and the JSON constants using the Prolog
  119    atoms =null=, =true= and =false=.
  120
  121This module provides the `json` _Quasi Quotation_ syntax that allows for
  122embedding JSON documents in Prolog.
  123
  124@see    http_json.pl links JSON to the HTTP client and server modules.
  125@see    json_convert.pl converts JSON Prolog terms to more comfortable
  126terms.
  127*/
  128
  129:- record json_options(
  130              null:ground = @(null),
  131              true:ground = @(true),
  132              false:ground = @(false),
  133              end_of_file:ground = error,
  134              value_string_as:oneof([atom,string]) = atom,
  135              tag:atom = '',
  136              default_tag:(var;atom) = '#',
  137              qqdict:list(compound(atom=var))).  138
  139default_json_dict_options(
  140    json_options(null, true, false, error, string, '', #, _)).
  141
  142
  143                 /*******************************
  144                 *       MAP TO/FROM TEXT       *
  145                 *******************************/
  146
  147%!  atom_json_term(?Atom, ?JSONTerm, +Options) is det.
  148%
  149%   Convert between textual  representation  and   a  JSON  term. In
  150%   _write_ mode (JSONTerm to Atom), the option
  151%
  152%       * as(Type)
  153%       defines the output type, which is one of `atom` (default),
  154%       `string`, `codes` or `chars`.
  155
  156atom_json_term(Atom, Term, Options) :-
  157    ground(Atom),
  158    !,
  159    setup_call_cleanup(
  160        open_string(Atom, In),
  161        json_read(In, Term, Options),
  162        close(In)).
  163atom_json_term(Result, Term, Options) :-
  164    select_option(as(Type), Options, Options1, atom),
  165    (   type_term(Type, Result, Out)
  166    ->  true
  167    ;   must_be(oneof([atom,string,codes,chars]), Type)
  168    ),
  169    with_output_to(Out,
  170                   json_write(current_output, Term, Options1)).
  171
  172type_term(atom,   Result, atom(Result)).
  173type_term(string, Result, string(Result)).
  174type_term(codes,  Result, codes(Result)).
  175type_term(chars,  Result, chars(Result)).
  176
  177
  178                 /*******************************
  179                 *           READING            *
  180                 *******************************/
  181
  182%!  json_read(+Stream, -Term) is det.
  183%!  json_read(+Stream, -Term, +Options) is det.
  184%
  185%   Read next JSON value from Stream into a Prolog term. The
  186%   canonical representation for Term is:
  187%
  188%     * A JSON object is mapped to a term json(NameValueList), where
  189%       NameValueList is a list of Name=Value. Name is an atom
  190%       created from the JSON string.
  191%
  192%     * A JSON array is mapped to a Prolog list of JSON values.
  193%
  194%     * A JSON string is mapped to a Prolog atom
  195%
  196%     * A JSON number is mapped to a Prolog number
  197%
  198%     * The JSON constants =true= and =false= are mapped -like JPL-
  199%       to @(true) and @(false).
  200%
  201%     * The JSON constant =null= is mapped to the Prolog term
  202%       @(null)
  203%
  204%   Here is a complete example in  JSON and its corresponding Prolog
  205%   term.
  206%
  207%     ```
  208%     { "name":"Demo term",
  209%       "created": {
  210%         "day":null,
  211%         "month":"December",
  212%         "year":2007
  213%       },
  214%       "confirmed":true,
  215%       "members":[1,2,3]
  216%     }
  217%     ```
  218%
  219%     ```
  220%     json([ name='Demo term',
  221%            created=json([day= @null, month='December', year=2007]),
  222%            confirmed= @true,
  223%            members=[1, 2, 3]
  224%          ])
  225%     ```
  226%
  227%   The following options are processed:
  228%
  229%     - null(+NullTerm)
  230%       Term used to represent JSON =null=.  Default @(null)
  231%     - true(+TrueTerm)
  232%       Term used to represent JSON =true=.  Default @(true)
  233%     - false(+FalseTerm)
  234%       Term used to represent JSON =false=.  Default @(false)
  235%     - end_of_file(+ErrorOrTerm)
  236%       If end of file is reached after skipping white space
  237%       but before any input is processed take the following
  238%       action (default `error`):
  239%         - If ErrorOrTerm == `error`, throw an unexpected
  240%           end of file syntax error
  241%         - Otherwise return ErrorOrTerm.
  242%       Returning an status term is required to process
  243%       [Concatenated
  244%       JSON](https://en.wikipedia.org/wiki/JSON_streaming#Concatenated_JSON).
  245%       Suggested values are `@(eof)` or `end_of_file`.
  246%     - value_string_as(+Type)
  247%       Prolog type used for strings used as value. Default is `atom`.
  248%       The alternative is `string`, producing a packed string object.
  249%       Please note that `codes` or `chars` would produce ambiguous
  250%       output and are therefore not supported.
  251%
  252%   @see    json_read_dict/3 to read a JSON term using the version 7
  253%           extended data types.
  254
  255json_read(Stream, Term) :-
  256    default_json_options(Options),
  257    (   json_value_top(Stream, Term, Options)
  258    ->  true
  259    ;   syntax_error(illegal_json, Stream)
  260    ).
  261json_read(Stream, Term, Options) :-
  262    make_json_options(Options, OptionTerm, _RestOptions),
  263    (   json_value_top(Stream, Term, OptionTerm)
  264    ->  true
  265    ;   syntax_error(illegal_json, Stream)
  266    ).
  267
  268json_value_top(Stream, Term, Options) :-
  269    stream_property(Stream, type(binary)),
  270    !,
  271    setup_call_cleanup(
  272        set_stream(Stream, encoding(utf8)),
  273        json_value_top_(Stream, Term, Options),
  274        set_stream(Stream, type(binary))).
  275json_value_top(Stream, Term, Options) :-
  276    json_value_top_(Stream, Term, Options).
  277
  278json_value_top_(Stream, Term, Options) :-
  279    get_code(Stream, C0),
  280    ws(C0, Stream, C1),
  281    (   C1 == -1
  282    ->  json_options_end_of_file(Options, Action),
  283        (   Action == error
  284        ->  syntax_error(unexpected_end_of_file, Stream)
  285        ;   Term = Action
  286        )
  287    ;   json_term_top(C1, Stream, Term, Options)
  288    ).
  289
  290json_value(Stream, Term, Next, Options) :-
  291    get_code(Stream, C0),
  292    ws(C0, Stream, C1),
  293    (   C1 == -1
  294    ->  syntax_error(unexpected_end_of_file, Stream)
  295    ;   json_term(C1, Stream, Term, Next, Options)
  296    ).
  297
  298json_term(C0, Stream, JSON, Next, Options) :-
  299    json_term_top(C0, Stream, JSON, Options),
  300    get_code(Stream, Next).
  301
  302json_term_top(0'{, Stream, json(Pairs), Options) :-
  303    !,
  304    ws(Stream, C),
  305    json_pairs(C, Stream, Pairs, Options).
  306json_term_top(0'[, Stream, Array, Options) :-
  307    !,
  308    ws(Stream, C),
  309    json_array(C, Stream, Array, Options).
  310json_term_top(0'", Stream, String, Options) :-
  311    !,
  312    get_code(Stream, C1),
  313    json_string_codes(C1, Stream, Codes),
  314    json_options_value_string_as(Options, Type),
  315    codes_to_type(Type, Codes, String).
  316json_term_top(0'-, Stream, Number, _Options) :-
  317    !,
  318    json_read_number(Stream, 0'-, Number).
  319json_term_top(D, Stream, Number, _Options) :-
  320    between(0'0, 0'9, D),
  321    !,
  322    json_read_number(Stream, D, Number).
  323json_term_top(C, Stream, Constant, Options) :-
  324    json_read_constant(C, Stream, ID),
  325    !,
  326    json_constant(ID, Constant, Options).
  327json_term_top(C, Stream, Var, Options) :-
  328    code_type(C, prolog_var_start),
  329    json_options_qqdict(Options, QQDict),
  330    nonvar(QQDict),
  331    !,
  332    json_read_var_cont(Stream, Codes),
  333    atom_codes(Name, [C | Codes]),
  334    (   memberchk(Name=Var, QQDict)
  335    ->  true
  336    ;   syntax_error(non_existing_var(Name, QQDict), Stream)
  337    ).
  338
  339json_read_var_cont(Stream, [C | L]) :-
  340    peek_code(Stream, C),
  341    code_type(C, prolog_identifier_continue),
  342    !,
  343    get_code(Stream, C),
  344    json_read_var_cont(Stream, L).
  345json_read_var_cont(_, []).
  346
  347
  348json_pairs(0'}, _, [], _) :- !.
  349json_pairs(C0, Stream, [Pair|Tail], Options) :-
  350    json_pair(C0, Stream, Pair, C, Options),
  351    ws(C, Stream, Next),
  352    (   Next == 0',
  353    ->  ws(Stream, C2),
  354        json_pairs(C2, Stream, Tail, Options)
  355    ;   Next == 0'}
  356    ->  Tail = []
  357    ;   syntax_error(illegal_object, Stream)
  358    ).
  359
  360json_pair(C0, Stream, Name=Value, Next, Options) :-
  361    json_string_as_atom(C0, Stream, Name),
  362    ws(Stream, C),
  363    C == 0':,
  364    json_value(Stream, Value, Next, Options).
  365
  366
  367json_array(0'], _, [], _) :- !.
  368json_array(C0, Stream, [Value|Tail], Options) :-
  369    json_term(C0, Stream, Value, C, Options),
  370    ws(C, Stream, Next),
  371    (   Next == 0',
  372    ->  ws(Stream, C1),
  373        json_array(C1, Stream, Tail, Options)
  374    ;   Next == 0']
  375    ->  Tail = []
  376    ;   syntax_error(illegal_array, Stream)
  377    ).
  378
  379codes_to_type(atom, Codes, Atom) :-
  380    atom_codes(Atom, Codes).
  381codes_to_type(string, Codes, Atom) :-
  382    string_codes(Atom, Codes).
  383codes_to_type(codes, Codes, Codes).
  384
  385json_string_as_atom(0'", Stream, Atom) :-
  386    get_code(Stream, C1),
  387    json_string_codes(C1, Stream, Codes),
  388    atom_codes(Atom, Codes).
  389
  390json_string_codes(0'", _, []) :- !.
  391json_string_codes(0'\\, Stream, [H|T]) :-
  392    !,
  393    get_code(Stream, C0),
  394    (   escape(C0, Stream, H)
  395    ->  true
  396    ;   syntax_error(illegal_string_escape, Stream)
  397    ),
  398    get_code(Stream, C1),
  399    json_string_codes(C1, Stream, T).
  400json_string_codes(-1, Stream, _) :-
  401    !,
  402    syntax_error(eof_in_string, Stream).
  403json_string_codes(C, Stream, [C|T]) :-
  404    get_code(Stream, C1),
  405    json_string_codes(C1, Stream, T).
  406
  407escape(0'", _, 0'") :- !.
  408escape(0'\\, _, 0'\\) :- !.
  409escape(0'/, _, 0'/) :- !.
  410escape(0'b, _, 0'\b) :- !.
  411escape(0'f, _, 0'\f) :- !.
  412escape(0'n, _, 0'\n) :- !.
  413escape(0'r, _, 0'\r) :- !.
  414escape(0't, _, 0'\t) :- !.
  415escape(0'u, Stream, C) :-
  416    get_XXXX(Stream, H),
  417    (   hi_surrogate(H)
  418    ->  get_surrogate_tail(Stream, H, C)
  419    ;   C = H
  420    ).
  421
  422get_XXXX(Stream, C) :-
  423    get_xdigit(Stream, D1),
  424    get_xdigit(Stream, D2),
  425    get_xdigit(Stream, D3),
  426    get_xdigit(Stream, D4),
  427    C is D1<<12+D2<<8+D3<<4+D4.
  428
  429get_xdigit(Stream, D) :-
  430    get_code(Stream, C),
  431    code_type(C, xdigit(D)),
  432    !.
  433get_xdigit(Stream, _) :-
  434    syntax_error(hexdigit_expected, Stream).
  435
  436get_surrogate_tail(Stream, Hi, Codepoint) :-
  437    (   get_code(Stream, 0'\\),
  438        get_code(Stream, 0'u),
  439        get_XXXX(Stream, Lo),
  440        surrogate([Hi, Lo], Codepoint)
  441    ->  true
  442    ;   syntax_error(illegal_surrogate_pair, Stream)
  443    ).
  444
  445
  446hi_surrogate(C) :-
  447    C >= 0xD800, C < 0xDC00.
  448
  449lo_surrogate(C) :-
  450    C >= 0xDC00, C < 0xE000.
  451
  452surrogate([Hi, Lo], Codepoint) :-
  453    hi_surrogate(Hi),
  454    lo_surrogate(Lo),
  455    Codepoint is (Hi - 0xD800) * 0x400 + (Lo - 0xDC00) + 0x10000.
  456
  457json_read_constant(0't, Stream, true) :-
  458    !,
  459    must_see(`rue`, Stream, true).
  460json_read_constant(0'f, Stream, false) :-
  461    !,
  462    must_see(`alse`, Stream, false).
  463json_read_constant(0'n, Stream, null) :-
  464    !,
  465    must_see(`ull`, Stream, null).
  466
  467must_see([], _Stream, _).
  468must_see([H|T], Stream, Name) :-
  469    get_code(Stream, C),
  470    (   C == H
  471    ->  true
  472    ;   syntax_error(json_expected(Name), Stream)
  473    ),
  474    must_see(T, Stream, Name).
  475
  476json_constant(true, Constant, Options) :-
  477    !,
  478    json_options_true(Options, Constant).
  479json_constant(false, Constant, Options) :-
  480    !,
  481    json_options_false(Options, Constant).
  482json_constant(null, Constant, Options) :-
  483    !,
  484    json_options_null(Options, Constant).
  485
  486%!  ws(+Stream, -Next) is det.
  487%!  ws(+C0, +Stream, -Next)
  488%
  489%   Skip white space on the Stream, returning the first non-ws
  490%   character.  Also skips =|//|= ... comments.
  491
  492ws(Stream, Next) :-
  493    get_code(Stream, C0),
  494    json_skip_ws(Stream, C0, Next).
  495
  496ws(C0, Stream, Next) :-
  497    json_skip_ws(Stream, C0, Next).
  498
  499syntax_error(Message, Stream) :-
  500    stream_error_context(Stream, Context),
  501    throw(error(syntax_error(json(Message)), Context)).
  502
  503stream_error_context(Stream, stream(Stream, Line, LinePos, CharNo)) :-
  504    stream_pair(Stream, Read, _),
  505    character_count(Read, CharNo),
  506    line_position(Read, LinePos),
  507    line_count(Read, Line).
  508
  509
  510                 /*******************************
  511                 *          JSON OUTPUT         *
  512                 *******************************/
  513
  514%!  json_write_string(+Stream, +Text) is det.
  515%
  516%   Write a JSON string to  Stream.  Stream   must  be  opened  in a
  517%   Unicode capable encoding, typically UTF-8.
  518
  519% foreign json_write_string/2.
  520
  521%!  json_write_indent(+Stream, +Indent, +TabDistance) is det.
  522%
  523%   Newline and indent to  Indent.  A   Newline  is  only written if
  524%   line_position(Stream, Pos) is not 0. Then   it  writes Indent //
  525%   TabDistance tab characters and Indent mode TabDistance spaces.
  526
  527% foreign json_write_indent/3.
  528
  529%!  json_write(+Stream, +Term) is det.
  530%!  json_write(+Stream, +Term, +Options) is det.
  531%
  532%   Write a JSON term to Stream. The JSON   object is of the same format
  533%   as  produced  by  json_read/2,  though  we    allow  for  some  more
  534%   flexibility with regard to pairs  in   objects.  All  of Name=Value,
  535%   Name-Value and Name(Value) produce the same output.
  536%
  537%   Values can be of  the  form  #(Term),   which  causes  `Term`  to be
  538%   _stringified_ if it is not  an   atom  or string. Stringification is
  539%   based on term_string/2.
  540%
  541%   Rational numbers are emitted as  floating   point  numbers. The hook
  542%   json_write_hook/4  can  be  used   to    realize   domain   specific
  543%   alternatives.
  544%
  545%   The version 7 _dict_ type is supported   as well. Optionally, if the
  546%   dict has a _tag_, a  property  "type":"tag"   can  be  added  to the
  547%   object. This behaviour can be controlled using the =tag= option (see
  548%   below). For example:
  549%
  550%     ==
  551%     ?- json_write(current_output, point{x:1,y:2}).
  552%     {
  553%       "x":1,
  554%       "y":2
  555%     }
  556%     ==
  557%
  558%     ==
  559%     ?- json_write(current_output, point{x:1,y:2}, [tag(type)]).
  560%     {
  561%       "type":"point",
  562%       "x":1,
  563%       "y":2
  564%     }
  565%     ==
  566%
  567%   In addition to the options recognised by json_read/3, we process
  568%   the following options are recognised:
  569%
  570%       * width(+Width)
  571%       Width in which we try to format the result.  Too long lines
  572%       switch from _horizontal_ to _vertical_ layout for better
  573%       readability. If performance is critical and human
  574%       readability is not an issue use Width = 0, which causes a
  575%       single-line output.
  576%
  577%       * step(+Step)
  578%       Indentation increment for next level.  Default is 2.
  579%
  580%       * tab(+TabDistance)
  581%       Distance between tab-stops.  If equal to Step, layout
  582%       is generated with one tab per level.
  583%
  584%       * serialize_unknown(+Boolean)
  585%       If =true= (default =false=), serialize unknown terms and
  586%       print them as a JSON string.  The default raises a type
  587%       error.  Note that this option only makes sense if you can
  588%       guarantee that the passed value is not an otherwise valid
  589%       Prolog representation of a Prolog term.
  590%
  591%   If a string is  emitted,  the   sequence  =|</|=  is  emitted as
  592%   =|<\/|=. This is valid  JSON  syntax   which  ensures  that JSON
  593%   objects  can  be  safely  embedded  into  an  HTML  =|<script>|=
  594%   element.
  595
  596%!  json_write_hook(+Term, +Stream, +State, +Options) is semidet.
  597%
  598%   Hook that can be used to  emit   a  JSON  representation for Term to
  599%   Stream. If the  predicate  succeeds  it   __must__  have  written  a
  600%   __valid__ JSON data element and if it fails it may not have produced
  601%   any output. This facility may be used  to map arbitrary Prolog terms
  602%   to JSON. It was added to manage   the  precision with which floating
  603%   point numbers are emitted.
  604%
  605%   Note that this hook is shared by all   users  of this library. It is
  606%   generally  advised  to  map  a  unique    compound   term  to  avoid
  607%   interference with normal output.
  608%
  609%   @arg State and Options are opaque handles to the current output
  610%   state and settings.  Future versions may provide documented access
  611%   to these terms.  Currently it is advised to ignore these arguments.
  612
  613%!  json_dict_pairs(+Dict, -Pairs) is semidet.
  614%
  615%   This hook may be used to order the   keys of an object. If it fails,
  616%   dict_pairs/3 is used which produces an ordered list of keys.
  617
  618:- record json_write_state(indent:nonneg = 0,
  619                           step:positive_integer = 2,
  620                           tab:positive_integer = 8,
  621                           width:nonneg = 72,
  622                           serialize_unknown:boolean = false
  623                          ).  624
  625json_write(Stream, Term) :-
  626    json_write(Stream, Term, []).
  627json_write(Stream, Term, Options) :-
  628    make_json_write_state(Options, State, Options1),
  629    make_json_options(Options1, OptionTerm, _RestOptions),
  630    json_write_term(Term, Stream, State, OptionTerm).
  631
  632json_write_term(Var, _, _, _) :-
  633    var(Var),
  634    !,
  635    instantiation_error(Var).
  636json_write_term(json(Pairs), Stream, State, Options) :-
  637    !,
  638    json_write_object(Pairs, Stream, State, Options).
  639json_write_term(Dict, Stream, State, Options) :-
  640    is_dict(Dict, Tag),
  641    !,
  642    json_pairs(Dict, Pairs0),
  643    (   nonvar(Tag),
  644        json_options_tag(Options, Name),
  645        Name \== ''
  646    ->  Pairs = [Name-Tag|Pairs0]
  647    ;   Pairs = Pairs0
  648    ),
  649    json_write_object(Pairs, Stream, State, Options).
  650json_write_term(List, Stream, State, Options) :-
  651    is_list(List),
  652    !,
  653    space_if_not_at_left_margin(Stream, State),
  654    write(Stream, '['),
  655    (   json_write_state_width(State, Width),
  656        (   Width == 0
  657        ->  true
  658        ;   json_write_state_indent(State, Indent),
  659            json_print_length(List, Options, Width, Indent, _)
  660        )
  661    ->  set_width_of_json_write_state(0, State, State2),
  662        write_array_hor(List, Stream, State2, Options),
  663        write(Stream, ']')
  664    ;   step_indent(State, State2),
  665        write_array_ver(List, Stream, State2, Options),
  666        indent(Stream, State),
  667        write(Stream, ']')
  668    ).
  669
  670json_write_term(Term, Stream, State, Options) :-
  671    json_write_hook(Term, Stream, State, Options),
  672    !.
  673json_write_term(Number, Stream, _State, _Options) :-
  674    number(Number),
  675    !,
  676    (   float(Number)
  677    ->  write(Stream, Number)
  678    ;   integer(Number)
  679    ->  write(Stream, Number)
  680    ;   Float is float(Number)              % rational number
  681    ->  write(Stream, Float)
  682    ).
  683json_write_term(True, Stream, _State, Options) :-
  684    json_options_true(Options, True),
  685    !,
  686    write(Stream, true).
  687json_write_term(False, Stream, _State, Options) :-
  688    json_options_false(Options, False),
  689    !,
  690    write(Stream, false).
  691json_write_term(Null, Stream, _State, Options) :-
  692    json_options_null(Options, Null),
  693    !,
  694    write(Stream, null).
  695json_write_term(#(Text), Stream, _State, _Options) :-
  696    !,
  697    (   (   atom(Text)
  698        ;   string(Text)
  699        )
  700    ->  json_write_string(Stream, Text)
  701    ;   term_string(Text, String),
  702        json_write_string(Stream, String)
  703    ).
  704json_write_term(String, Stream, _State, _Options) :-
  705    atom(String),
  706    !,
  707    json_write_string(Stream, String).
  708json_write_term(String, Stream, _State, _Options) :-
  709    string(String),
  710    !,
  711    json_write_string(Stream, String).
  712json_write_term(AnyTerm, Stream, State, _Options) :-
  713    (   json_write_state_serialize_unknown(State, true)
  714    ->  term_string(AnyTerm, String),
  715        json_write_string(Stream, String)
  716    ;   type_error(json_term, AnyTerm)
  717    ).
  718
  719json_pairs(Dict, Pairs) :-
  720    json_dict_pairs(Dict, Pairs),
  721    !.
  722json_pairs(Dict, Pairs) :-
  723    dict_pairs(Dict, _, Pairs).
  724
  725json_write_object(Pairs, Stream, State, Options) :-
  726    space_if_not_at_left_margin(Stream, State),
  727    write(Stream, '{'),
  728    (   json_write_state_width(State, Width),
  729        (   Width == 0
  730        ->  true
  731        ;   json_write_state_indent(State, Indent),
  732            json_print_length(json(Pairs), Options, Width, Indent, _)
  733        )
  734    ->  set_width_of_json_write_state(0, State, State2),
  735        write_pairs_hor(Pairs, Stream, State2, Options),
  736        write(Stream, '}')
  737    ;   step_indent(State, State2),
  738        write_pairs_ver(Pairs, Stream, State2, Options),
  739        indent(Stream, State),
  740        write(Stream, '}')
  741    ).
  742
  743
  744write_pairs_hor([], _, _, _).
  745write_pairs_hor([H|T], Stream, State, Options) :-
  746    json_pair(H, Name, Value),
  747    json_write_string(Stream, Name),
  748    write(Stream, ':'),
  749    json_write_term(Value, Stream, State, Options),
  750    (   T == []
  751    ->  true
  752    ;   (   json_write_state_width(State, 0)
  753        ->  write(Stream, ',')
  754        ;   write(Stream, ', ')
  755        ),
  756        write_pairs_hor(T, Stream, State, Options)
  757    ).
  758
  759write_pairs_ver([], _, _, _).
  760write_pairs_ver([H|T], Stream, State, Options) :-
  761    indent(Stream, State),
  762    json_pair(H, Name, Value),
  763    json_write_string(Stream, Name),
  764    write(Stream, ':'),
  765    json_write_term(Value, Stream, State, Options),
  766    (   T == []
  767    ->  true
  768    ;   write(Stream, ','),
  769        write_pairs_ver(T, Stream, State, Options)
  770    ).
  771
  772
  773json_pair(Var, _, _) :-
  774    var(Var),
  775    !,
  776    instantiation_error(Var).
  777json_pair(Name=Value, Name, Value) :- !.
  778json_pair(Name-Value, Name, Value) :- !.
  779json_pair(NameValue, Name, Value) :-
  780    compound(NameValue),
  781    NameValue =.. [Name, Value],
  782    !.
  783json_pair(Pair, _, _) :-
  784    type_error(json_pair, Pair).
  785
  786
  787write_array_hor([], _, _, _).
  788write_array_hor([H|T], Stream, State, Options) :-
  789    json_write_term(H, Stream, State, Options),
  790    (   T == []
  791    ->  write(Stream, ' ')
  792    ;   write(Stream, ', '),
  793        write_array_hor(T, Stream, State, Options)
  794    ).
  795
  796write_array_ver([], _, _, _).
  797write_array_ver([H|T], Stream, State, Options) :-
  798    indent(Stream, State),
  799    json_write_term(H, Stream, State, Options),
  800    (   T == []
  801    ->  true
  802    ;   write(Stream, ','),
  803        write_array_ver(T, Stream, State, Options)
  804    ).
  805
  806
  807indent(Stream, State) :-
  808    json_write_state_indent(State, Indent),
  809    json_write_state_tab(State, Tab),
  810    json_write_indent(Stream, Indent, Tab).
  811
  812step_indent(State0, State) :-
  813    json_write_state_indent(State0, Indent),
  814    json_write_state_step(State0, Step),
  815    NewIndent is Indent+Step,
  816    set_indent_of_json_write_state(NewIndent, State0, State).
  817
  818space_if_not_at_left_margin(Stream, State) :-
  819    stream_pair(Stream, _, Write),
  820    line_position(Write, LinePos),
  821    (   LinePos == 0
  822    ;   json_write_state_indent(State, LinePos)
  823    ),
  824    !.
  825space_if_not_at_left_margin(Stream, _) :-
  826    put_char(Stream, ' ').
  827
  828
  829%!  json_print_length(+Value, +Options, +Max, +Len0, +Len) is semidet.
  830%
  831%   True if Len-Len0 is the print-length of Value on a single line
  832%   and Len-Len0 =< Max.
  833%
  834%   @tbd    Escape sequences in strings are not considered.
  835
  836json_print_length(Var, _, _, _, _) :-
  837    var(Var),
  838    !,
  839    instantiation_error(Var).
  840json_print_length(json(Pairs), Options, Max, Len0, Len) :-
  841    !,
  842    Len1 is Len0 + 2,
  843    Len1 =< Max,
  844    must_be(list, Pairs),
  845    pairs_print_length(Pairs, Options, Max, Len1, Len).
  846json_print_length(Dict, Options, Max, Len0, Len) :-
  847    is_dict(Dict),
  848    !,
  849    dict_pairs(Dict, _Tag, Pairs),
  850    Len1 is Len0 + 2,
  851    Len1 =< Max,
  852    pairs_print_length(Pairs, Options, Max, Len1, Len).
  853json_print_length(Array, Options, Max, Len0, Len) :-
  854    is_list(Array),
  855    !,
  856    Len1 is Len0 + 2,
  857    Len1 =< Max,
  858    array_print_length(Array, Options, Max, Len1, Len).
  859json_print_length(Null, Options, Max, Len0, Len) :-
  860    json_options_null(Options, Null),
  861    !,
  862    Len is Len0 + 4,
  863    Len =< Max.
  864json_print_length(False, Options, Max, Len0, Len) :-
  865    json_options_false(Options, False),
  866    !,
  867    Len is Len0 + 5,
  868    Len =< Max.
  869json_print_length(True, Options, Max, Len0, Len) :-
  870    json_options_true(Options, True),
  871    !,
  872    Len is Len0 + 4,
  873    Len =< Max.
  874json_print_length(Number, _Options, Max, Len0, Len) :-
  875    number(Number),
  876    !,
  877    write_length(Number, AL, []),
  878    Len is Len0 + AL,
  879    Len =< Max.
  880json_print_length(@(Id), _Options, Max, Len0, Len) :-
  881    atom(Id),
  882    !,
  883    atom_length(Id, IdLen),
  884    Len is Len0+IdLen,
  885    Len =< Max.
  886json_print_length(String, _Options, Max, Len0, Len) :-
  887    string_len(String, Len0, Len),
  888    !,
  889    Len =< Max.
  890json_print_length(AnyTerm, _Options, Max, Len0, Len) :-
  891    write_length(AnyTerm, AL, []),          % will be serialized
  892    Len is Len0 + AL+2,
  893    Len =< Max.
  894
  895pairs_print_length([], _, _, Len, Len).
  896pairs_print_length([H|T], Options, Max, Len0, Len) :-
  897    pair_len(H, Options, Max, Len0, Len1),
  898    (   T == []
  899    ->  Len = Len1
  900    ;   Len2 is Len1 + 2,
  901        Len2 =< Max,
  902        pairs_print_length(T, Options, Max, Len2, Len)
  903    ).
  904
  905pair_len(Pair, Options, Max, Len0, Len) :-
  906    compound(Pair),
  907    pair_nv(Pair, Name, Value),
  908    !,
  909    string_len(Name, Len0, Len1),
  910    Len2 is Len1+2,
  911    Len2 =< Max,
  912    json_print_length(Value, Options, Max, Len2, Len).
  913pair_len(Pair, _Options, _Max, _Len0, _Len) :-
  914    type_error(pair, Pair).
  915
  916pair_nv(Name=Value, Name, Value) :- !.
  917pair_nv(Name-Value, Name, Value) :- !.
  918pair_nv(Term, Name, Value) :-
  919    compound_name_arguments(Term, Name, [Value]).
  920
  921array_print_length([], _, _, Len, Len).
  922array_print_length([H|T], Options, Max, Len0, Len) :-
  923    json_print_length(H, Options, Max, Len0, Len1),
  924    (   T == []
  925    ->  Len = Len1
  926    ;   Len2 is Len1+2,
  927        Len2 =< Max,
  928        array_print_length(T, Options, Max, Len2, Len)
  929    ).
  930
  931string_len(String, Len0, Len) :-
  932    atom(String),
  933    !,
  934    atom_length(String, AL),
  935    Len is Len0 + AL + 2.
  936string_len(String, Len0, Len) :-
  937    string(String),
  938    !,
  939    string_length(String, AL),
  940    Len is Len0 + AL + 2.
  941
  942
  943                 /*******************************
  944                 *             TEST             *
  945                 *******************************/
  946
  947%!  is_json_term(@Term) is semidet.
  948%!  is_json_term(@Term, +Options) is semidet.
  949%
  950%   True if Term is  a  json  term.   Options  are  the  same as for
  951%   json_read/2, defining the Prolog  representation   for  the JSON
  952%   =true=, =false= and =null= constants.
  953
  954is_json_term(Term) :-
  955    default_json_options(Options),
  956    is_json_term2(Options, Term).
  957
  958is_json_term(Term, Options) :-
  959    make_json_options(Options, OptionTerm, _RestOptions),
  960    is_json_term2(OptionTerm, Term).
  961
  962is_json_term2(_, Var) :-
  963    var(Var), !, fail.
  964is_json_term2(Options, json(Pairs)) :-
  965    !,
  966    is_list(Pairs),
  967    maplist(is_json_pair(Options), Pairs).
  968is_json_term2(Options, List) :-
  969    is_list(List),
  970    !,
  971    maplist(is_json_term2(Options), List).
  972is_json_term2(_, Primitive) :-
  973    atomic(Primitive),
  974    !.           % atom, string or number
  975is_json_term2(Options, True) :-
  976    json_options_true(Options, True).
  977is_json_term2(Options, False) :-
  978    json_options_false(Options, False).
  979is_json_term2(Options, Null) :-
  980    json_options_null(Options, Null).
  981
  982is_json_pair(_, Var) :-
  983    var(Var), !, fail.
  984is_json_pair(Options, Name=Value) :-
  985    atom(Name),
  986    is_json_term2(Options, Value).
  987
  988                 /*******************************
  989                 *         DICT SUPPORT         *
  990                 *******************************/
  991
  992%!  json_read_dict(+Stream, -Dict) is det.
  993%!  json_read_dict(+Stream, -Dict, +Options) is det.
  994%
  995%   Read  a  JSON  object,  returning  objects    as  a  dicts.  The
  996%   representation depends on the options, where the default is:
  997%
  998%     * String values are mapped to Prolog strings
  999%     * JSON =true=, =false= and =null= are represented using these
 1000%       Prolog atoms.
 1001%     * JSON objects are mapped to dicts.
 1002%     * Optionally, a =type= field in an object assigns a tag for
 1003%       the dict.
 1004%
 1005%   The predicate json_read_dict/3 processes  the   same  options as
 1006%   json_read/3,  but  with  different  defaults.  In  addition,  it
 1007%   processes the `tag` option. See   json_read/3  for details about
 1008%   the shared options.
 1009%
 1010%     * tag(+Name)
 1011%       When converting to/from a dict, map the indicated JSON
 1012%       attribute to the dict _tag_. No mapping is performed if Name
 1013%       is the empty atom ('', default). See json_read_dict/2 and
 1014%       json_write_dict/2.
 1015%     * default_tag(+Tag)
 1016%       Provide the default tag if the above `tag` option does not
 1017%       apply.
 1018%     * null(+NullTerm)
 1019%       Default the atom `null`.
 1020%     * true(+TrueTerm)
 1021%       Default the atom `true`.
 1022%     * false(+FalseTerm)
 1023%       Default the atom `false`
 1024%     * end_of_file(+ErrorOrTerm)
 1025%       Action on reading end-of-file. See json_read/3 for details.
 1026%     * value_string_as(+Type)
 1027%       Prolog type used for strings used as value.  Default
 1028%       is `string`.  The alternative is `atom`, producing a
 1029%       packed string object.
 1030
 1031json_read_dict(Stream, Dict) :-
 1032    json_read_dict(Stream, Dict, []).
 1033
 1034json_read_dict(Stream, Dict, Options) :-
 1035    make_json_dict_options(Options, OptionTerm, _RestOptions),
 1036    (   json_value_top(Stream, Term, OptionTerm)
 1037    ->  true
 1038    ;   syntax_error(illegal_json, Stream)
 1039    ),
 1040    term_to_dict(Term, Dict, OptionTerm).
 1041
 1042term_to_dict(Var, Var, _Options) :-
 1043    var(Var),
 1044    !.
 1045term_to_dict(json(Pairs), Dict, Options) :-
 1046    !,
 1047    (   json_options_tag(Options, TagName),
 1048        Tag \== '',
 1049        select(TagName = Tag0, Pairs, NVPairs),
 1050        to_atom(Tag0, Tag)
 1051    ->  json_dict_pairs(NVPairs, DictPairs, Options)
 1052    ;   json_options_default_tag(Options, DefTag),
 1053        (   var(DefTag)
 1054        ->  true
 1055        ;   Tag = DefTag
 1056        ),
 1057        json_dict_pairs(Pairs, DictPairs, Options)
 1058    ),
 1059    dict_create(Dict, Tag, DictPairs).
 1060term_to_dict(Value0, Value, _Options) :-
 1061    atomic(Value0), Value0 \== [],
 1062    !,
 1063    Value = Value0.
 1064term_to_dict(List0, List, Options) :-
 1065    is_list(List0),
 1066    !,
 1067    terms_to_dicts(List0, List, Options).
 1068term_to_dict(Special, Special, Options) :-
 1069    (   json_options_true(Options, Special)
 1070    ;   json_options_false(Options, Special)
 1071    ;   json_options_null(Options, Special)
 1072    ;   json_options_end_of_file(Options, Special)
 1073    ),
 1074    !.
 1075
 1076json_dict_pairs([], [], _).
 1077json_dict_pairs([Name=Value0|T0], [Name=Value|T], Options) :-
 1078    term_to_dict(Value0, Value, Options),
 1079    json_dict_pairs(T0, T, Options).
 1080
 1081terms_to_dicts([], [], _).
 1082terms_to_dicts([Value0|T0], [Value|T], Options) :-
 1083    term_to_dict(Value0, Value, Options),
 1084    terms_to_dicts(T0, T, Options).
 1085
 1086to_atom(Tag, Atom) :-
 1087    string(Tag),
 1088    !,
 1089    atom_string(Atom, Tag).
 1090to_atom(Atom, Atom) :-
 1091    atom(Atom).
 1092
 1093%!  json_write_dict(+Stream, +Dict) is det.
 1094%!  json_write_dict(+Stream, +Dict, +Options) is det.
 1095%
 1096%   Write a JSON term, represented using dicts.  This is the same as
 1097%   json_write/3, but assuming the default   representation  of JSON
 1098%   objects as dicts.
 1099
 1100json_write_dict(Stream, Dict) :-
 1101    json_write_dict(Stream, Dict, []).
 1102
 1103json_write_dict(Stream, Dict, Options) :-
 1104    make_json_write_state(Options, State, Options1),
 1105    make_json_dict_options(Options1, OptionTerm, _RestOptions),
 1106    json_write_term(Dict, Stream, State, OptionTerm).
 1107
 1108
 1109make_json_dict_options(Options, Record, RestOptions) :-
 1110    default_json_dict_options(Record0),
 1111    set_json_options_fields(Options, Record0, Record, RestOptions).
 1112
 1113%!  atom_json_dict(+Atom, -JSONDict, +Options) is det.
 1114%!  atom_json_dict(-Text, +JSONDict, +Options) is det.
 1115%
 1116%   Convert  between  textual  representation  and    a   JSON  term
 1117%   represented as a dict. Options are as for json_read/3.
 1118%   In _write_ mode, the additional option
 1119%
 1120%       * as(Type)
 1121%       defines the output type, which is one of =atom=,
 1122%       =string= or =codes=.
 1123
 1124atom_json_dict(Atom, Term, Options) :-
 1125    ground(Atom),
 1126    !,
 1127    setup_call_cleanup(
 1128        open_string(Atom, In),
 1129        json_read_dict(In, Term, Options),
 1130        close(In)).
 1131atom_json_dict(Result, Term, Options) :-
 1132    select_option(as(Type), Options, Options1, atom),
 1133    (   type_term(Type, Result, Out)
 1134    ->  true
 1135    ;   must_be(oneof([atom,string,codes]), Type)
 1136    ),
 1137    with_output_to(Out,
 1138                   json_write_dict(current_output, Term, Options1)).
 1139
 1140                 /*******************************
 1141                 *      QUASI-QUOTATIONS        *
 1142                 *******************************/
 1143
 1144%!  json(+Content, +Vars, +VarDict, -JSON) is det.
 1145%
 1146%   The  predicate  json/4  implements  JSON   quasi  quotations.  These
 1147%   quotations   produce   a   JSON   dict    that   is   suitable   for
 1148%   json_write_dict/2. The quasi quoter only accepts valid, but possibly
 1149%   partial JSON documents. The quoter replaces content whose value is a
 1150%   Prolog variable that appears in  the   argument  list  of the `json`
 1151%   indicator. Notably, you can't use a Prolog   variable in place of an
 1152%   object key. Here is an example.
 1153%
 1154%     ```
 1155%       {|json(Name)||
 1156%           { "name": Name,
 1157%             "created": {
 1158%               "day":null,
 1159%               "month":"December",
 1160%               "year":2007
 1161%             },
 1162%             "confirmed":true,
 1163%             "members":[1,2,3]
 1164%           }
 1165%       |}.
 1166%     ```
 1167
 1168:- quasi_quotation_syntax(json). 1169
 1170json(Content, Vars, Dict, Result) :-
 1171    must_be(list, Dict),
 1172    include(qq_var(Vars), Dict, QQDict),
 1173    with_quasi_quotation_input(Content, Stream,
 1174                               json_read_dict(Stream, Result,
 1175                                              [ qqdict(QQDict)
 1176                                              ])).
 1177
 1178qq_var(Vars, _=Var) :-
 1179    member(V, Vars),
 1180    V == Var,
 1181    !.
 1182
 1183
 1184                 /*******************************
 1185                 *           MESSAGES           *
 1186                 *******************************/
 1187
 1188:- multifile
 1189    prolog:error_message/3. 1190
 1191prolog:error_message(syntax_error(json(Id))) -->
 1192    [ 'JSON syntax error: ' ],
 1193    json_syntax_error(Id).
 1194
 1195json_syntax_error(illegal_comment) -->
 1196    [ 'Illegal comment' ].
 1197json_syntax_error(illegal_string_escape) -->
 1198    [ 'Illegal escape sequence in string' ].
 1199json_syntax_error(illegal_surrogate_pair) -->
 1200    [ 'Illegal escaped surrogate pair in string' ].
 1201json_syntax_error(non_existing_var(Var, QQDict)) -->
 1202    { maplist(arg(1), QQDict, Vars),
 1203      Term =.. [json|Vars]
 1204    },
 1205    [ 'Variable ', ansi(code, '~w', [Var]),
 1206      ' is not defined in {|',ansi(code,'~w',Term),'|||}'
 1207    ].
 1208
 1209                /*******************************
 1210                *           SANDBOX            *
 1211                *******************************/
 1212
 1213:- multifile sandbox:safe_primitive/1. 1214
 1215sandbox:safe_primitive(json:json(_,_,_,_))