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