lib/DX/Deparse.pm

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