#!/usr/bin/env swipl
% -*- mode: prolog -*-

% Plugin for generating SWI-Prolog protobuf code from a .proto file.
% See https://developers.google.com/protocol-buffers/docs/reference/other

% This program gets a '.google.protobuf.compiler.CodeGeneratorRequest'
% on standard input and outputs a
% '.google.protobuf.compiler.CodeGeneratorResponse' to standard
% output, with the generated contents in file `file` field (repeated).

% Note: The name of this file (protoc-gen-swipl) follows the naming
%       conventions for a protoc plugin, assuming that it's envoked by
%       `protoc --swipl_out=...`

:- initialization(main, main).

:- use_module(library(protobufs)).
:- use_module(library(apply), [maplist/2]).
:- use_module(library(lists), [nth0/3]).
:- use_module(library(error), [domain_error/2]).
:- use_module(library(filesex), [relative_file_name/3]).

% TODO: update this documentation:
% The proto_pb module (and its imports) was generated by running
% parse_descriptor_proto_dump.pl and extracting the contents. See also
% descriptor_proto.pl

:- use_module(gen_pb/google/protobuf/compiler/plugin_pb).

main(Argv) :-
    with_output_to(string(Content), main2(Argv, FileName)),
    Error = [], % or: Error = ['This is the error message']
    proto_to_pb(FileName, PbName),
    % TODO: use protobufs:protobuf_serialize_to_codes/3
    %       MessageType='.google.protobuf.compiler.CodeGeneratorResponse'
    Response = protobuf([ % message CodeGeneratorResponse
                          repeated( 1, string(Error)), % optional string error = 1
                          embedded(15, File)           % repeated File = 15
                        ]
                        ),
    File = protobuf([ % message File
                      string( 1, PbName),   % optional string name = 1
                      string(15, Content) % optional string content = 15
                    ]),
    protobuf_message(Response, ResponseWireStream),
    set_stream(user_output, encoding(octet)),
    set_stream(user_output, type(binary)),
    format(user_output, '~s', [ResponseWireStream]),
    halt.

proto_to_pb(FileName, PbName) :-
    atom_concat(FilePart, '.proto', FileName),  % TODO: file_name_extension/3
    atom_concat(FilePart, '_pb.pl', PbName).

