Commit | Line | Data |
1444edde |
1 | package DX::TraceFormatter; |
381e8dad |
2 | |
c25fbf05 |
3 | use Scalar::Util qw(blessed); |
1444edde |
4 | use List::Util qw(min); |
381e8dad |
5 | use DX::Class; |
6 | |
6162b001 |
7 | our $WS; |
8 | our $Extra = 0; |
9 | |
1444edde |
10 | has ambient_indent_level => ( |
2548ce61 |
11 | is => 'rwp', lazy => 1, clearer => 1, default => 0, isa => Int |
1444edde |
12 | ); |
13 | |
381e8dad |
14 | sub indent_by { ' ' } |
15 | |
6162b001 |
16 | sub max_width { 78 } |
17 | |
c25fbf05 |
18 | sub format { |
381e8dad |
19 | my ($self, $thing) = @_; |
1444edde |
20 | local our $Indent_Level = $self->ambient_indent_level; |
21 | my $unindented = $self->_format($thing); |
22 | my $indent_level = min($Indent_Level, $self->ambient_indent_level); |
23 | (my $indented = $unindented) |
24 | =~ s/^/${\($self->indent_by x $indent_level)}/mg; |
25 | return $indented; |
7f385fb2 |
26 | } |
27 | |
c25fbf05 |
28 | sub _format { |
29 | my ($self, $thing) = @_; |
30 | my ($as, $data) = @{blessed($thing) ? $thing->for_deparse : $thing}; |
3cc9323e |
31 | # return $self->${\"_format_as_${as}"}($data); if $WS eq "\n"; |
6162b001 |
32 | local $WS = ' '; |
3cc9323e |
33 | my $spaced = $self->${\"_format_as_${as}"}($data); |
6162b001 |
34 | if ($spaced =~ /\n/ |
35 | or (length($spaced) |
36 | > ($self->max_width - |
37 | ((length($self->indent_by) * our $Indent_Level) + $Extra))) |
38 | ) { |
39 | local $WS = "\n"; |
40 | local $Extra = 0; |
41 | return $self->${\"_format_as_${as}"}($data); |
42 | } |
43 | return $spaced; |
44 | } |
45 | |
46 | sub _format_as_word_and_body { |
47 | my ($self, $wb) = @_; |
48 | my ($word, $body) = @$wb; |
49 | my $word_f = $self->_format_as_maybe_bareword($word).' '; |
50 | local $Extra = length($word_f); |
51 | return $word_f.$self->_format($body); |
381e8dad |
52 | } |
53 | |
c25fbf05 |
54 | sub _format_indented { |
f69aaaff |
55 | my ($self, $thing) = @_; |
56 | return $self->_format($thing) if $WS eq ' '; |
c25fbf05 |
57 | our $Indent_Level; |
58 | local $Indent_Level = $Indent_Level + 1; |
f69aaaff |
59 | my $unindented = $self->_format($thing); |
c25fbf05 |
60 | (my $indented = $unindented) =~ s/^/${\$self->indent_by}/mg; |
61 | return $indented; |
1e812b19 |
62 | } |
63 | |
c25fbf05 |
64 | sub _format_as_string { |
65 | my ($self, $val) = @_; |
1e812b19 |
66 | # TODO: multiline handling |
381e8dad |
67 | if ($val =~ /^\w+$/) { |
68 | qq{'${val}'} |
69 | } else { |
70 | qq{{'${val}'}} |
71 | } |
72 | } |
73 | |
c25fbf05 |
74 | sub _format_as_symbol { $_[1] } |
1e812b19 |
75 | |
c25fbf05 |
76 | sub _format_as_maybe_bareword { |
77 | my ($self, $maybe_bareword) = @_; |
78 | # should stringify if required |
79 | return $maybe_bareword; |
39351e10 |
80 | } |
81 | |
c25fbf05 |
82 | sub _format_as_number { $_[1] } |
1e812b19 |
83 | |
c25fbf05 |
84 | sub _format_as_boolean { $_[1] ? 'true' : 'false' } |
1e812b19 |
85 | |
c25fbf05 |
86 | sub _format_as_unset { 'unset' } |
e442aff8 |
87 | |
c25fbf05 |
88 | sub _format_as_array { |
89 | my ($self, $members) = @_; |
6162b001 |
90 | join $WS, |
91 | '{[', |
f69aaaff |
92 | (map $self->_format_indented($_), @$members) |
6162b001 |
93 | , ']}'; |
1e812b19 |
94 | } |
95 | |
c25fbf05 |
96 | sub _format_as_dict { |
97 | my ($self, $members) = @_; |
6162b001 |
98 | join $WS, '{{', ( |
f69aaaff |
99 | map $self->_format_indented( |
6162b001 |
100 | [ word_and_body => [ $_, $members->{$_} ] ], |
f69aaaff |
101 | ), sort keys %$members |
c25fbf05 |
102 | ), '}}'; |
693f2d6d |
103 | } |
104 | |
c25fbf05 |
105 | sub _format_as_statement { |
106 | my ($self, $parts) = @_; |
107 | join ' ', map $self->_format($_), @$parts; |
061f9d55 |
108 | } |
109 | |
c25fbf05 |
110 | sub _format_as_value_path { |
111 | my ($self, $parts) = @_; |
112 | join '.', map $self->_format_as_maybe_bareword($_), @$parts; |
693f2d6d |
113 | } |
1e812b19 |
114 | |
c25fbf05 |
115 | sub _format_as_list { |
116 | my ($self, $members) = @_; |
6162b001 |
117 | join $WS, '{', ( |
f69aaaff |
118 | map $self->_format_indented($_), @$members |
c25fbf05 |
119 | ), '}'; |
1e812b19 |
120 | } |
121 | |
c25fbf05 |
122 | sub _format_as_pairs { |
123 | my ($self, $members) = @_; |
6162b001 |
124 | join $WS, '{', ( |
f69aaaff |
125 | map $self->_format_indented( |
6162b001 |
126 | [ word_and_body => $_ ] |
f69aaaff |
127 | ), @$members |
c25fbf05 |
128 | ), '}'; |
1e812b19 |
129 | } |
381e8dad |
130 | |
c25fbf05 |
131 | sub _format_as_block { |
132 | my ($self, $members) = @_; |
6162b001 |
133 | join $WS, '{', ( |
134 | join +($WS eq ' ' ? '; ' : $WS), |
f69aaaff |
135 | map $self->_format_indented($_), @$members |
c25fbf05 |
136 | ), '}'; |
56f90161 |
137 | } |
138 | |
1444edde |
139 | sub _format_as_enter_block { |
140 | my ($self) = @_; |
141 | $self->_set_ambient_indent_level($self->ambient_indent_level + 1); |
142 | '{' |
143 | } |
144 | |
145 | sub _format_as_leave_block { |
146 | my ($self) = @_; |
147 | $self->_set_ambient_indent_level($self->ambient_indent_level - 1); |
148 | '}' |
149 | } |
150 | |
381e8dad |
151 | 1; |