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