lib/DX/TraceFormatter.pm

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