main2(Argv, FileName) :-
    set_stream(user_input, encoding(octet)),
    set_stream(user_input, type(binary)),
    read_stream_to_codes(user_input, RequestWireStream),
    % Because of the way the code is structured, bugs can cause
    % backtracking into a clause that gives an uninformative
    % instantiation error. To debug this, use the following code:
    %   :- use_module(library(prolog_stack)).  % For catch_with_backtrace
    %   catch_with_backtrace(
    %       protobuf_parse_from_codes(...),
    %       Error,
    %       ( print_message(error, Error),  halt(1) )),
    protobuf_parse_from_codes(RequestWireStream,
                              '.google.protobuf.compiler.CodeGeneratorRequest',
                              Request),
    Request.file_to_generate = [FileName|_],
    file_base_name(FileName, FileBaseName),
    file_name_extension(ModuleName0, Extension, FileBaseName),
    atomic_concat(ModuleName0, '_pb', ModuleName),
    assertion(Extension == 'proto'),
    format('% ~w~n', ['-*- mode: prolog; coding: utf-8; -*-']),
    format('~n% ~w~n', ['This file was generated by protoc-gen-swipl']),
    format('% ~w~n~n', ['as a plugin from protoc (the Protobuf compiler)']),
    format('~q.~n', [(:- module(ModuleName, []))]),
    format('~q.~n', [(:- encoding(utf8))]),

    % Term-expansion that avoids duplicate facts. This can happen if
    % a_pb imports b_pb and the main program imports both a_pb and b_pb.
    % TODO: this doesn't work if the *_pb.pl files are compiled to *_pb.qlf.
    % TODO: the calls to clause/2 mess up the swipl JITI, so leave out
    %       the term_expansion and put a cut in protobuf:field_and_type/7
    %       See https://swi-prolog.discourse.group/t/first-and-second-argument-indexing-which-should-be-a-first-argument/2659/5 et seq
    (   false % Turning this off for now
    ->  output_rule(term_expansion(protobufs:Head, Clause),
                    (   clause(protobufs:Head, true)
                    ->  Clause = []
                    ;   Clause = [protobufs:Head]
                    ),
                    ['Head'=Head, 'Clause'=Clause]),
        output_rule(term_expansion((protobufs:Head:-Body), Clause),
                    (   clause(protobufs:Head, Body)
                    ->  Clause = []
                    ;   Clause = [(protobufs:Head :- Body)]
                    ),
                    ['Head'=Head, 'Clause'=Clause, 'Body'=Body])
    ;   true
    ),
    format('~q.~n', [(:- multifile protobufs:protoc_gen_swipl_version/2)]),
    % Note: when the following version is changed, also change the
    %       check in protobufs:protobuf_parse_from_codes/3,
    %       protobufs:protobuf_serialize_to_codes/3.
    format('~q.~n', [protobufs:protoc_gen_swipl_version(ModuleName, [0,9,1])]),
    (   current_prolog_flag(version_git, Version)
    ->  format('swi_prolog_version(~q).~n', [Version])
    ;   current_prolog_flag(version_data, swi(Major, Minor, Path, Extra)),
        (   Extra == []
        ->  format('swi_prolog_version(\'~w.~w.~w\').~n',    [Major, Minor, Path])
        ;   format('swi_prolog_version(\'~w.~w.~w.~w\').~n', [Major, Minor, Path, Extra])
        )
    ),
    ProtocVersion = Request.compiler_version,
    (   ProtocVersion.suffix == ''
    ->  format('protoc_version(\'~w.~w.~w\').~n',
               [ProtocVersion.major, ProtocVersion.minor, ProtocVersion.patch])
    ;   format('protoc_version(\'~w.~w.~w.~w\').~n',
               [ProtocVersion.major, ProtocVersion.minor, ProtocVersion.patch, ProtocVersion.suffix])
    ),
    ReqVersion = req_version{major:3, minor:6, patch:1}, % from Ubuntu PPA
    assertion(ProtocVersion.major > ReqVersion.major
            ;    (   ProtocVersion.major == ReqVersion.major,
                     ProtocVersion.minor > ReqVersion.minor)
             ;   (   ProtocVersion.major == ReqVersion.major,
                     ProtocVersion.minor == ReqVersion.minor,
                     ProtocVersion.patch >= ReqVersion.patch)),
    format('prototoc_gen_swipl_args(~q).~n', [Argv]),
    get_time(Time),
    stamp_date_time(Time, DateUtc, 'UTC'),
    stamp_date_time(Time, DateLocal, local),
    format_time(atom(TS_utc), '%FT%T%z', DateUtc, posix),
    format_time(atom(TS_local), '%FT%T%z', DateLocal, posix),
    format('protoc_run_time(~q, ~q).~n', [TS_utc, TS_local]),
    format('file_to_generate(~q).~n~n', [Request.file_to_generate]),
    generated_preds(Preds),
    atomic_list_concat(Preds, ',\n    ', PredsStr),
    format(':- multifile~n    ~w~n', [PredsStr]),
    % format(':- discontiguous~n    ~w~n~n~n', [PredsStr]), % Not needed: multifile implies this
    (   false  % change to "true" for debugging
               % these 2 facts add a lot to load time (0.33 sec vs 0.02 sec)
    ->  format(user_error, '~n% for debugging:~n', []),
        % remove the source code stuff for debugging output - we don't use it:
        maplist(nb_set_dict_value(source_code_info, ' <deleted> '), Request.proto_file),
        (   select_dict(_{source_code_info:_}, Request, RequestWithoutSourceCodeInfo)
        ->  true
        ;   RequestWithoutSourceCodeInfo = Request
        ),
        % TODO: there's a bug with print_term for dict{x: -5} which outputs as "dict{x:-5}", which can't be read
        format(user_error, 'request(~n', []),
        print_term(RequestWithoutSourceCodeInfo, [indent_arguments(4),output(user_error)]),
        format(user_error, ').~n', []),
        format(user_error, 'request_wire_stream(~q).~n', [RequestWireStream]),
        format(user_error, '% (end of debbuging facts).~n~n', [])
    ;   true
    ),

    expand_request(Request),

    format('~nend_of_file.~n', []).

