#!/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, ' '), 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.