lib/DX/Deparse.pm

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