show resolve step dependency info
[scpubgit/DX.git] / lib / DX / Deparse.pm
CommitLineData
381e8dad 1package DX::Deparse;
2
3use DX::Class;
4
5sub indent_by { ' ' }
6
7sub max_width { 78 }
8
9sub _inner_meta {
10 my ($self, $ometa) = @_;
11 +{ %$ometa, width_left => $ometa->{width_left} - length $self->indent_by };
12}
13
14sub _indent_one {
15 my ($self, $to_indent) = @_;
16 $to_indent =~ s/^/${\$self->indent_by}/mg;
17 $to_indent;
18}
19
20sub fmt {
21 my ($self, $thing) = @_;
22 $self->_fmt($thing, { width_left => $self->max_width })."\n";
23}
24
25sub _fmt {
26 my ($self, $thing, $meta) = @_;
4016201b 27 return '{}' unless defined($thing);
381e8dad 28 return $thing unless ref($thing);
1e812b19 29 my $type = join'_', split '::', lc +(ref($thing) =~ /^(?:DX::)?(.*)/)[0];
381e8dad 30 $self->${\"_fmt_${type}"}($thing, $meta);
31}
32
33sub _fmt_value_dict {
1e812b19 34 my ($self, $dict, $meta) = @_;
35 my $chunks = $self->_fmt_pairs([
36 map [ $_, $dict->get_member_at($_) ], $dict->index_list
37 ], $meta);
38 return '{{ }}' unless $chunks =~ /\S/;
061f9d55 39 s/^\s+//, s/\n\s+/ /g for (my $maybe = $chunks);
40 return "{{ ${maybe} }}" if length($maybe) < $meta->{width_left};
381e8dad 41 "{{\n${chunks}\n}}";
42}
43
1e812b19 44sub _fmt_pairs {
45 my ($self, $pairs, $ometa) = @_;
46 my $imeta = $self->_inner_meta($ometa);
47 $self->_indent_one(join "\n", map {
48 join ' ', map $self->_fmt($_, $imeta), @$_
49 } @$pairs);
50}
51
381e8dad 52sub _fmt_value_string {
53 my ($self, $string) = @_;
1e812b19 54 # TODO: multiline handling
381e8dad 55 my $val = $string->string_value;
56 if ($val =~ /^\w+$/) {
57 qq{'${val}'}
58 } else {
59 qq{{'${val}'}}
60 }
61}
62
63sub _fmt_value_number { $_[1]->number_value }
64
65sub _fmt_value_true { 'true' }
66
67sub _fmt_value_false { 'false' }
68
1e812b19 69sub _fmt_value_unset { 'unset' }
70
71sub _fmt_object {
72 my ($self, $pairs, $meta) = @_;
73 my $chunks = $self->_fmt_pairs($pairs, $meta);
74 return '{ }' unless $chunks =~ /\S/;
061f9d55 75 s/^\s+//, s/\n\s+/ /g for (my $maybe = $chunks);
76 return "{ ${maybe} }" if length($maybe) < $meta->{width_left};
1e812b19 77 "{\n${chunks}\n}"
78}
79
80sub _fmt_hypothesis {
81 my ($self, $hyp, $meta) = @_;
82 $self->_fmt_object([
83 map [ $_ => $hyp->$_ ],
9ccd6caf 84 qw(actions resolved_propositions scope)
1e812b19 85 ], $meta);
86}
87
88sub _fmt_array {
89 my ($self, $ary, $ometa) = @_;
90 my $imeta = $self->_inner_meta($ometa);
91 my $chunks = $self->_indent_one(
92 join "\n", map $self->_fmt($_, $imeta), @$ary
93 );
94 return '{ }' unless $chunks =~ /\S/;
95 "{\n${chunks}\n}";
96}
97
39351e10 98sub _fmt_glob {
99 my ($self, $glob, $meta) = @_;
100 return ((''.*$glob) =~ /::([A-Z_]+)$/)[0];
101}
102
1e812b19 103sub _fmt_action_setvalue {
104 my ($self, $action, $meta) = @_;
105 $self->_fmt_action_generic(SetValue => $action, $meta);
106}
107
108sub _fmt_action_addvalue {
109 my ($self, $action, $meta) = @_;
110 $self->_fmt_action_generic(AddValue => $action, $meta);
111}
112
1e90aa03 113sub _fmt_action_bindvalue {
114 my ($self, $action, $meta) = @_;
13e9d35a 115 my $path = join '.', map $self->_fmt($_, $meta), @{$action->target_path};
116 my $bound_path = join '.',
117 map $self->_fmt($_, $meta),
118 @{$action->new_value
119 ->action_builder
120 ->inner_action_builder
121 ->target_path};
122 join ' ', BindValue => $path, $bound_path;
1e90aa03 123}
124
5b066a1c 125sub _fmt_action_addboundvalue {
126 my ($self, $action, $meta) = @_;
127 $self->_fmt_action_generic(AddBoundValue => $action, $meta);
128}
129
e442aff8 130sub _fmt_action_setboundvalue {
131 my ($self, $action, $meta) = @_;
132 $self->_fmt_action_generic(SetBoundValue => $action, $meta);
133}
134
1e812b19 135sub _fmt_action_generic {
136 my ($self, $name, $action, $meta) = @_;
137 my $path = join '.', map $self->_fmt($_, $meta), @{$action->target_path};
138 join ' ', $name, $path, $self->_fmt($action->new_value, $meta);
139}
140
693f2d6d 141sub _fmt_resolvedpropositionset {
142 my ($self, $rps, $meta) = @_;
39351e10 143 $self->_fmt_object([
144 map {
061f9d55 145 [ $_, [
146 map bless([ @$_ ], 'DX::Dependency'),
147 map @{$_}[1..$#$_],
148 @{$rps->dependencies_for($_)}
149 ] ]
39351e10 150 } @{$rps->propositions},
151 ], $meta);
693f2d6d 152}
153
061f9d55 154sub _fmt_dependency {
155 my ($self, $dep, $meta) = @_;
156 '{ '.join(' ', map $self->_fmt($_, $meta), @$dep).' }'
157}
158
693f2d6d 159sub _fmt_proposition {
160 my ($self, $prop, $meta) = @_;
161 join ' ',
162 $prop->predicate,
e08346a8 163 map $self->_fmt($_, $meta),
164 map +((!ref($_) and $prop->introduced_names->{$_}) ? "?$_" : $_),
165 @{$prop->args};
693f2d6d 166}
1e812b19 167
168sub _fmt_scope {
169 my ($self, $scope, $meta) = @_;
170 $self->_fmt_object([
171 [ W => $scope->globals ],
172 map [ $_ => $scope->locals->[$_] ], 0..$#{$scope->locals}
173 ], $meta);
174}
175
176sub _fmt_searchstate {
177 my ($self, $ss, $meta) = @_;
178 $self->_fmt_object([
179 [ alternatives => '{...}' ],
180 [ current_hypothesis => $ss->current_hypothesis ],
181 ], $meta);
182}
381e8dad 183
56f90161 184sub _fmt_step_considerproposition {
cdf7d310 185 my ($self, $step, $meta) = @_;
56f90161 186 'consider '.$self->_fmt($step->proposition, $meta);
187}
188
189sub _fmt_step_resolveproposition {
190 my ($self, $step, $meta) = @_;
191 'resolve '.$self->_fmt_object([
cdf7d310 192 [ actions => $step->actions ],
56f90161 193 ($step->alternative_step
194 ? [ alternative_step => '...' ]
195 : ()),
57542e07 196 [ depends_on => [
197 map bless([ @$_ ], 'DX::Dependency'),
198 map @{$_}[1..$#$_],
199 @{$step->depends_on}
200 ] ],
cdf7d310 201 ], $meta);
202}
203
56f90161 204sub _fmt_step_backtrack { 'backtrack' }
205
206sub _fmt_step_markassolution { 'mark as solution' }
207
208sub _fmt_step_enterrecheck {
209 my ($self, $step, $meta) = @_;
210 'recheck '.$self->_fmt($step->proposition_list->[0], $meta);
211}
212
213sub _fmt_step_completerecheck { 'complete recheck' }
214
215sub _fmt_step_failrecheck { 'fail recheck' }
216
381e8dad 2171;