pervasive type constraints

[scpubgit/DX.git] / lib / DX / TraceFormatter.pm

package DX::TraceFormatter;

use Scalar::Util qw(blessed);
use List::Util qw(min);
use DX::Class;

our $WS;
our $Extra = 0;

has ambient_indent_level => (
  is => 'rwp', lazy => 1, clearer => 1, default => 0, isa => Int
);

sub indent_by { '    ' }

sub max_width { 78 }

sub format {
  my ($self, $thing) = @_;
  local our $Indent_Level = $self->ambient_indent_level;
  my $unindented = $self->_format($thing);
  my $indent_level = min($Indent_Level, $self->ambient_indent_level);
  (my $indented = $unindented)
    =~ s/^/${\($self->indent_by x $indent_level)}/mg;
  return $indented;
}

sub _format {
  my ($self, $thing) = @_;
  my ($as, $data) = @{blessed($thing) ? $thing->for_deparse : $thing};
  local $WS = ' ';
  my $spaced = $self->${\"_format_as_${as}"}($data);#
  if ($spaced =~ /\n/
      or (length($spaced)
           > ($self->max_width -
               ((length($self->indent_by) * our $Indent_Level) + $Extra)))
  ) {
    local $WS = "\n";
    local $Extra = 0;
    return $self->${\"_format_as_${as}"}($data);
  }
  return $spaced;
}

sub _format_as_word_and_body {
  my ($self, $wb) = @_;
  my ($word, $body) = @$wb;
  my $word_f = $self->_format_as_maybe_bareword($word).' ';
  local $Extra = length($word_f);
  return $word_f.$self->_format($body);
}

sub _format_indented {
  my ($self, $thing) = @_;
  return $self->_format($thing) if $WS eq ' ';
  our $Indent_Level;
  local $Indent_Level = $Indent_Level + 1;
  my $unindented = $self->_format($thing);
  (my $indented = $unindented) =~ s/^/${\$self->indent_by}/mg;
  return $indented;
}

sub _format_as_string {
  my ($self, $val) = @_;
  # TODO: multiline handling
  if ($val =~ /^\w+$/) {
    qq{'${val}'}
  } else {
    qq{{'${val}'}}
  }
}

sub _format_as_symbol { $_[1] }

sub _format_as_maybe_bareword {
  my ($self, $maybe_bareword) = @_;
  # should stringify if required
  return $maybe_bareword;
}

sub _format_as_number { $_[1] }

sub _format_as_boolean { $_[1] ? 'true' : 'false' }

sub _format_as_unset { 'unset' }

sub _format_as_array {
  my ($self, $members) = @_;
  join $WS,
    '{[',
    (map $self->_format_indented($_), @$members)
    , ']}';
}

sub _format_as_dict {
  my ($self, $members) = @_;
  join $WS, '{{', (
    map $self->_format_indented(
      [ word_and_body => [ $_, $members->{$_} ] ],
    ), sort keys %$members
  ), '}}';
}

sub _format_as_statement {
  my ($self, $parts) = @_;
  join ' ', map $self->_format($_), @$parts;
}

sub _format_as_value_path {
  my ($self, $parts) = @_;
  join '.', map $self->_format_as_maybe_bareword($_), @$parts;
}

sub _format_as_list {
  my ($self, $members) = @_;
  join $WS, '{', (
    map $self->_format_indented($_), @$members
  ), '}';
}

sub _format_as_pairs {
  my ($self, $members) = @_;
  join $WS, '{', (
    map $self->_format_indented(
      [ word_and_body => $_ ]
    ), @$members
  ), '}';
}

sub _format_as_block {
  my ($self, $members) = @_;
  join $WS, '{', (
    join +($WS eq ' ' ? '; ' : $WS),
      map $self->_format_indented($_), @$members
  ), '}';
}

sub _format_as_enter_block {
  my ($self) = @_;
  $self->_set_ambient_indent_level($self->ambient_indent_level + 1);
  '{'
}

sub _format_as_leave_block {
  my ($self) = @_;
  $self->_set_ambient_indent_level($self->ambient_indent_level - 1);
  '}'
}

1;