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)  2018, VU University Amsterdam
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(yaml,
   36          [ yaml_read/2,                        % +Input, -DOM
   37            yaml_write/2,                       % +Output, +DOM
   38            yaml_write/3                        % +Output, +DOM, +Options
   39          ]).   40:- autoload(library(apply),[maplist/3,exclude/3]).   41:- autoload(library(base64),[base64/3]).   42:- use_module(library(debug),[debug/3]).   43:- autoload(library(error),[instantiation_error/1]).   44:- autoload(library(option),[option/2,option/3]).   45:- autoload(library(terms),[term_factorized/3]).   46
   47:- use_foreign_library(foreign(yaml4pl)).   48
   49/** <module> Process YAML data
   50
   51This module parses  YAML  serialized  data   into  a  Prolog  term  with
   52structure that is compatible with the JSON   library.  This library is a
   53wrapper around the C library `libyaml`. This  library forms the basis of
   54the YAML support in several languages  and thus guarantees compatibility
   55of our YAML support with other languages.
   56*/
   57
   58:- multifile
   59    tagged/3.                         % +Tag, ?String, ?Value
   60
   61:- predicate_options(yaml_write/3, 3,
   62                     [ canonical(boolean),
   63                       unicode(boolean),
   64                       implicit(boolean),
   65                       factorize(boolean)
   66                     ]).   67
   68%!  yaml_read(+Input, -DOM) is det.
   69%
   70%   Parse Input to a YAML DOM. The DOM representation uses the following
   71%   mapping:
   72%
   73%     - A YAML sequence is mapped to a Prolog List.
   74%     - A YAML mapping is mapped to a Prolog dict.
   75%     - Untagged _scalars_ follow the implicit tag rules defined by
   76%       YAML, providing numbers (int, float and special floats),
   77%       `null` and the booleans `true` and `false`.  Other untagged
   78%       values are returned as a Prolog string.  Tagged values are
   79%       returned as tag(Tag, String) which is processed by
   80%       yalm_tagged/3.  This internal predicate calls the user hook
   81%       yaml:tagged/3 with the same arguments and, if the hook fails,
   82%       provides the following defaults:
   83%
   84%         - =|!!binary|= converts the Base64 to a string of bytes.
   85%         - =|!!str|= explicitly keeps a string
   86%         - =|!!null|= translates "null" to `null`
   87%         - =|!!bool|= translates to `true` and `false`
   88%         - =|!!int|= translates to an integer
   89%         - =|!!float|= translates to a float
   90%         - Anything else is returned as tag(Tag, String)
   91%
   92%   @arg Input is one of (1) a stream, (2) a term string(Data) or
   93%   (3) a file name.
   94%   @bug YAML defines that floats do not require a digit after the
   95%   decimal dot.  We use the Prolog parser which does require the
   96%   decimal dot to be followed by at least one digit.  Because the
   97%   YAML spec intends to match JSON which does require a digit,
   98%   we ignore this incompatibility, expecting it will be addressed
   99%   in the next YAML version.
  100
  101yaml_read(In, DOM) :-
  102    setup_call_cleanup(
  103        yaml_open(In, Stream, Close),
  104        yaml_parse_stream(Stream, DOM0),
  105        Close),
  106    finalize_dom(DOM0, DOM).
  107
  108yaml_open(Stream, Stream, Close) :-
  109    is_stream(Stream),
  110    !,
  111    stream_property(Stream, eof_action(EOF0)),
  112    (   EOF0 == eof_code
  113    ->  Close = true
  114    ;   set_stream(Stream, eof_action(eof_code)),
  115        Close = set_stream(Stream, eof_action(EOF0))
  116    ).
  117yaml_open(string(Data), Stream, close(Stream)) :-
  118    open_string(Data, Stream),
  119    set_stream(Stream, eof_action(eof_code)).
  120yaml_open(File, Stream, close(Stream)) :-
  121    open(File, read, Stream,
  122         [ eof_action(eof_code)
  123         ]).
  124
  125finalize_dom(Var, _) :-
  126    var(Var),                                   % node in progress
  127    !.
  128finalize_dom(sequence(Elems0, Done, Elems), Elems) :-
  129    !,
  130    (   var(Done)
  131    ->  Done = true,
  132        maplist(finalize_dom, Elems0, Elems)
  133    ;   true
  134    ).
  135finalize_dom(mapping(Attrs0, Done, Dict), Dict) :-
  136    !,
  137    (   var(Done)
  138    ->  Done = true,
  139        maplist(mapping_pair, Attrs0, Pairs),
  140        dict_pairs(Dict, yaml, Pairs)
  141    ;   true
  142    ).
  143finalize_dom(tag(Tag, ValueIn), Value) :-
  144    !,
  145    (   string(ValueIn)
  146    ->  (   yalm_tagged(Tag, ValueIn, Value0)
  147        ->  Value = Value0
  148        ;   debug(yaml(tag), 'Ignored tag ~p for ~p', [Tag, ValueIn]),
  149            Value = tag(Tag, ValueIn)
  150        )
  151    ;   finalize_dom(ValueIn, ValueOut),
  152        Value = tag(Tag, ValueOut)
  153    ).
  154finalize_dom(Value, Value).
  155
  156mapping_pair(Name=Value0, Name-Value) :-
  157    finalize_dom(Value0, Value).
  158
  159yalm_tagged(Tag, String, Value) :-
  160    tagged(Tag, String, Value), !.
  161yalm_tagged('tag:yaml.org,2002:binary', Base64, Data) :-
  162    string_codes(Base64, EncCodes0),
  163    exclude(whitespace, EncCodes0, EncCodes),
  164    phrase(base64(PlainCodes), EncCodes),
  165    string_codes(Data, PlainCodes).
  166yalm_tagged('tag:yaml.org,2002:str', String, String).
  167yalm_tagged('tag:yaml.org,2002:null', "null", null).
  168yalm_tagged('tag:yaml.org,2002:bool', "true", true).
  169yalm_tagged('tag:yaml.org,2002:bool', "false", false).
  170yalm_tagged('tag:yaml.org,2002:int',  String, Int) :-
  171    number_string(Int, String).
  172yalm_tagged('tag:yaml.org,2002:float', String, Float) :-
  173    (   special_float(String, Float)
  174    ->  true
  175    ;   number_string(Float0, String),
  176        Float is float(Float0)
  177    ).
  178
  179special_float(".nan", NaN) :- NaN is nan.
  180special_float(".NaN", NaN) :- NaN is nan.
  181special_float(".NAN", NaN) :- NaN is nan.
  182special_float(".inf", Inf) :- Inf is inf.
  183special_float(".Inf", Inf) :- Inf is inf.
  184special_float(".INF", Inf) :- Inf is inf.
  185special_float("-.inf", Inf) :- Inf is -inf.
  186special_float("-.Inf", Inf) :- Inf is -inf.
  187special_float("-.INF", Inf) :- Inf is -inf.
  188
  189whitespace(0'\s).
  190whitespace(0'\t).
  191whitespace(0'\r).
  192whitespace(0'\n).
  193
  194		 /*******************************
  195		 *             EMITTER		*
  196		 *******************************/
  197
  198%!  yaml_write(+Out:stream, +DOM) is det.
  199%!  yaml_write(+Out:stream, +DOM, +Options) is det.
  200%
  201%   Emit a YAML DOM object as a   serialized YAML document to the stream
  202%   Out.  Options processed are:
  203%
  204%     - canonical(+Boolean)
  205%       Use canonical representation.  Default is `false`.
  206%     - unicode(+Boolean)
  207%       Use unicode Default is `true`.
  208%     - implicit(+Boolean)
  209%       Use implicit or explicit representation.  Currently only
  210%       affects the opening and closing the document.  Default is
  211%       `true`.  Use `false` for embedded documents.
  212%     - factorize(+Boolean)
  213%       If `true`, minimize the term by factoring out common
  214%       structures and use =|&anchor|= and =|*anchor|=.  Factorization
  215%       is always used if DOM is a cyclic term.
  216
  217yaml_write(To, DOM) :-
  218    yaml_write(To, DOM, []).
  219
  220yaml_write(To, DOM, Options) :-
  221    (   option(factorize(true), Options)
  222    ->  true
  223    ;   cyclic_term(DOM)
  224    ),
  225    !,
  226    term_factorized(DOM, Skeleton, Substitutions),
  227    assign_anchors(Substitutions, 1),
  228    yaml_write2(To, Skeleton, Options).
  229yaml_write(To, DOM, Options) :-
  230    yaml_write2(To, DOM, Options).
  231
  232assign_anchors([], _).
  233assign_anchors([anchored(Anchor,_Done,Term)=Term|T], I) :-
  234    string_concat("a", I, Anchor),
  235    I2 is I + 1,
  236    assign_anchors(T, I2).
  237
  238yaml_write2(To, DOM, Options) :-
  239    option(implicit(Implicit), Options, true),
  240    yaml_emitter_create(Emitter, To, Options),
  241    yaml_emit_event(Emitter, stream_start),
  242    yaml_emit_event(Emitter, document_start(Implicit)),
  243    yaml_emit(DOM, Emitter, Options),
  244    yaml_emit_event(Emitter, document_end(Implicit)),
  245    yaml_emit_event(Emitter, stream_end).
  246
  247yaml_emit(Var, _, _) :-
  248    var(Var),
  249    !,
  250    instantiation_error(Var).
  251yaml_emit(anchored(Anchor, Done, Term), Emitter, Options) :-
  252    !,
  253    (   var(Done)
  254    ->  Done = true,
  255        yaml_emit(Term, Emitter, Anchor, Options)
  256    ;   yaml_emit_event(Emitter, alias(Anchor))
  257    ).
  258yaml_emit(Term, Emitter, Options) :-
  259    yaml_emit(Term, Emitter, _Anchor, Options).
  260
  261yaml_emit(List, Emitter, Anchor, Options) :-
  262    is_list(List),
  263    !,
  264    yaml_emit_event(Emitter, sequence_start(Anchor, _Tag)),
  265    yaml_emit_list_elements(List, Emitter, Options),
  266    yaml_emit_event(Emitter, sequence_end).
  267yaml_emit(Dict, Emitter, Anchor, Options) :-
  268    is_dict(Dict, _),
  269    !,
  270    dict_pairs(Dict, _, Pairs),
  271    emit_mapping(Pairs, Emitter, Anchor, Options).
  272yaml_emit(json(Pairs), Emitter, Anchor, Options) :-
  273    !,
  274    emit_mapping(Pairs, Emitter, Anchor, Options).
  275yaml_emit(yaml(Pairs), Emitter, Anchor, Options) :-
  276    !,
  277    emit_mapping(Pairs, Emitter, Anchor, Options).
  278yaml_emit(Scalar, Emitter, Anchor, _Options) :-
  279    yaml_emit_event(Emitter, scalar(Scalar, _Tag, Anchor, plain)).
  280
  281yaml_emit_list_elements([], _, _).
  282yaml_emit_list_elements([H|T], Emitter, Options) :-
  283    yaml_emit(H, Emitter, Options),
  284    yaml_emit_list_elements(T, Emitter, Options).
  285
  286emit_mapping(Pairs, Emitter, Anchor, Options) :-
  287    yaml_emit_event(Emitter, mapping_start(Anchor, _Tag)),
  288    yaml_emit_mapping_elements(Pairs, Emitter, Options),
  289    yaml_emit_event(Emitter, mapping_end).
  290
  291yaml_emit_mapping_elements([], _, _).
  292yaml_emit_mapping_elements([H|T], Emitter, Options) :-
  293    name_value(H, Name, Value),
  294    yaml_emit(Name, Emitter, Options),
  295    yaml_emit(Value, Emitter, Options),
  296    yaml_emit_mapping_elements(T, Emitter, Options).
  297
  298name_value(Name-Value, Name, Value) :- !.
  299name_value(Name=Value, Name, Value) :- !.
  300name_value(NameValue, Name, Value) :-
  301    NameValue =.. [Name,Value].
  302
  303
  304		 /*******************************
  305		 *            HOOKS		*
  306		 *******************************/
  307
  308%!  tagged(+Tag, ?String, ?Value) is semidet.
  309%
  310%   Hook that allows  convering  =|!!tag|=  values   to  be  decoded  or
  311%   encoded.