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