lib/DX/Expander.pm

   1 package DX::Expander;
   2
   3 use DX::Utils qw(:all);
   4 use DX::Value::True;
   5 use DX::Value::False;
   6 use Types::Standard qw(InstanceOf);
   7 use Tcl;
   8 use DX::Class;
   9
  10 has tcl => (
  11   is => 'lazy', builder => sub { Tcl->new }, isa => InstanceOf['Tcl'],
  12   handles => { _split_list => 'SplitList' },
  13 );
  14
  15 sub expand_args {
  16   my ($self, @args) = @_;
  17   map { $self->expand_one($_) } @args;
  18 }
  19
  20 sub expand_proposition {
  21   my ($self, $prop) = @_;
  22   my ($name, @args) = $self->_split_list($prop);
  23   proposition($name, $self->expand_args(@args));
  24 }
  25
  26 my @exp_t = map { [ qr/\A(\s*)${\$_->[1]}\s*\Z/, 'expand_'.$_->[0] ] } (
  27   [ number => qr/([\d.]+)/ ],
  28   [ string => qr/'(.*)'/s ],
  29   [ bool => qr/(true|false)/ ],
  30   # foo or Foo or ?Foo or _Foo or ?_Foo
  31   [ symbol => qr/((?:[a-z]|\??[A-Z_])[a-zA-Z0-9_]*)/ ],
  32   [ dict => qr/{(.*)}/s ],
  33   [ array => qr/\[(.*)\]/s ],
  34 );
  35
  36 sub expand_one {
  37   my ($self, $exp) = @_;
  38   foreach my $try (@exp_t) {
  39     my ($re, $meth) = @$try;
  40     $exp =~ $re and return $self->$meth($2, $1);
  41   }
  42   die 'Uhhhh ... '.$exp;
  43 }
  44
  45 sub expand_number { number($_[1]) }
  46
  47 sub expand_string {
  48   my ($self, $exp, $ws) = @_;
  49   return string($exp) unless $ws =~ s/.*\n//s;
  50   my $wstrip = length($ws)+1;
  51   $exp =~ s/^ {1,$wstrip}//mg;
  52   return string($exp);
  53 }
  54
  55 sub expand_symbol { $_[1] }
  56
  57 sub expand_dict {
  58   my ($self, $val) = @_;
  59   my @pairs = $self->_split_list($val);
  60   die "Uneven dict" if @pairs % 2;
  61   dict(map {
  62     $pairs[2*$_] => $self->expand_one($pairs[(2*$_)+1])
  63   } 0..int($#pairs/2))
  64 }
  65
  66 sub expand_array { die;
  67 }
  68
  69 sub expand_bool {
  70   ('DX::Value::'.ucfirst($_[1]))->new
  71 }
  72
  73 1;