nb_set_dict_value(Key, Value, Dict) :-
    nb_set_dict(Key, Dict, Value).

generated_preds(Preds) :-
        Preds = [
     'protobufs:proto_meta_normalize/2,              % (Unnormalized, Normalized)',
     'protobufs:proto_meta_package/3,                % (Package, FileName, Options)',
     'protobufs:proto_meta_message_type/3,           % (Fqn, Package, Name)',
     'protobufs:proto_meta_message_type_map_entry/1, % (Fqn)',
     'protobufs:proto_meta_field_name/4,             % (Fqn, FieldNumber, FieldName, FqnName)',
     'protobufs:proto_meta_field_json_name/2,        % (FqnName, JsonName)',
     'protobufs:proto_meta_field_label/2,            % (FqnName, LabelRepeatOptional) % LABEL_OPTIONAL, LABEL_REQUIRED, LABEL_REPEATED',
     'protobufs:proto_meta_field_type/2,             % (FqnName, Type) % TYPE_INT32, TYPE_MESSAGE, etc',
     'protobufs:proto_meta_field_type_name/2,        % (FqnName, TypeName)',
     'protobufs:proto_meta_field_default_value/2,    % (FqnName, DefaultValue)',
     'protobufs:proto_meta_field_option_packed/1,    % (FqnName)',
     'protobufs:proto_meta_enum_type/3,              % (FqnName, Fqn, Name)',
     'protobufs:proto_meta_enum_value/3,             % (FqnName, Name, Number)',
     'protobufs:proto_meta_field_oneof_index/2,      % (FqnName, Index)',
     'protobufs:proto_meta_oneof/3.                  % (FqnName, Index, Name)'
            ].

:- det(expand_request/1).
expand_request(Request) :-
    format('~n% Generated proto_meta_... facts:~n', []),
    % format('  % compiler_version: ~q~n', [Request.compiler_version]),
    format('  % protoc compiler version: ~w.~w.~w~@.~n',
           [Request.compiler_version.major, Request.compiler_version.minor, Request.compiler_version.patch,
            (   Request.compiler_version.suffix == ""
            ->  true
            ;   format(current_output, '.~w', [Request.compiler_version.suffix])
            )]),
    format('  % file_to_generate: ~q~n', [Request.file_to_generate]), % list
    (   get_dict(parameter, Request, Request_parameter)
    ->  format('  % parameter: ~q~n', [Request_parameter])
    ;   format('  % parameter: (none)~n', [])
    ),
    % Request.parameter comes from protoc=--swipl_out=..., which allows
    % specifying a "parameter:dir".
    % TODO: https://github.com/SWI-Prolog/contrib-protobufs/issues/7
    %       - optionally process all (recursive) imports
    maplist(expand_file(Request.file_to_generate), Request.proto_file),
    format('~n% End of generated proto_meta_... facts.~n', []).

:- det(expand_file/2).
expand_file(FileToGenerate, File) :-
    (   memberchk(File.name, FileToGenerate)
    ->  format('  % Processing file ~q~n', [File.name]),
        expand_file_impl(File)
    ;   format('  % Skipping file ~q~n', [File.name])
    ).

:- det(expand_file_impl/1).
expand_file_impl(File) :-
    lookup_pieces('.google.protobuf.FileDescriptorProto',
                  File,
                  _{
                    name:              ''              -File_name,
                    package:           ''              -File_package,
                    dependency:        []              -File_dependency,
                    public_dependency: []              -_,
                    weak_dependency:   []              -_,
                    message_type:      []              -File_message_type,
                    enum_type:         []              -File_enum_type,
                    service:           []               -_,
                    extension:         []              -_File_extension,
                    options:           '.google.protobuf.FileOptions'{} -File_options,
                    source_code_info:  _               -_,
                    syntax:            ''              -_
                   }),
    % TODO: is there anything in File_options that we should check?
    % TODO: do anything with File_dependency? (which is a list)
    %       See https://github.com/SWI-Prolog/contrib-protobufs/issues/7
    format('~n%  -- package(~q) name(~q) dependency(~q)~n',
           [File_package, File_name, File_dependency]),
    maplist(expand_file_dependency(File_name), File_dependency),
    % TODO: handle _File_extensions - see unittest.proto
    (   File_package == ""
    ->  Package = ''
    ;   add_to_fqn('', File_package, Package)
    ),
    output_fact(proto_meta_package(Package, File_name, File_options)),
    maplist(expand_DescriptorProto(Package), File_message_type),
    maplist(expand_EnumDescriptorProto(Package), File_enum_type).

