1%%% Copyright (C) 2017  Tomas Abrahamsson
2%%%
3%%% Author: Tomas Abrahamsson <tab@lysator.liu.se>
4%%%
5%%% This library is free software; you can redistribute it and/or
6%%% modify it under the terms of the GNU Lesser General Public
7%%% License as published by the Free Software Foundation; either
8%%% version 2.1 of the License, or (at your option) any later version.
9%%%
10%%% This library is distributed in the hope that it will be useful,
11%%% but WITHOUT ANY WARRANTY; without even the implied warranty of
12%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
13%%% Lesser General Public License for more details.
14%%%
15%%% You should have received a copy of the GNU Lesser General Public
16%%% License along with this library; if not, write to the Free Software
17%%% Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
18%%% MA  02110-1301  USA
19
20%%% @doc Generation of type specs and record definitinos.
21%%% @private
22-module(gpb_gen_types).
23
24-export([format_msg_record/5]).
25-export([format_maps_as_msgs_record_defs/1]).
26-export([format_enum_typespec/2]).
27-export([format_record_typespec/5]).
28-export([format_export_types/3]).
29
30-include("../include/gpb.hrl").
31-include("gpb_compile.hrl").
32
33format_msg_record(Msg, Fields, AnRes, Opts, Defs) ->
34    Def = list_to_atom(gpb_lib:uppercase(lists:concat([Msg, "_PB_H"]))),
35    [?f("-ifndef(~p).~n", [Def]),
36     ?f("-define(~p, true).~n", [Def]),
37     ?f("-record(~p,~n", [Msg]),
38     ?f("        {"),
39     gpb_lib:outdent_first(format_hfields(Msg, 8+1, Fields, AnRes, Opts, Defs)),
40     "\n",
41     ?f("        }).~n"),
42     ?f("-endif.~n")].
43
44format_maps_as_msgs_record_defs(MapsAsMsgs) ->
45    [begin
46         FNames = [atom_to_list(FName) || #?gpb_field{name=FName} <- Fields],
47         ?f("-record(~p,{~s}).~n", [MsgName, gpb_lib:comma_join(FNames)])
48     end
49     || {{msg,MsgName},Fields} <- MapsAsMsgs].
50
51format_export_types(Defs, AnRes, Opts) ->
52    case gpb_lib:get_type_specs_by_opts(Opts) of
53        false ->
54            "";
55        true ->
56            iolist_to_binary(
57              ["%% enumerated types\n",
58               gpb_lib:nl_join([format_enum_typespec(Enum, Enumeration)
59                                || {{enum, Enum}, Enumeration} <- Defs]),
60               "\n",
61               ?f("-export_type([~s]).",
62                  [gpb_lib:comma_join(["'"++atom_to_list(Enum)++"'/0"
63                                       || {{enum, Enum}, _} <- Defs])]),
64               "\n\n",
65               "%% message types\n",
66               gpb_lib:nl_join(
67                 [format_record_typespec(Name, Fields, Defs, AnRes, Opts)
68                  || {_, Name, Fields} <- gpb_lib:msgs_or_groups(Defs)]),
69               "\n",
70               ?f("-export_type([~s]).",
71                  [gpb_lib:comma_join(
72                     ["'"++atom_to_list(Name)++"'/0"
73                      || {_, Name, _} <- gpb_lib:msgs_or_groups(Defs)])]),
74               "\n"])
75    end.
76
77format_enum_typespec(Enum, Enumeration) ->
78  ?f("-type '~s'() :: ~s.", [Enum,
79    gpb_lib:or_join(
80      ["'"++atom_to_list(EName)++"'" || {EName, _} <- Enumeration])]).
81
82format_record_typespec(Msg, Fields, Defs, AnRes, Opts) ->
83    case gpb_lib:get_records_or_maps_by_opts(Opts) of
84        records ->
85            ?f("-type ~p() :: #~p{}.~n", [Msg, Msg]);
86        maps ->
87            HFields = format_hfields(Msg, 7 + 1, Fields, AnRes, Opts, Defs),
88            BType = calc_keytype_override(Fields, Opts),
89            if BType == no_override ->
90                    ?f("-type ~p() ::~n"
91                       "      #{~s~n"
92                       "       }.~n",
93                       [Msg, gpb_lib:outdent_first(HFields)]);
94               true ->
95                    ?f("-type ~p() ::~n"
96                       "      #{~s~n" % all fields gets rendered as comments
97                       "        ~s~n"
98                       "       }.~n",
99                       [Msg, gpb_lib:outdent_first(HFields), BType])
100            end
101    end.
102
103calc_keytype_override([], _Opts) ->
104    no_override;
105calc_keytype_override(Fields, Opts) ->
106    case gpb_lib:get_maps_key_type_by_opts(Opts) of
107        atom ->
108            no_override;
109        binary ->
110            TypespecsCanIndicateMapItemPresence =
111                gpb_lib:target_can_specify_map_item_presence_in_typespecs(Opts),
112            HaveMandatoryFields =
113                lists:any(fun(F) ->
114                                  gpb_lib:get_field_occurrence(F) /= optional
115                          end,
116                          Fields),
117            if TypespecsCanIndicateMapItemPresence, HaveMandatoryFields ->
118                    "binary() := _";
119               TypespecsCanIndicateMapItemPresence, not HaveMandatoryFields ->
120                    "binary() => _";
121               true ->
122                    "binary() => _"
123            end
124    end.
125
126format_hfields(MsgName, Indent, Fields, AnRes, Opts, Defs) ->
127    IsProto3 = gpb:is_msg_proto3(MsgName, Defs),
128    TypeSpecs = gpb_lib:get_type_specs_by_opts(Opts),
129    MapsOrRecords = gpb_lib:get_records_or_maps_by_opts(Opts),
130    MappingAndUnset = gpb_lib:get_mapping_and_unset_by_opts(Opts),
131    TypespecsCanIndicateMapItemPresence =
132        gpb_lib:target_can_specify_map_item_presence_in_typespecs(Opts),
133    Fields1 = case MappingAndUnset of
134                  #maps{unset_optional=omitted, oneof=flat} ->
135                      gpb_lib:flatten_oneof_fields(Fields);
136                  _ ->
137                      Fields
138              end,
139    LastIndex = case MappingAndUnset of
140                    records ->
141                        length(Fields1);
142                    #maps{unset_optional=present_undefined} ->
143                        length(Fields1);
144                    #maps{unset_optional=omitted} ->
145                        if TypespecsCanIndicateMapItemPresence ->
146                                length(Fields1); % do typespecs for all fields
147                           true ->
148                                find_last_nonopt_field_index(Fields1)
149                        end
150                end,
151    MapTypeFieldsRepr = gpb_lib:get_2tuples_or_maps_for_maptype_fields_by_opts(
152                          Opts),
153    KeyType = gpb_lib:get_maps_key_type_by_opts(Opts),
154    gpb_lib:nl_join(
155      lists:map(
156        fun({I, #?gpb_field{name=Name, fnum=FNum, opts=FOpts, type=Type,
157                            occurrence=Occur}=Field}) ->
158                TypeSpecifierSep = calc_field_type_sep(Field, Opts),
159                LineLead = case MappingAndUnset of
160                               #maps{unset_optional=omitted} when
161                                     Occur == optional,
162                                     not TypespecsCanIndicateMapItemPresence ->
163                                   "%% ";
164                               #maps{} ->
165                                   case KeyType of
166                                       atom   -> "";
167                                       binary -> "%% "
168                                   end;
169                               _ ->
170                                   ""
171                           end,
172                DefaultStr =
173                    case proplists:get_value(default, FOpts, '$no') of
174                        '$no' ->
175                            case {Type, Occur, MapsOrRecords} of
176                                {{map,_,_}, repeated, records} ->
177                                    case MapTypeFieldsRepr of
178                                        maps ->
179                                            ?f(" = #{}");
180                                        '2tuples' ->
181                                            ?f(" = []")
182                                    end;
183                                {_, repeated, records} ->
184                                    ?f(" = []");
185                                {_, _, records} ->
186                                    case IsProto3 of
187                                        true ->
188                                            Default =
189                                                gpb_lib:proto3_type_default(
190                                                  Type,
191                                                  Defs,
192                                                  Opts),
193                                            ?f(" = ~p", [Default]);
194                                        false -> ""
195                                    end;
196                                _ ->
197                                    ""
198                            end;
199                        Default ->
200                            case MapsOrRecords of
201                                records ->
202                                    ?f(" = ~p", [Default]);
203                                maps ->
204                                    ""
205                            end
206                    end,
207                TypeStr = type_to_typestr(MsgName, Field, Defs, AnRes, Opts),
208                CommaSep = if I < LastIndex -> ",";
209                              true          -> "" %% last entry
210                           end,
211                FieldTxt0 = ?f("~s~w~s", [LineLead, Name, DefaultStr]),
212                FieldTxt1 = gpb_lib:indent(Indent, FieldTxt0),
213                FieldTxt2 = if TypeSpecs ->
214                                    LineUp = lineup(iolist_size(FieldTxt1), 32),
215                                    ?f("~s~s~s ~s~s", [FieldTxt1, LineUp,
216                                                       TypeSpecifierSep,
217                                                       TypeStr, CommaSep]);
218                               not TypeSpecs ->
219                                    ?f("~s~s", [FieldTxt1, CommaSep])
220                            end,
221                LineUpCol2 = if TypeSpecs -> 52;
222                                not TypeSpecs -> 40
223                             end,
224                LineUpStr2 = lineup(iolist_size(FieldTxt2), LineUpCol2),
225                TypeComment = type_to_comment(MsgName, Field, TypeSpecs, AnRes),
226                ?f("~s~s% = ~w~s~s",
227                   [FieldTxt2, LineUpStr2, FNum,
228                    [", " || TypeComment /= ""], TypeComment]);
229           ({I, #gpb_oneof{name=Name}=Field}) ->
230                TypeSpecifierSep = calc_field_type_sep(Field, Opts),
231                LineLead = case MappingAndUnset of
232                               #maps{unset_optional=omitted} when
233                                     not TypespecsCanIndicateMapItemPresence->
234                                   "%% ";
235                               #maps{} ->
236                                   case KeyType of
237                                       atom   -> "";
238                                       binary -> "%% "
239                                   end;
240                               _ ->
241                                   ""
242                           end,
243                TypeStr = type_to_typestr(MsgName, Field, Defs, AnRes, Opts),
244                CommaSep = if I < LastIndex -> ",";
245                              true          -> "" %% last entry
246                           end,
247                FieldTxt0 = ?f("~s~w", [LineLead, Name]),
248                FieldTxt1 = gpb_lib:indent(Indent, FieldTxt0),
249                FieldTxt2 = if TypeSpecs ->
250                                    LineUp = lineup(iolist_size(FieldTxt1), 32),
251                                    ?f("~s~s~s ~s~s", [FieldTxt1, LineUp,
252                                                       TypeSpecifierSep,
253                                                       TypeStr, CommaSep]);
254                               not TypeSpecs ->
255                                    ?f("~s~s", [FieldTxt1, CommaSep])
256                            end,
257                LineUpCol2 = if TypeSpecs -> 52;
258                                not TypeSpecs -> 40
259                             end,
260                LineUpStr2 = lineup(iolist_size(FieldTxt2), LineUpCol2),
261                TypeComment = type_to_comment(MsgName, Field, TypeSpecs, AnRes),
262                ?f("~s~s% ~s",
263                   [FieldTxt2, LineUpStr2, TypeComment])
264        end,
265        gpb_lib:index_seq(Fields1))).
266
267find_last_nonopt_field_index(Fields) ->
268    lists:foldl(fun({I, F}, Acc) ->
269                        case gpb_lib:get_field_occurrence(F) of
270                            required -> I;
271                            repeated -> I;
272                            optional -> Acc
273                        end
274                end,
275                0,
276                gpb_lib:index_seq(Fields)).
277
278calc_field_type_sep(#?gpb_field{occurrence=Occurrence}, Opts) ->
279    case gpb_lib:get_mapping_and_unset_by_opts(Opts) of
280        records ->
281            "::";
282        #maps{unset_optional=present_undefined} ->
283            mandatory_map_item_type_sep(Opts);
284        #maps{unset_optional=omitted} ->
285            case Occurrence of
286                required -> mandatory_map_item_type_sep(Opts);
287                repeated -> "=>";
288                optional -> "=>"
289            end
290    end;
291calc_field_type_sep(#gpb_oneof{}, Opts) ->
292    case gpb_lib:get_mapping_and_unset_by_opts(Opts) of
293        records   -> "::";
294        #maps{} -> "=>"
295    end.
296
297mandatory_map_item_type_sep(Opts) ->
298    %% With Erlang 19 we write #{n := integer()} to say that a
299    %% map must contain a map item with key `n' and an integer value.
300    %%
301    %% With earlier Erlang versions, we can only write #{n => integer()}
302    %% and we can never distinguish between map items that may or must
303    %% be present.
304    %%
305    %% Ideally, we would want to know for which version of Erlang we're
306    %% generating code.  For now, we assume the run-time version is the
307    %% same as the compile-time version, which is not necessarily true.  For
308    %% instance, we can generate code for maps even on pre-map Erlang R15.
309    %%
310    %% (At the time of this writing, the OTP_RELEASE pre-defined macro
311    %% does not exist, but even if it had existed, it would have been of
312    %% limited value because it would have linked the Erlang version at
313    %% proto-encoding run-time with the Erlang version at compile-time
314    %% of `gpb' not at compile-time of the .proto file.  In some
315    %% scenario with a package manager, it might have a `gpb'
316    %% pre-compiled with an old Erlang-version to be compatible with
317    %% many environments.  Better to check version at run-time.)
318    %%
319    case gpb_lib:target_can_specify_map_item_presence_in_typespecs(Opts) of
320        true  -> ":=";
321        false -> "=>"
322    end.
323
324type_to_typestr(MsgName,
325                #?gpb_field{name=FName, type=Type, occurrence=Occurrence},
326                Defs, AnRes, Opts) ->
327    OrUndefined = case gpb_lib:get_mapping_and_unset_by_opts(Opts) of
328                      records ->
329                          " | undefined";
330                      #maps{unset_optional=present_undefined} ->
331                          " | undefined";
332                      #maps{unset_optional=omitted} ->
333                          ""
334                  end,
335    ElemPath = [MsgName, FName],
336    case gpb_gen_translators:has_type_spec_translation(ElemPath, AnRes) of
337        {true, TypeStr} ->
338            case Occurrence of
339                required -> TypeStr;
340                repeated -> TypeStr ++ OrUndefined;
341                optional -> TypeStr ++ OrUndefined
342            end;
343        false ->
344            TypeStr = type_to_typestr_2(Type, Defs, Opts),
345            case Occurrence of
346                required ->
347                    TypeStr;
348                repeated ->
349                    case Type of
350                        {map,_,_} ->
351                            TypeStr;
352                        _ ->
353                            RElemPath = [MsgName, FName, []],
354                            case gpb_gen_translators:has_type_spec_translation(
355                                   RElemPath, AnRes) of
356                                {true, RTs} ->
357                                    "[" ++ RTs ++ "]";
358                                false ->
359                                    "[" ++ TypeStr ++ "]"
360                            end
361                    end
362                        ++ OrUndefined;
363                optional ->
364                    TypeStr ++ OrUndefined
365            end
366    end;
367type_to_typestr(MsgName,
368                #gpb_oneof{name=FName, fields=OFields},
369                Defs, AnRes, Opts) ->
370    OrUndefinedElems = case gpb_lib:get_mapping_and_unset_by_opts(Opts) of
371                           records ->
372                               ["undefined"];
373                           #maps{unset_optional=present_undefined} ->
374                               ["undefined"];
375                           #maps{unset_optional=omitted} ->
376                               []
377                       end,
378    OrUndefinedStr = case OrUndefinedElems of
379                         [] -> "";
380                         [U] -> " | " ++ U
381                     end,
382    ElemPath = [MsgName, FName],
383    case gpb_gen_translators:has_type_spec_translation(ElemPath, AnRes) of
384        {true, TypeStr} ->
385            TypeStr ++ OrUndefinedStr;
386        false ->
387            gpb_lib:or_join(
388              [begin
389                   OElemPath = [MsgName, FName, Name],
390                   case gpb_gen_translators:has_type_spec_translation(
391                          OElemPath, AnRes) of
392                       {true, TypeStr} ->
393                           TypeStr;
394                       false ->
395                           TypeStr = type_to_typestr_2(Type, Defs, Opts),
396                           ?f("{~p, ~s}", [Name, TypeStr])
397                   end
398               end
399               || #?gpb_field{name=Name, type=Type} <- OFields]
400              ++ OrUndefinedElems)
401    end.
402
403type_to_typestr_2(sint32, _Defs, _Opts)   -> "integer()";
404type_to_typestr_2(sint64, _Defs, _Opts)   -> "integer()";
405type_to_typestr_2(int32, _Defs, _Opts)    -> "integer()";
406type_to_typestr_2(int64, _Defs, _Opts)    -> "integer()";
407type_to_typestr_2(uint32, _Defs, _Opts)   -> "non_neg_integer()";
408type_to_typestr_2(uint64, _Defs, _Opts)   -> "non_neg_integer()";
409type_to_typestr_2(bool, _Defs, _Opts)     -> "boolean() | 0 | 1";
410type_to_typestr_2(fixed32, _Defs, _Opts)  -> "non_neg_integer()";
411type_to_typestr_2(fixed64, _Defs, _Opts)  -> "non_neg_integer()";
412type_to_typestr_2(sfixed32, _Defs, _Opts) -> "integer()";
413type_to_typestr_2(sfixed64, _Defs, _Opts) -> "integer()";
414type_to_typestr_2(float, _Defs, _Opts)    -> float_spec();
415type_to_typestr_2(double, _Defs, _Opts)   -> float_spec();
416type_to_typestr_2(string, _Defs, Opts)    ->
417  string_to_typestr(gpb_lib:get_strings_as_binaries_by_opts(Opts));
418type_to_typestr_2(bytes, _Defs, _Opts)    -> "iodata()";
419type_to_typestr_2({enum,E}, Defs, Opts)   -> enum_typestr(E, Defs, Opts);
420type_to_typestr_2({msg,M}, _Defs, Opts)   -> msg_to_typestr(M, Opts);
421type_to_typestr_2({group,G}, _Defs, Opts) -> msg_to_typestr(G, Opts);
422type_to_typestr_2({map,KT,VT}, Defs, Opts) ->
423    KTStr = type_to_typestr_2(KT, Defs, Opts),
424    VTStr = type_to_typestr_2(VT, Defs, Opts),
425    MapSep = mandatory_map_item_type_sep(Opts),
426    case gpb_lib:get_2tuples_or_maps_for_maptype_fields_by_opts(Opts) of
427        '2tuples' -> ?f("[{~s, ~s}]", [KTStr, VTStr]);
428        maps      -> ?f("#{~s ~s ~s}", [KTStr, MapSep, VTStr])
429    end.
430
431float_spec() ->
432    "float() | integer() | infinity | '-infinity' | nan".
433
434msg_to_typestr(M, Opts) ->
435  case gpb_lib:get_records_or_maps_by_opts(Opts) of
436    records ->
437      Mod = proplists:get_value(module, Opts),
438      ?f("~p:~p()", [Mod, M]);
439    maps -> ?f("~p()", [M])
440  end.
441
442%% when the strings_as_binaries option is requested the corresponding
443%% typespec should be spec'ed
444string_to_typestr(true) ->
445  "iodata()";
446string_to_typestr(false) ->
447  "iolist()".
448
449enum_typestr(E, Defs, Opts) ->
450    UnknownEnums = case proplists:get_bool(nif, Opts) of
451                       false -> " | integer()";
452                       true  -> ""
453                   end,
454    {value, {{enum,E}, Enumerations}} = lists:keysearch({enum,E}, 1, Defs),
455    gpb_lib:or_join(
456      ["'"++atom_to_list(EName)++"'" || {EName, _} <- Enumerations])
457        ++ UnknownEnums.
458
459type_to_comment(MsgName, Field, TypeSpec, AnRes) ->
460    ElemPath = [MsgName, gpb_lib:get_field_name(Field)],
461    case gpb_gen_translators:has_type_spec_translation(ElemPath, AnRes) of
462        {true, _} ->
463            "";
464        false ->
465            type_to_comment_2(Field, TypeSpec)
466    end.
467
468type_to_comment_2(#?gpb_field{type=Type}, true=_TypeSpec) ->
469    case Type of
470        sint32   -> "32 bits";
471        sint64   -> "32 bits";
472        int32    -> "32 bits";
473        int64    -> "32 bits";
474        uint32   -> "32 bits";
475        uint64   -> "32 bits";
476        fixed32  -> "32 bits";
477        fixed64  -> "32 bits";
478        sfixed32 -> "32 bits";
479        sfixed64 -> "32 bits";
480        {enum,E} -> "enum "++atom_to_list(E);
481        _        -> ""
482    end;
483type_to_comment_2(#?gpb_field{type=Type, occurrence=Occurrence}, false) ->
484    case Occurrence of
485        required -> ?f("~w", [Type]);
486        repeated -> "[" ++ ?f("~w", [Type]) ++ "]";
487        optional -> ?f("~w (optional)", [Type])
488    end;
489type_to_comment_2(#gpb_oneof{}, _) ->
490    "oneof".
491
492
493lineup(CurrentCol, TargetCol) when CurrentCol < TargetCol ->
494    lists:duplicate(TargetCol - CurrentCol, $\s);
495lineup(_, _) ->
496    " ".
497