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_value_dict {
  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/;
  39   "{{\n${chunks}\n}}";
  40 }
  41
  42 sub _fmt_pairs {
  43   my ($self, $pairs, $ometa) = @_;
  44   my $imeta = $self->_inner_meta($ometa);
  45   $self->_indent_one(join "\n", map {
  46     join ' ', map $self->_fmt($_, $imeta), @$_
  47   } @$pairs);
  48 }
  49
  50 sub _fmt_value_string {
  51   my ($self, $string) = @_;
  52   # TODO: multiline handling
  53   my $val = $string->string_value;
  54   if ($val =~ /^\w+$/) {
  55     qq{'${val}'}
  56   } else {
  57     qq{{'${val}'}}
  58   }
  59 }
  60
  61 sub _fmt_value_number { $_[1]->number_value }
  62
  63 sub _fmt_value_true { 'true' }
  64
  65 sub _fmt_value_false { 'false' }
  66
  67 sub _fmt_value_unset { 'unset' }
  68
  69 sub _fmt_object {
  70   my ($self, $pairs, $meta) = @_;
  71   my $chunks = $self->_fmt_pairs($pairs, $meta);
  72   return '{ }' unless $chunks =~ /\S/;
  73   "{\n${chunks}\n}"
  74 }
  75
  76 sub _fmt_hypothesis {
  77   my ($self, $hyp, $meta) = @_;
  78   $self->_fmt_object([
  79     map [ $_ => $hyp->$_ ],
  80       qw(actions outstanding_propositions resolved_propositions scope)
  81   ], $meta);
  82 }
  83
  84 sub _fmt_array {
  85   my ($self, $ary, $ometa) = @_;
  86   my $imeta = $self->_inner_meta($ometa);
  87   my $chunks = $self->_indent_one(
  88     join "\n", map $self->_fmt($_, $imeta), @$ary
  89   );
  90   return '{ }' unless $chunks =~ /\S/;
  91   "{\n${chunks}\n}";
  92 }
  93
  94 sub _fmt_glob {
  95   my ($self, $glob, $meta) = @_;
  96   return ((''.*$glob) =~ /::([A-Z_]+)$/)[0];
  97 }
  98
  99 sub _fmt_action_setvalue {
 100   my ($self, $action, $meta) = @_;
 101   $self->_fmt_action_generic(SetValue => $action, $meta);
 102 }
 103
 104 sub _fmt_action_addvalue {
 105   my ($self, $action, $meta) = @_;
 106   $self->_fmt_action_generic(AddValue => $action, $meta);
 107 }
 108
 109 sub _fmt_action_generic {
 110   my ($self, $name, $action, $meta) = @_;
 111   my $path = join '.', map $self->_fmt($_, $meta), @{$action->target_path};
 112   join ' ', $name, $path, $self->_fmt($action->new_value, $meta);
 113 }
 114
 115 sub _fmt_resolvedpropositionset {
 116   my ($self, $rps, $meta) = @_;
 117   $self->_fmt_object([
 118     map {
 119       [ $_, $rps->dependencies_for($_) ]
 120     } @{$rps->propositions},
 121   ], $meta);
 122 }
 123
 124 sub _fmt_proposition {
 125   my ($self, $prop, $meta) = @_;
 126   join ' ',
 127     $prop->predicate,
 128     map $self->_fmt($_, $meta), @{$prop->args};
 129 }
 130
 131 sub _fmt_scope {
 132   my ($self, $scope, $meta) = @_;
 133   $self->_fmt_object([
 134     [ W => $scope->globals ],
 135     map [ $_ => $scope->locals->[$_] ], 0..$#{$scope->locals}
 136   ], $meta);
 137 }
 138
 139 sub _fmt_searchstate {
 140   my ($self, $ss, $meta) = @_;
 141   $self->_fmt_object([
 142     [ alternatives => '{...}' ],
 143     [ current_hypothesis => $ss->current_hypothesis ],
 144   ], $meta);
 145 }
 146
 147 1;