expand_file_dependency(File, Dependency) :-
    absolute_file_name(File, AbsFile, []), % should always succeed
    absolute_file_name(Dependency, AbsDependency, []),
    relative_file_name(AbsDependency, AbsFile, RelativeDependency),
    proto_to_pb(RelativeDependency, PbName),
    format(':- ~q.~n', [use_module(PbName)]).

:- det(expand_DescriptorProto/2).
expand_DescriptorProto(Fqn, MessageType) :-
    lookup_pieces('.google.protobuf.DescriptorProto',
                  MessageType,
                  _{
                    name:            ''      -MessageType_name,
                    field:           []       -MessageType_field,
                    extension:       []      -_,
                    nested_type:     []      -MessageType_nested_type,
                    enum_type:       []      -MessageType_enum_type,
                    extension_range: []      -_,
                    oneof_decl:      []      -MessageType_oneof_decl,
                    options:         '.google.protobuf.MessageOptions'{map_entry:false}-MessageType_options,
                    reserved_range:  []      -_,
                    reserved_name:   []      -_
                   }),
    add_to_fqn(Fqn, MessageType_name, FqnName),
    fqn_no_dot(FqnName, FqnNameNoDot),
    output_fact(proto_meta_normalize(FqnName, FqnName)),
    output_fact(proto_meta_normalize(FqnNameNoDot, FqnName)),
    output_fact(proto_meta_message_type(FqnName, Fqn, MessageType_name)),
    maplist(expand_FieldDescriptorProto(FqnName), MessageType_field),
    maplist(expand_DescriptorProto(FqnName), MessageType_nested_type),
    maplist(expand_EnumDescriptorProto(FqnName), MessageType_enum_type),
    forall(nth0(N, MessageType_oneof_decl, Oneof),
           expand_OneofDescriptorProto(FqnName, N, Oneof)),
    (   MessageType_options.map_entry = true
    ->  output_fact(proto_meta_message_type_map_entry(FqnName))
    ;   true
    ).

fqn_no_dot(FqnName, FqnNameNoDot) :-
    atom_concat('.', FqnNameNoDot, FqnName).

:- det(expand_OneofDescriptorProto/3).
expand_OneofDescriptorProto(Fqn, N, Oneof) :-
    lookup_pieces('.google.protobuf.OneofDescriptorProto',
                  Oneof,
                  _{
                    name:            ''               -Oneof_name,
                    options:         []               -_ % TODO: ??? unused
                   }),
    output_fact(proto_meta_oneof(Fqn, N, Oneof_name)).

:- det(expand_FieldDescriptorProto/2).
expand_FieldDescriptorProto(Fqn, Field) :-
    lookup_pieces('.google.protobuf.FieldDescriptorProto', Field,
                  _{
                    name:            ''               -Field_name,
                    number:          0                -Field_number,
                    label:           0                -Field_label, % enum Label
                    type:            0                -Field_type, % enum Type
                    type_name:       ''               -Field_type_name,
                    extendee:        _                -_,
                    default_value:   ""               -Field_default_value0,
                    oneof_index:     0                -Field_oneof_index,
                    json_name:       ''               -Field_json_name,
                    options:         '.google.protobuf.FieldOptions'{} -Field_options,
                    proto3_optional: false            -_Field_Proto3Optional % TODO
                   }),
    add_to_fqn(Fqn, Field_name, FqnName),
    output_fact(proto_meta_field_name(Fqn, Field_number, Field_name, FqnName)),
    output_fact(proto_meta_field_json_name(FqnName, Field_json_name)),
    output_fact(proto_meta_field_label(FqnName, Field_label)),
    output_fact(proto_meta_field_type(FqnName, Field_type)),
    output_fact(proto_meta_field_type_name(FqnName, Field_type_name)),
    output_fact(proto_meta_field_oneof_index(FqnName, Field_oneof_index)),
    (   default_value(Field_label, Field_type, Field_default_value0, Field_default_value, Field_type_name, Rhs, VariableNames)
    ->  string_atom(FqnName, FqnNameAtom),
        output_rule(protobufs:proto_meta_field_default_value(FqnNameAtom, Field_default_value), Rhs, VariableNames)
    ;   true
    ),
    expand_FieldOptions(FqnName, Field_options).

