lib/DX/TraceFormatter.pm

   1 package DX::TraceFormatter;
   2
   3 use Scalar::Util qw(blessed);
   4 use curry;
   5 use List::Util qw(min);
   6 use DX::Class;
   7
   8 has ambient_indent_level => (
   9   is => 'rwp', lazy => 1, clearer => 1, default => 0
  10 );
  11
  12 sub indent_by { '    ' }
  13
  14 sub format {
  15   my ($self, $thing) = @_;
  16   local our $Indent_Level = $self->ambient_indent_level;
  17   my $unindented = $self->_format($thing);
  18   my $indent_level = min($Indent_Level, $self->ambient_indent_level);
  19   (my $indented = $unindented)
  20     =~ s/^/${\($self->indent_by x $indent_level)}/mg;
  21   return $indented;
  22 }
  23
  24 sub _format {
  25   my ($self, $thing) = @_;
  26   my ($as, $data) = @{blessed($thing) ? $thing->for_deparse : $thing};
  27   $self->${\"_format_as_${as}"}($data);
  28 }
  29
  30 sub _format_indented {
  31   my ($self, $cb) = @_;
  32   our $Indent_Level;
  33   local $Indent_Level = $Indent_Level + 1;
  34   my $unindented = $cb->();
  35   (my $indented = $unindented) =~ s/^/${\$self->indent_by}/mg;
  36   return $indented;
  37 }
  38
  39 sub _format_as_string {
  40   my ($self, $val) = @_;
  41   # TODO: multiline handling
  42   if ($val =~ /^\w+$/) {
  43     qq{'${val}'}
  44   } else {
  45     qq{{'${val}'}}
  46   }
  47 }
  48
  49 sub _format_as_symbol { $_[1] }
  50
  51 sub _format_as_maybe_bareword {
  52   my ($self, $maybe_bareword) = @_;
  53   # should stringify if required
  54   return $maybe_bareword;
  55 }
  56
  57 sub _format_as_number { $_[1] }
  58
  59 sub _format_as_boolean { $_[1] ? 'true' : 'false' }
  60
  61 sub _format_as_unset { 'unset' }
  62
  63 sub _format_as_array {
  64   my ($self, $members) = @_;
  65   join ' ', '{[', (map $self->_format($_), @$members), ']}';
  66 }
  67
  68 sub _format_as_dict {
  69   my ($self, $members) = @_;
  70   join ' ', '{{', (
  71     map +(
  72       $self->_format_as_maybe_bareword($_),
  73       $self->_format($members->{$_}),
  74     ), sort keys %$members
  75   ), '}}';
  76 }
  77
  78 sub _format_as_statement {
  79   my ($self, $parts) = @_;
  80   join ' ', map $self->_format($_), @$parts;
  81 }
  82
  83 sub _format_as_value_path {
  84   my ($self, $parts) = @_;
  85   join '.', map $self->_format_as_maybe_bareword($_), @$parts;
  86 }
  87
  88 sub _format_as_list {
  89   my ($self, $members) = @_;
  90   join "\n", '{', (
  91     map $self->_format_indented($self->curry::_format($_)), @$members
  92   ), '}';
  93 }
  94
  95 sub _format_as_pairs {
  96   my ($self, $members) = @_;
  97   join "\n", '{', (
  98     map $self->_format_indented(sub {
  99           $self->_format_as_maybe_bareword($_->[0])
 100             .' '.$self->_format($_->[1])
 101         }), @$members
 102   ), '}';
 103 }
 104
 105 sub _format_as_block {
 106   my ($self, $members) = @_;
 107   join "\n", '{', (
 108     map $self->_format_indented($self->curry::_format($_)), @$members
 109   ), '}';
 110 }
 111
 112 sub _format_as_enter_block {
 113   my ($self) = @_;
 114   $self->_set_ambient_indent_level($self->ambient_indent_level + 1);
 115   '{'
 116 }
 117
 118 sub _format_as_leave_block {
 119   my ($self) = @_;
 120   $self->_set_ambient_indent_level($self->ambient_indent_level - 1);
 121   '}'
 122 }
 123
 124 1;