Commit | Line | Data |
b40e416a |
1 | package DX::RuleSet; |
2 | |
3 | use Moo; |
4 | use DX::Op::CallRule; |
5 | use DX::Op::MemberOf; |
b40e416a |
6 | use DX::Op::ApplyConstraint; |
7 | use DX::Op::Return; |
734376d9 |
8 | use DX::Op::Cut; |
b40e416a |
9 | use List::Util qw(reduce); |
10 | |
11 | has rules => (is => 'ro', default => sub { {} }); |
12 | |
13 | sub add_rule { |
14 | my ($self, $name, $vars, @body) = @_; |
15 | my $full_name = join('/', $name, scalar @$vars); |
16 | push @{$self->rules->{$full_name}}, $self->_make_rule($vars, @body); |
17 | return $self; |
18 | } |
19 | |
20 | sub _make_rule { |
21 | my ($self, $vars, @body) = @_; |
22 | my $head = reduce { $b->but(next => $a) } |
23 | DX::Op::Return->new, |
24 | reverse map $self->expand(@$_), @body; |
25 | [ $vars, $head ]; |
26 | } |
27 | |
28 | sub expand { |
29 | my ($self, $type, @rest) = @_; |
6d533c9d |
30 | if ($self->can(my $expand_meth = "_expand_${type}")) { |
31 | return $self->$expand_meth(@rest); |
32 | } |
33 | return $self->_expand_call($type, @rest); |
b40e416a |
34 | } |
35 | |
36 | sub _expand_call { |
37 | my ($self, $name, @args) = @_; |
38 | DX::Op::CallRule->new(rule_name => $name, rule_args => \@args); |
39 | } |
40 | |
734376d9 |
41 | sub _expand_cut { return DX::Op::Cut->new } |
42 | |
b40e416a |
43 | sub _expand_member_of { |
385fa954 |
44 | my ($self, $member_var, $coll_var) = @_; |
b40e416a |
45 | DX::Op::MemberOf->new( |
46 | member_var => $member_var, |
385fa954 |
47 | coll_var => $coll_var, |
b40e416a |
48 | ); |
49 | } |
50 | |
b40e416a |
51 | sub _expand_constrain { |
52 | my ($self, $vars, $constraint) = @_; |
53 | DX::Op::ApplyConstraint->new( |
54 | vars => $vars, |
55 | constraint => $constraint |
56 | ); |
57 | } |
58 | |
59 | 1; |