%! default_value(+Field_label:atom, +Field_type:atom, +Field_default_value0:atom, -Field_default, Field_type_name, -Rhs, -VariableNames) is semidet.
% protoc compiler gives default '' if not specified; puts it in a
% string (which we handle as an atom) otherwise.
default_value('LABEL_REQUIRED', Field_type, Field_default_value0, Field_default_value, Field_type_name, Rhs, VariableNames) :-
    % TODO: LABEL_REQUIRED shouldn't need a default value, but it doesn't hurt to set it (I think).
    default_value('LABEL_OPTIONAL', Field_type, Field_default_value0, Field_default_value, Field_type_name, Rhs, VariableNames).
default_value('LABEL_REPEATED', _, _, [], _, true, []) :- !.
% TODO: verify non-Unicode string, bytes
default_value('LABEL_OPTIONAL', Type, "", 0, _, true, []) :-
    default_value_int(Type), !.
default_value('LABEL_OPTIONAL', 'TYPE_DOUBLE', "", 0.0, _, true, []) :- !.
default_value('LABEL_OPTIONAL', 'TYPE_DOUBLE', Atom, Value, _, true, []) :- !,
    atom_number(Atom, Number0),
    Value is float(Number0).
default_value('LABEL_OPTIONAL', 'TYPE_FLOAT', Atom, Value, FieldTypeName, Rhs, VariableNames) :- !,
    default_value('LABEL_OPTIONAL', 'TYPE_DOUBLE', Atom, Value, FieldTypeName, Rhs, VariableNames).
default_value('LABEL_OPTIONAL', 'TYPE_BOOL', "", false, _, true, []) :- !.
default_value('LABEL_OPTIONAL', 'TYPE_BOOL', "false", false, _, true, []) :- !.
default_value('LABEL_OPTIONAL', 'TYPE_BOOL', "true", true, _, true, []) :- !.
% TODO: are there any other possibilities of BOOL ... and does protoc check? - test case
default_value('LABEL_OPTIONAL', 'TYPE_BOOL', DefaultStr, false, _, true, []) :- !,
    domain_error(["false","true"], DefaultStr).
% TODO: what if string not UTF8?
default_value('LABEL_OPTIONAL', 'TYPE_STRING', Atom, Value, _, true, []) :- !,
    atom_string(Atom, Value).
% 'TYPE_GROUP' - fail
% 'TYPE_MESSAGE' - fail
default_value('LABEL_OPTIONAL', 'TYPE_BYTES', Atom, Value, _, true, []) :- !,
    atom_codes(Atom, Value).
default_value('LABEL_OPTIONAL', 'TYPE_ENUM', "", EnumName, FieldTypeName,
              protobufs:proto_meta_enum_value(FieldTypeNameAtom, EnumName, 0), ['EnumName'=EnumName]) :- !,
    string_atom(FieldTypeName, FieldTypeNameAtom).
% TODO: does protoc check for valid enum value? - test case
default_value('LABEL_OPTIONAL', 'TYPE_ENUM', Atom, Atom, _, true, []) :- !.

default_value_int('TYPE_FIXED32').
default_value_int('TYPE_FIXED64').
default_value_int('TYPE_INT32').
default_value_int('TYPE_INT64').
default_value_int('TYPE_SFIXED32').
default_value_int('TYPE_SFIXED64').
default_value_int('TYPE_SINT32').
default_value_int('TYPE_SINT64').
default_value_int('TYPE_UINT32').
default_value_int('TYPE_UINT64').

:- det(expand_FieldOptions/2).
expand_FieldOptions(FqnName, Options) :-
    lookup_pieces('.google.protobuf.FieldOptions', Options,
                  _{
                    ctype:                _     -_,
                    packed:               false -Option_packed,
                    jstype:               _     -_,
                    lazy:                 false -_,
                    deprecated:           false -_, % TODO: output warning if a deprecated field is used
                    weak:                 false -_,
                    uninterpreted_option: _     -_
                   }),
    (   Option_packed = true
    ->  output_fact(proto_meta_field_option_packed(FqnName))
    ;   true
    ).

