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:- autoload(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 YALM 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
   95yaml_read(In, DOM) :-
   96    setup_call_cleanup(
   97        yaml_open(In, Stream, Close),
   98        yaml_parse_stream(Stream, DOM0),
   99        Close),
  100    finalize_dom(DOM0, DOM).
  101
  102yaml_open(Stream, Stream, Close) :-
  103    is_stream(Stream),
  104    !,
  105    stream_property(Stream, eof_action(EOF0)),
  106    (   EOF0 == eof_code
  107    ->  Close = true
  108    ;   set_stream(Stream, eof_action(eof_code)),
  109        Close = set_stream(Stream, eof_action(EOF0))
  110    ).
  111yaml_open(string(Data), Stream, close(Stream)) :-
  112    open_string(Data, Stream),
  113    set_stream(Stream, eof_action(eof_code)).
  114yaml_open(File, Stream, close(Stream)) :-
  115    open(File, read, Stream,
  116         [ eof_action(eof_code)
  117         ]).
  118
  119finalize_dom(Var, _) :-
  120    var(Var),                                   % node in progress
  121    !.
  122finalize_dom(sequence(Elems0, Done, Elems), Elems) :-
  123    !,
  124    (   var(Done)
  125    ->  Done = true,
  126        maplist(finalize_dom, Elems0, Elems)
  127    ;   true
  128    ).
  129finalize_dom(mapping(Attrs0, Done, Dict), Dict) :-
  130    !,
  131    (   var(Done)
  132    ->  Done = true,
  133        maplist(mapping_pair, Attrs0, Pairs),
  134        dict_pairs(Dict, yaml, Pairs)
  135    ;   true
  136    ).
  137finalize_dom(tag(Tag, ValueIn), Value) :-
  138    !,
  139    (   string(ValueIn)
  140    ->  (   yalm_tagged(Tag, ValueIn, Value0)
  141        ->  Value = Value0
  142        ;   debug(yaml(tag), 'Ignored tag ~p for ~p', [Tag, ValueIn]),
  143            Value = tag(Tag, ValueIn)
  144        )
  145    ;   finalize_dom(ValueIn, ValueOut),
  146        Value = tag(Tag, ValueOut)
  147    ).
  148finalize_dom(Value, Value).
  149
  150mapping_pair(Name=Value0, Name-Value) :-
  151    finalize_dom(Value0, Value).
  152
  153yalm_tagged(Tag, String, Value) :-
  154    tagged(Tag, String, Value), !.
  155yalm_tagged('tag:yaml.org,2002:binary', Base64, Data) :-
  156    string_codes(Base64, EncCodes0),
  157    exclude(whitespace, EncCodes0, EncCodes),
  158    phrase(base64(PlainCodes), EncCodes),
  159    string_codes(Data, PlainCodes).
  160yalm_tagged('tag:yaml.org,2002:str', String, String).
  161yalm_tagged('tag:yaml.org,2002:null', "null", null).
  162yalm_tagged('tag:yaml.org,2002:bool', "true", true).
  163yalm_tagged('tag:yaml.org,2002:bool', "false", false).
  164yalm_tagged('tag:yaml.org,2002:int',  String, Int) :-
  165    number_string(Int, String).
  166yalm_tagged('tag:yaml.org,2002:float', String, Float) :-
  167    (   special_float(String, Float)
  168    ->  true
  169    ;   number_string(Float0, String),
  170        Float is float(Float0)
  171    ).
  172
  173special_float(".nan", NaN) :- NaN is nan.
  174special_float(".NaN", NaN) :- NaN is nan.
  175special_float(".NAN", NaN) :- NaN is nan.
  176special_float(".inf", Inf) :- Inf is inf.
  177special_float(".Inf", Inf) :- Inf is inf.
  178special_float(".INF", Inf) :- Inf is inf.
  179special_float("-.inf", Inf) :- Inf is -inf.
  180special_float("-.Inf", Inf) :- Inf is -inf.
  181special_float("-.INF", Inf) :- Inf is -inf.
  182
  183whitespace(0'\s).
  184whitespace(0'\t).
  185whitespace(0'\r).
  186whitespace(0'\n).
  187
  188		 /*******************************
  189		 *             EMITTER		*
  190		 *******************************/
  191
  192%!  yaml_write(+Out:stream, +DOM) is det.
  193%!  yaml_write(+Out:stream, +DOM, +Options) is det.
  194%
  195%   Emit a YAML DOM object as a   serialized YAML document to the stream
  196%   Out.  Options processed are:
  197%
  198%     - canonical(+Boolean)
  199%       Use canonical representation.  Default is `false`.
  200%     - unicode(+Boolean)
  201%       Use unicode Default is `true`.
  202%     - implicit(+Boolean)
  203%       Use implicit or explicit representation.  Currently only
  204%       affects the opening and closing the document.  Default is
  205%       `true`.  Use `false` for embedded documents.
  206%     - factorize(+Boolean)
  207%       If `true`, minimize the term by factoring out common
  208%       structures and use =|&anchor|= and =|*anchor|=.  Factorization
  209%       is always used if DOM is a cyclic term.
  210
  211yaml_write(To, DOM) :-
  212    yaml_write(To, DOM, []).
  213
  214yaml_write(To, DOM, Options) :-
  215    (   option(factorize(true), Options)
  216    ->  true
  217    ;   cyclic_term(DOM)
  218    ),
  219    !,
  220    term_factorized(DOM, Skeleton, Substitutions),
  221    assign_anchors(Substitutions, 1),
  222    yaml_write2(To, Skeleton, Options).
  223yaml_write(To, DOM, Options) :-
  224    yaml_write2(To, DOM, Options).
  225
  226assign_anchors([], _).
  227assign_anchors([anchored(Anchor,_Done,Term)=Term|T], I) :-
  228    string_concat("a", I, Anchor),
  229    I2 is I + 1,
  230    assign_anchors(T, I2).
  231
  232yaml_write2(To, DOM, Options) :-
  233    option(implicit(Implicit), Options, true),
  234    yaml_emitter_create(Emitter, To, Options),
  235    yaml_emit_event(Emitter, stream_start),
  236    yaml_emit_event(Emitter, document_start(Implicit)),
  237    yaml_emit(DOM, Emitter, Options),
  238    yaml_emit_event(Emitter, document_end(Implicit)),
  239    yaml_emit_event(Emitter, stream_end).
  240
  241yaml_emit(Var, _, _) :-
  242    var(Var),
  243    !,
  244    instantiation_error(Var).
  245yaml_emit(anchored(Anchor, Done, Term), Emitter, Options) :-
  246    !,
  247    (   var(Done)
  248    ->  Done = true,
  249        yaml_emit(Term, Emitter, Anchor, Options)
  250    ;   yaml_emit_event(Emitter, alias(Anchor))
  251    ).
  252yaml_emit(Term, Emitter, Options) :-
  253    yaml_emit(Term, Emitter, _Anchor, Options).
  254
  255yaml_emit(List, Emitter, Anchor, Options) :-
  256    is_list(List),
  257    !,
  258    yaml_emit_event(Emitter, sequence_start(Anchor, _Tag)),
  259    yaml_emit_list_elements(List, Emitter, Options),
  260    yaml_emit_event(Emitter, sequence_end).
  261yaml_emit(Dict, Emitter, Anchor, Options) :-
  262    is_dict(Dict, _),
  263    !,
  264    dict_pairs(Dict, _, Pairs),
  265    emit_mapping(Pairs, Emitter, Anchor, Options).
  266yaml_emit(json(Pairs), Emitter, Anchor, Options) :-
  267    !,
  268    emit_mapping(Pairs, Emitter, Anchor, Options).
  269yaml_emit(yaml(Pairs), Emitter, Anchor, Options) :-
  270    !,
  271    emit_mapping(Pairs, Emitter, Anchor, Options).
  272yaml_emit(Scalar, Emitter, Anchor, _Options) :-
  273    yaml_emit_event(Emitter, scalar(Scalar, _Tag, Anchor, plain)).
  274
  275yaml_emit_list_elements([], _, _).
  276yaml_emit_list_elements([H|T], Emitter, Options) :-
  277    yaml_emit(H, Emitter, Options),
  278    yaml_emit_list_elements(T, Emitter, Options).
  279
  280emit_mapping(Pairs, Emitter, Anchor, Options) :-
  281    yaml_emit_event(Emitter, mapping_start(Anchor, _Tag)),
  282    yaml_emit_mapping_elements(Pairs, Emitter, Options),
  283    yaml_emit_event(Emitter, mapping_end).
  284
  285yaml_emit_mapping_elements([], _, _).
  286yaml_emit_mapping_elements([H|T], Emitter, Options) :-
  287    name_value(H, Name, Value),
  288    yaml_emit(Name, Emitter, Options),
  289    yaml_emit(Value, Emitter, Options),
  290    yaml_emit_mapping_elements(T, Emitter, Options).
  291
  292name_value(Name-Value, Name, Value) :- !.
  293name_value(Name=Value, Name, Value) :- !.
  294name_value(NameValue, Name, Value) :-
  295    NameValue =.. [Name,Value].
  296
  297
  298		 /*******************************
  299		 *            HOOKS		*
  300		 *******************************/
  301
  302%!  tagged(+Tag, ?String, ?Value) is semidet.
  303%
  304%   Hook that allows  convering  =|!!tag|=  values   to  be  decoded  or
  305%   encoded.