1%% Copyright (c) 2008-2016 Robert Virding
2%%
3%% Licensed under the Apache License, Version 2.0 (the "License");
4%% you may not use this file except in compliance with the License.
5%% You may obtain a copy of the License at
6%%
7%%     http://www.apache.org/licenses/LICENSE-2.0
8%%
9%% Unless required by applicable law or agreed to in writing, software
10%% distributed under the License is distributed on an "AS IS" BASIS,
11%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
12%% See the License for the specific language governing permissions and
13%% limitations under the License.
14
15%% File    : lfe_io_pretty.erl
16%% Author  : Robert Virding
17%% Purpose : Pretty printer for Lisp Flavoured Erlang.
18
19-module(lfe_io_pretty).
20
21-export([term/1,term/2,term/3,term/4]).
22
23-compile(export_all).
24
25-import(lists, [reverse/1,reverse/2,flatlength/1]).
26
27%% Define IS_MAP/1 macro for is_map/1 bif.
28-ifdef(HAS_MAPS).
29-define(IS_MAP(T), is_map(T)).
30-else.
31-define(IS_MAP(T), false).
32-endif.
33
34%% term(Sexpr [, Depth [, Indentation [, LineLength]]]) -> [char()].
35%%  A relatively simple pretty print function, but with some
36%%  customisation. N.B. We know about the standard character macros
37%%  and use them instead of their expanded forms.
38
39term(S) -> term(S, -1, 0, 80).
40
41term(S, D) -> term(S, D, 0, 80).
42
43term(S, D, I) -> term(S, D, I, 80).
44
45term(_, 0, _, _) -> "...";
46term(Symb, _, _, _) when is_atom(Symb) -> lfe_io_write:symbol(Symb);
47term(Numb, _, _, _) when is_integer(Numb) -> integer_to_list(Numb);
48term(Numb, _, _, _) when is_float(Numb) -> io_lib_format:fwrite_g(Numb);
49%% Handle some default special cases, standard character macros. These
50%% don't increase depth as they really should.
51term([quote,E], D, I, L) -> ["'",term(E, D, I+1, L)];
52term([backquote,E], D, I, L) -> ["`",term(E, D, I+1, L)];
53term([comma,E], D, I, L) -> [",",term(E, D, I+1, L)];
54term(['comma-at',E], D, I, L) -> [",@",term(E, D, I+2, L)];
55term([map|MapBody], D, I, L) ->                 %Special case map form
56    Mcs = map_body(MapBody, D, I+5, L),
57    ["(map ",Mcs,$)];
58term([Car|_]=List, D, I, L) ->
59    %% Handle printable lists specially.
60    case io_lib:printable_unicode_list(List) of
61        true -> lfe_io_write:string(List, $");  %"
62        false ->
63            case list_max(List, D-1, I+1, L-1) of
64                {yes,Print} -> ["(",Print,")"];
65                no ->
66                    %% Customise printing of lists.
67                    case indent_type(Car) of
68                        none ->                 %Normal lists.
69                            ["(",list(List, D-1, I+1, L-1),")"];
70                        defun ->                %Special case for defuns
71                            defun(List, D, I, L);
72                        N when is_integer(N) -> %Special N first elements
73                            type(List, D, I, L, N)
74                    end
75            end
76    end;
77term([], _, _, _) -> "()";
78term({}, _, _, _) -> "#()";
79term(Tup, D, I, L) when is_tuple(Tup) ->
80    Es = tuple_to_list(Tup),
81    case list_max(Es, D-1, I+2, L-1) of
82        {yes,Print}  -> ["#(",Print,")"];
83        no -> ["#(",list(Es, D-1, I+2, L),")"]
84    end;
85term(Bit, D, _, _) when is_bitstring(Bit) ->
86    bitstring(Bit, D);                          %First D bytes
87term(Map, D, I, L) when ?IS_MAP(Map) ->
88    %% This will return kv pairs in reverse order to from_list, but
89    %% this dooesn't really matter here.
90    Fun = fun (K, V, Acc) -> [K,V|Acc] end,
91    Mcs = map_body(maps:fold(Fun, [], Map), D, I+3, L),
92    ["#M(",Mcs,$)];
93term(Other, _, _, _) ->
94    lfe_io_write:term(Other).                   %Use standard LFE for rest
95
96%% bitstring(Bitstring, Depth) -> [char()]
97%%  Print the bytes in a bitstring. Print bytes except for last which
98%%  we add size field if not 8 bits big.
99
100bitstring(Bit, D) ->
101    try
102        Chars = unicode:characters_to_list(Bit, utf8),
103        true  = io_lib:printable_unicode_list(Chars),
104        [$#|lfe_io_write:string(Chars, $")]
105    catch
106        _:_ -> lfe_io_write:bitstring(Bit, D)
107    end.
108
109%% defun(List, Depth, Indentation, LineLength) -> [char()].
110%%  Print a defun depending on whether it is traditional or matching.
111
112defun([Def,Name,Args|Rest], D, I, L) when is_atom(Name), (D > 3) or (D < 0) ->
113    Dcs = atom_to_list(Def),                    %Might not actually be defun
114    Ncs = atom_to_list(Name),
115    case lfe_lib:is_symb_list(Args) of
116        true ->                                 %Traditional
117            Acs = term(Args, D-2, I + length(Dcs) + length(Ncs) + 3, L),
118            Tcs = list_tail(Rest, D-3, I+2, L),
119            ["(",Dcs," ",Ncs," ",Acs,Tcs,")"];
120        false ->                                %Matching
121            Tcs = list_tail([Args|Rest], D-2, I+2, L),
122            ["(",Dcs," ",Ncs,Tcs,")"]
123    end;
124defun(List, D, I, L) ->
125    %% Too short to get worked up about, or not a "proper" defun or
126    %% not enough depth.
127    ["(",list(List, D-1, I+1, L),")"].
128
129%% type(List, Depth, Indentation, LineLength, TypeCount) -> [char()].
130%%  Print a special type form indenting first TypeCount elements afer
131%%  type and rest indented 2 steps.
132
133type([Car|Cdr], D, I, L, N) when (D > 2) or (D < 0) ->
134    %% Handle special lists, we KNOW Car is an atom.
135    Cs = atom_to_list(Car),
136    NewI = I + length(Cs) + 2,
137    {Spec,Rest} = split(N, Cdr),
138    Tcs = [list(Spec, D-1, NewI, L),
139           list_tail(Rest, D-2, I+2, L)],
140    ["(" ++ Cs," ",Tcs,")"];
141type(List, D, I, L, _) ->
142    %% Too short to get worked up about or not enough depth.
143    [$(,list(List, D-1, I+1, L),$)].
144
145%% split(N, List) -> {List1,List2}.
146%%  Split a list into two lists, the first containing the first N
147%%  elements and the second the rest. Be tolerant of too few elements.
148
149split(0, L) -> {[],L};
150split(_, []) -> {[],[]};
151split(N, [H|T]) ->
152    {H1,T1} = split(N-1, T),
153    {[H|H1],T1}.
154
155%% list_max(List, Depth, Indentation, LineLength) -> {yes,Chars} | no.
156%%  Maybe print a list on one line, but abort if it goes past
157%%  LineLength.
158
159list_max([], _, _, _) -> {yes,[]};
160list_max(_, 0, _, _) -> {yes,"..."};
161list_max([Car|Cdr], D, I, L) ->
162    Cs = term(Car, D, 0, 99999),                %Never break the line
163    tail_max(Cdr, D-1, I + flatlength(Cs), L, [Cs]).
164
165%% tail_max(Tail, Depth, Indentation, LineLength) -> {yes,Chars} | no.
166%%  Maybe print the tail of a list on one line, but abort if it goes
167%%  past LineLength. We know about dotted pairs. When we reach depth 0
168%%  we just quit as we know necessary "..." will have come from an
169%%  earlier print1 at same depth.
170
171tail_max(_, _, I, L, _) when I >= L -> no;      %No more room
172tail_max([], _, _, _, Acc) -> {yes,reverse(Acc)};
173tail_max(_, 0, _, _, Acc) -> {yes,reverse(Acc, [" ..."])};
174tail_max([Car|Cdr], D, I, L, Acc) ->
175    Cs = term(Car, D, 0, 99999),                %Never break the line
176    tail_max(Cdr, D-1, I + flatlength(Cs) + 1, L, [Cs," "|Acc]);
177tail_max(S, D, I, L, Acc) ->
178    Cs = term(S, D, 0, 99999),                  %Never break the line
179    tail_max([], D-1, I + flatlength(Cs) + 3, L, [Cs," . "|Acc]).
180
181%% list(List, Depth, Indentation, LineLength)
182%%  Print a list, one element per line but print multiple atomic
183%%  elements on one line. No leading/trailing ().
184
185list([], _, _, _) -> [];
186list(_, 0, _, _) -> "...";
187list([Car|Cdr], D, I, L) ->
188    case list_element(Car, I, D, I, L) of
189        {join,Ccs,Cl} ->                        %Atomic that fits
190            [Ccs|list_tail(Cdr, I+Cl, D, I, L)];
191        {break,Ccs,_} ->                        %Atomic that does not fit
192            [Ccs|list_tail(Cdr, L, D, I, L)];
193        {break,Ccs} ->                          %Non-atomic
194            %% Force a break after not an atomic.
195            [Ccs|list_tail(Cdr, L, D, I, L)]
196    end.
197
198%% list_tail(Tail, Depth, Indentation, LineLength)
199%% list_tail(Tail, CurrentLength, Depth, Indentation, LineLength)
200%%  Print the tail of a list decreasing the depth for each element. We
201%%  print multiple atomic elements on one line and we know about
202%%  dotted pairs.
203
204list_tail(Tail, D, I, L) ->
205    list_tail(Tail, L, D, I, L).                %Force a break
206
207list_tail([], _, _, _, _) -> "";
208list_tail(_, _, 0, _, _) -> " ...";
209list_tail([Car|Cdr], CurL, D, I, L) ->
210    case list_element(Car, CurL+1, D, I, L) of
211        {join,Ccs,Cl} ->                        %Atomic that fits
212            [$\s,Ccs,list_tail(Cdr, CurL+1+Cl, D-1, I, L)];
213        {break,Ccs,Cl} ->                       %Atomic that does not fit
214            [newline(I, Ccs),list_tail(Cdr, I+Cl, D-1, I, L)];
215        {break,Ccs} ->                          %Non-atomic
216            %% Force a break after not an atomic.
217            [newline(I, Ccs),list_tail(Cdr, L, D-1, I, L)]
218    end;
219list_tail(Cdr, CurL, D, I, L) ->
220    case list_element(Cdr, CurL+3, D, I, L) of
221        {join,Ccs,_} -> [" . "|Ccs];            %Atomic that fits
222        {break,Ccs,_} ->                        %Atomic that does not fit
223            [" .\n",blanks(I, Ccs)];
224        {break,Ccs} ->                          %Non-atomic
225            [" .\n",blanks(I, Ccs)]
226    end.
227
228list_element(E, CurL, D, _, L) when is_number(E);
229                                    is_atom(E);
230                                    is_pid(E);
231                                    is_reference(E);
232                                    is_port(E);
233                                    is_function(E);
234                                    E =:= [] ->
235    Ecs = lfe_io_write:term(E, D),
236    El = flatlength(Ecs),
237    if CurL+El =< L - 10 -> {join,Ecs,El};      %Don't make the line too wide
238       true -> {break,Ecs,El}
239    end;
240list_element(E, _, D, I, L) ->
241    {break,term(E, D, I, L)}.
242
243blanks(N, Tail) -> string:chars($\s, N, Tail).
244
245newline(N) -> newline(N, []).
246
247newline(N, Tail) ->
248    [$\n|blanks(N, Tail)].
249
250%% indent_type(Form) -> N | none.
251%%  Defines special indentation. None means default, N is number of
252%%  sexprs in list which are indented *after* Form while all following
253%%  that end up at indent+2.
254
255%% Old style forms.
256indent_type('define') -> 1;
257indent_type('define-syntax') -> 1;
258indent_type('define-record') -> 1;
259indent_type('begin') -> 0;
260indent_type('let-syntax') -> 1;
261indent_type('syntax-rules') -> 0;
262indent_type('macro') -> 0;
263%% New style forms.
264indent_type('defmodule') -> 1;
265indent_type('defun') -> defun;
266indent_type('defmacro') -> defun;
267indent_type('defsyntax') -> 1;
268indent_type('defrecord') -> 1;
269indent_type('deftest') -> 1;
270%% Core forms.
271indent_type('progn') -> 0;
272indent_type('lambda') -> 1;
273indent_type('match-lambda') -> 0;
274indent_type('let') -> 1;
275indent_type('let-function') -> 1;
276indent_type('letrec-function') -> 1;
277indent_type('let-macro') -> 1;
278indent_type('if') -> 1;
279indent_type('case') -> 1;
280indent_type('receive') -> 0;
281indent_type('catch') -> 0;
282indent_type('try') -> 1;
283indent_type('funcall') -> 1;
284indent_type('call') -> 2;
285indent_type('eval-when-compile') -> 0;
286indent_type('define-function') -> 1;
287indent_type('define-macro') -> 1;
288indent_type('define-module') -> 1;
289indent_type('extend-module') -> 0;
290indent_type('define-type') -> 1;
291indent_type('define-opaque-type') -> 1;
292indent_type('define-function-spec') -> 1;
293%% Core macros.
294indent_type(':') -> 2;
295indent_type('cond') -> 999;                     %All following forms
296indent_type('let*') -> 1;
297indent_type('flet') -> 1;
298indent_type('flet*') -> 1;
299indent_type('fletrec') -> 1;
300indent_type(macrolet) -> 1;
301indent_type(syntaxlet) -> 1;
302indent_type('do') -> 2;
303indent_type('lc') -> 1;                         %List comprehensions
304indent_type('list-comp') -> 1;
305indent_type('bc') -> 1;                         %Binary comprehensions
306indent_type('binary-comp') -> 1;
307indent_type('match-spec') -> 0;
308indent_type(_) -> none.
309
310%% map(KVs, Depth, Indentation, LineLength).
311%% map_body(KVs, CurrentLineIndent, Depth, Indentation, LineLength)
312%%  Don't include the start and end of the map as this is called from
313%%  differenct functions.
314
315map_body(KVs, D, I, L) ->
316    map_body(KVs, I, D, I, L-1).
317
318map_body([K,V|KVs], CurL, D, I, L) ->
319    case map_assoc(K, V, CurL, D, I, L) of
320        {curr_line,KVcs,KVl} ->                 %Both fit on current line
321            [KVcs,map_rest(KVs, CurL+KVl, D-1, I, L)];
322        {one_line,KVcs,KVl} ->                  %Both fit on one line
323            [KVcs,map_rest(KVs, I+KVl, D-1, I, L)];
324        {sep_lines,Kcs,Vcs} ->                  %On separate lines
325            %% Force a break after K/V split.
326            [Kcs,newline(I, Vcs),map_rest(KVs, L, D-1, I, L)]
327    end;
328map_body(E, CurL, D, I, L) ->
329    map_last(E, CurL, D, I, L).
330
331%% map_rest(KVs, Depth, Indentation, LineLength)
332%% map_rest(KVs, CurrentLineIndent, Depth, Indentation, LineLength)
333
334map_rest(KVs, D, I, L) ->
335    map_rest(KVs, I, D, I, L-1).
336
337map_rest(_, _, 0, _, _) -> " ...";              %Reached our depth
338map_rest([K,V|KVs], CurL, D, I, L) ->
339    case map_assoc(K, V, CurL+1, D, I, L) of
340        {curr_line,KVcs,KVl} ->                 %Both fit on current line
341            [$\s,KVcs,map_rest(KVs, CurL+KVl+1, D-1, I, L)];
342        {one_line,KVcs,KVl} ->                  %Both fit on one line
343            [newline(I, KVcs),map_rest(KVs, I+KVl, D-1, I, L)];
344        {sep_lines,Kcs,Vcs} ->                  %On separate lines
345            %% Force a break after K/V split.
346            [newline(I, Kcs),newline(I, Vcs),map_rest(KVs, L, D-1, I, L)]
347    end;
348map_rest(E, CurL, D, I, L) ->
349    map_last(E, CurL, D, I, L).
350
351%% Print any remaining element as list element.
352map_last(Tail, CurL, D, I, L) ->
353    list_tail(Tail, CurL, D, I, L).
354
355map_assoc(K, V, CurL, D, I, L) ->
356    Kcs = term(K, D, 0, 99999),                 %Never break the line
357    Kl = flatlength(Kcs),
358    Vcs = term(V, D, 0, 99999),                 %Never break the line
359    Vl = flatlength(Vcs),
360    if CurL+Kl+Vl < L-10 ->                     %Both fit on current line
361            {curr_line,[Kcs,$\s,Vcs],Kl+1+Vl};
362       I+Kl+Vl < L-10 ->                        %Both fit on one line
363            {one_line,[Kcs,$\s,Vcs],Kl+1+Vl};
364       true ->                                  %On separate lines
365            %% Try to reuse flat prints if they fit on one line.
366            Ks = if I+Kl < L-10 -> Kcs;
367                    true -> term(K, D, I, L)
368                 end,
369            Vs = if I+Vl < L-10 -> Vcs;
370                    true -> term(V, D, I, L)
371                 end,
372            {sep_lines,Ks,Vs}
373    end.
374
375%% last_length(Chars) -> Length.
376%% last_length(Chars, CurrentLine) -> Length.
377%%  Return the length of the last line in the text.
378
379last_length(S) -> last_length(S, 0).
380
381last_length([H|T], L0) when is_list(H) ->
382    L1 = last_length(H, L0),                    %Must go left-to-right
383    last_length(T, L1);
384last_length([$\n|T], _) ->
385    last_length(T, 0);
386last_length([_|T], L) ->
387    last_length(T, L+1);
388last_length([], L) -> L.
389