:- det(expand_EnumDescriptorProto/2).
expand_EnumDescriptorProto(Fqn, EnumType) :-
    lookup_pieces('.google.protobuf.EnumDescriptorProto', EnumType,
                  _{
                    name:           '' -EnumType_name,
                    value:          [] -EnumType_value,
                    options:        _  -_,
                    reserved_range: _  -_,
                    reserved_name:  _  -_
                   }),
    add_to_fqn(Fqn, EnumType_name, FqnName),
    output_fact(proto_meta_enum_type(FqnName, Fqn, EnumType_name)),
    maplist(expand_EnumValueDescriptorProto(FqnName), EnumType_value).

:- det(expand_EnumValueDescriptorProto/2).
expand_EnumValueDescriptorProto(Fqn, Value) :-
    lookup_pieces('.google.protobuf.EnumValueDescriptorProto', Value,
                  _{
                    name:    ''-Value_name,
                    number:  0-Value_number,
                    options: _-_
                   }),
    output_fact(proto_meta_enum_value(Fqn, Value_name, Value_number)).

:- det(lookup_pieces/3).
%! lookup_pieces(+Tag, +DataDict, ?LookupDict) is det.
% Given a =DataDict=, look up the items in =LookupDict= If =DataDict=
% contains any keys that aren't in =LookupDict=, this predicate
% fails. This is to catch typos. For example: =|lookup_pieces(d,
% d{a:1,b:2}, _{a:0-A,bb:0-B,c:[]-C})|= will fail but
% =|lookup_pieces(d, d{a:1,b:2}, _{a:0-A,b:0-B,c:[]-C})|= will succeed
% with =|A=1,B=2,C=[]|=. In other words, =LookupDict= must contain all
% the possible keys in =DataDict= (with suitable defaults, of course).
% @param Tag the tag for =DataDict=
% @param DataDict items in =LookupDict= are looked up in here.
%        Its tag must unify with =Tag= (i.e., =|is_dict(DataDict,Tag)|=).
% @param LookupDict a dict where each entry is of the form =Default-Value=.
%        Each key is looked up in =DataDict= - if it's there, the value
%        from =DataDict= is unified with =Value=; if it's not there,
%        =Value= is unified with =Default=.
lookup_pieces(Tag, DataDict, LookupDict) :-
    is_dict(DataDict, Tag0),
    assertion(Tag == Tag0),
    dict_pairs(LookupDict, _, LookupPairs),
    lookup_piece_pairs(LookupPairs, DataDict).

lookup_piece_pairs([], RemainderDict) =>
    RemainderDict = _{}. % For debugging: assertion(RemainderDict = _{})
lookup_piece_pairs([Key-(Default-Value)|KDVs], DataDict0) =>
    dict_create(D0, _, [Key-Value]),
    (   select_dict(D0, DataDict0, DataDict)
    ->  true
    ;   Value = Default,
        DataDict = DataDict0
    ),
    lookup_piece_pairs(KDVs, DataDict).

add_to_fqn(Fqn, Name, FqnName) :-
    atomic_list_concat([Fqn, Name], '.', FqnName).

:- det(output_fact/1).
output_fact(Fact) =>
    Fact =.. [Name|Args0],
    maplist(string_atom, Args0, Args1),
    Fact1 =.. [Name|Args1],
    format('~q.~n', [protobufs:Fact1]).

:- det(output_rule/3).
output_rule(Head, Rhs, VariableNames) =>
    % Do *not* convert strings to atoms - this messes up string default values.
    Opts = [fullstop(false),quoted(true),variable_names(VariableNames)],
    (   Rhs == true
    ->  format('~W.~n', [Head, Opts])
    ;   format('~W.~n', [(Head:-Rhs), Opts])
    ).

string_atom(String, Atom) :-
    (   string(String)
    ->  atom_string(Atom, String)
    ;   % TODO: if dict, process the items (from proto_meta_package(Package, File_name, File_options))
        String = Atom
    ).

end_of_file.
