I have a rule that is failing to commit. This is the rule:
when {
$t isa person;
$car isa car;
$t2 isa person;
$r ($t, $car) isa ownership;
$r2 ($t2, $car) isa ownership;
}, then {
$car has age 23;
($car, $t2) isa ownership;
};
This is the error that I get after I commit this:
INVALID_ARGUMENT: InvalidKBException-A structural validation error has occurred. Please correct the [`1`] errors found.
The rule [rule-32] does not form a valid clause, as it contains a multi-atom head
. Please check server logs for the stack trace.
All uncommitted data is cleared
A rule can only infer one fact:
In Graql, the “when” part of the rule is required to be a conjunctive
pattern, whereas the “then” should be atomic - each rule can derive a
single fact only
docs
What #Jon T said is correct, and therefore the solution specific to your problem is to split the rule into two rules.
Both rules will have an identical when clause where the then clause has exactly one conclusion:
when {
$t isa person;
$car isa car;
$t2 isa person;
$r ($t, $car) isa ownership;
$r2 ($t2, $car) isa ownership;
}, then {
$car has age 23;
};
when {
$t isa person;
$car isa car;
$t2 isa person;
$r ($t, $car) isa ownership;
$r2 ($t2, $car) isa ownership;
}, then {
($car, $t2) isa ownership;
};
Related
Now have:
has 'id' => (
is => 'rw',
isa => 'Str',
default => sub { "id" . int(rand(1000))+1 }
);
Works OK, the:
PKG->new(id => 'some'); #the id is "some"
PKG->new() #the id is #id<random_number>
In the next scenario:
my $value = undef;
PKG->new(id => $value);
(of course) got an error:
Attribute (id) does not pass the type constraint because: Validation failed for 'Str' with value undef at /Users/me/perl5/perlbrew/perls/perl-5.16.3/lib/site_perl/5.16.3/darwin-thread-multi-2level/Moose/Exception.pm line 37
The question is:
How to achieve changing the value after it is set to undef (and only when it is $undef)? So,
has 'id' => (
is => 'rw',
isa => 'Str|Undef', #added undef to acceptable Type
default => sub { "id" . int(rand(1000))+1 }
);
Now, it accepting the $undef, but I don't want $undef but want "id" . int(rand(1000))+1. How to change the attribute value after it is set?
The after is called only for the accessors not for constructors. Maybe some weird coercion from Undef to Str - but only for this one attribute?
Ps: using the PKG->new( id => $value // int(rand(10000)) ) is not an acceptable solution. The module should accept the $undef and should silently change it to the random number.
Type::Tiny has as one of its aims to make it easy to add coercions to individual attributes really easy. Here's an example:
use strict;
use warnings;
{
package Local::Test;
use Moose;
use Types::Standard qw( Str Undef );
my $_id_default = sub { "id" . int(rand(1000)+1) };
has id => (
is => 'rw',
isa => Str->plus_coercions(Undef, $_id_default),
default => $_id_default,
coerce => 1,
);
__PACKAGE__->meta->make_immutable;
}
print Local::Test->new(id => 'xyz123')->dump;
print Local::Test->new(id => undef)->dump;
print Local::Test->new->dump;
You could also look at MooseX::UndefTolerant which makes undef values passed to the constructor act as if they were entirely omitted. This won't cover passing undef to accessors though; just constructors.
Here is an alternative, using Moose' BUILD method, which is called after an object is created.
#!/usr/bin/perl
package Test;
use Moose;
has 'id' => (
is => 'rw',
isa => 'Str|Undef',
);
sub BUILD {
my $self = shift;
unless($self->id){
$self->id("id" . (int(rand(1000))+1));
}
}
1;
package Main;
my $test = Test->new(id => undef);
print $test->id; ###Prints random number if id=> undef
More info on BUILD here:
http://metacpan.org/pod/Moose::Manual::Construction#BUILD
#choroba in a comment mentioned about the triggers. Based on this, found a next solution. The trigger is called twice in the case id=>undef, but otherwise it works.
use Modern::Perl;
package My;
use namespace::sweep;
use Moose;
my $_id_default = sub { "id" . int(rand(100_000_000_000)+1) };
my $_check_id = sub { $_[0]->id(&$_id_default) unless $_[1] };
has id => (
is => 'rw',
isa => 'Str|Undef',
default => $_id_default,
trigger => $_check_id,
);
__PACKAGE__->meta->make_immutable;
package main;
say My->new->id;
say My->new(id=>'aaa')->id;
say My->new(id=>undef)->id;
I've found that if a subclass adds a trigger, then method modifiers from the base class don't run. This seems like a Moose bug, or at least non-intuitive. Here's my example:
package Foo {
use Moose;
has 'foo' => (
is => 'rw',
isa => 'Str',
);
before 'foo' => sub {
warn "before foo";
};
};
package FooChild {
use Moose;
extends 'Foo';
has '+foo' => ( trigger => \&my_trigger, );
sub my_trigger {
warn 'this is my_trigger';
}
};
my $fc = FooChild->new();
$fc->foo(10);
If you run this example, only the "this is my_trigger" warn runs, and the "before" modifier is ignored. I'm using Perl 5.14.2 with Moose 2.0402.
Is this correct behavior? It doesn't seem right, especially since the trigger will fire after the before when the trigger is defined directly in the base class.
On the principle that you should not be able to distinguish between inherited code and code in the class, I'd call this a bug.
It appears to be a general problem where adding to an attribute removes method modifiers. This code demonstrates your bug without involving triggers.
package Foo {
use Moose;
has 'foo' => (
is => 'rw',
isa => 'Str',
default => 5,
);
before 'foo' => sub {
warn "before foo";
};
};
package FooChild {
use Moose;
extends 'Foo';
has '+foo' => ( default => 99 );
};
my $fc = FooChild->new();
print $fc->foo;
Please report this to the Moose folks.
Update
The code I posted in my original question was illustrative of the way method modifier do or don't work.
It was not necessarily illustrative of the problem description I gave.
This code should be. It works, but contains a hack in the trigger I used to code the requirement of tracking all updates and acting upon them based on the value supplied to the setter.
package Article;
use Moose;
use Moose::Util::TypeConstraints;
has 'name', is => 'rw', isa => 'Str', required => 1;
has 'price', is => 'rw', isa => 'Num', required => 1;
has 'quantity', is => 'rw', isa => 'Num', required => 1,
trigger => \&update_quantity;
has 'quantity_original', is => 'rw', isa => 'Num',
predicate => 'quantity_fix',
clearer => 'quantity_back_to_normal';
# https://metacpan.org/module/Moose::Cookbook::Basics::Recipe3
# A trigger accepts a subroutine reference, which will be called as a method
# whenever the attribute is set. This can happen both during object
# construction or later by passing a new object to the attribute's accessor
# method. However, it is not called when a value is provided by a default or
# builder.
sub update_quantity {
my( $self, $val ) = #_;
# print STDERR $val, "\n";
if ( $val == int $val ) {
$self->quantity_back_to_normal;
} else {
$self->quantity_original( $val );
# Updating quantity via setter would retrigger this code.
# Which would defeat its purpose. The following won't:
$self->{quantity} = 1; # hack, yes; but it does work
}
}
around name => sub {
my $orig = shift;
my $self = shift;
return $self->$orig( #_ ) if #_; # setter
return $self->$orig unless $self->quantity_fix;
return sprintf '%s (%s)', $self->$orig, $self->quantity_original;
};
around price => sub {
my $orig = shift;
my $self = shift;
return $self->$orig( #_ ) if #_; # setter
return $self->$orig unless $self->quantity_fix;
return int( 100 * $self->$orig * $self->quantity_original + 0.5 ) / 100;
};
__PACKAGE__->meta->make_immutable; no Moose;
package main;
use Test::More;
{ my $art = Article->new( name => 'Apfel', price => 33, quantity => 4 );
is $art->price, 33, 'supplied price';
is $art->quantity, 4, 'supplied quantity';
is $art->name, 'Apfel', 'supplied name';
}
{ my $art = Article->new( name => 'Mehl', price => 33, quantity => 4.44 );
# diag explain $art;
is $art->quantity, 1, 'has quantity fixed';
is $art->price, 33 * 4.44, 'has price fixed';
is $art->name, 'Mehl (4.44)', 'has name fixed';
# tougher testing ...
$art->quantity(3);
is $art->quantity, 3, 'supplied quantity again';
is $art->price, 33, 'supplied price again';
is $art->name, 'Mehl', 'supplied name again';
}
done_testing;
Still not sure what Moose facility to employ to do the job.
An abundance of features and facilities does not always make things easier.
At least not when you try not to reinvent any wheels and reuse what can be reused.
Original question
It appears the around method modifier isn't called as part of building the object (when calling new). Test case here:
package Bla;
use Moose;
has 'eins', is => 'rw', isa => 'Int';
has 'zwei', is => 'rw', isa => 'Num';
around [qw/ eins zwei /] => sub {
my $orig = shift;
my $self = shift;
return $self->$orig unless #_;
my $val = shift;
if ( $val == int $val ) {
return $self->$orig( $val );
}
else {
return $self->$orig( 1 );
warn "replaced $val by 1";
}
};
package main;
use Test::More;
use Test::Exception;
dies_ok { Bla->new( eins => 33.33 ) } 'dies because of Int type constraint';
my $bla = Bla->new( zwei => 22.22 );
is $bla->zwei, 22.22, 'around has not been called';
done_testing;
Let me explain what I want to achieve. There's a class that has quantity and price (and some more state). When quantity comes in (via new or the setter, I don't care), I want to make sure it ends up as an integer (hence the constraint). If it's not an integer, I want to replace it by just 1 and make some other updates to the object, like saving the original quantity and multiplying the price by the original quantity. Both for the constructor and the setter.
What should I do? Provide a subroutine that does the job and call it from both around BUILDARGS and around quantity?
How about this?
package Bla;
use Moose;
use Moose::Util::TypeConstraints;
subtype 'MyInt',
as 'Int';
coerce 'MyInt',
from 'Num',
via { 1 };
has 'eins', is => 'rw', isa => 'Int';
has 'zwei', is => 'rw', isa => 'MyInt', coerce => 1;
package main;
use Test::More;
use Test::Exception;
dies_ok { Bla->new( eins => 33.33 ) } 'dies because of Int type constraint';
my $bla = Bla->new( zwei => 22.22 );
is $bla->zwei, 1, '22.22 -> 1';
my $bla2 = Bla->new( zwei => 41 );
is $bla2->zwei, 41, '41 -> 41';
done_testing;
When I keep running against walls, I know I did something wrong, and I'm running against walls. The design sucks. I think the key problem is that you have one field serving two purposes.
If the only purpose of orig_quantity is to normalize the price, I suggested that you normalize quantity and price after they are set. This could be done explicitly, or it could be done implicitly when you try to fetch them as shown below.
has price => (
accessor => '_price',
isa => 'Num',
handles => {
price => sub {
my $self = shift;
return $self->_price(#_) if #_;
$self->normalize();
return $self->_price();
},
},
);
has quantity => (
accessor => '_quantity',
isa => 'Num',
handles => {
quantity => sub {
my $self = shift;
return $self->_quantity(#_) if #_;
$self->normalize();
return $self->_quantity();
},
},
);
sub normalize {
my ($self) = #_;
my $quantity = $self->_quantity();
return if is_an_int($quantity);
$self->_quantity(1);
$self->_price($self->_price() / $quantity);
}
If you actually do need orig_quantity, then you probably want the constructor to set this directly and make quantity a derived value.
I've received a lot of exceptions from QA due to incomplete data being fed to my Moose constructors. The attribute name is present in the constructor arguments, but the value is undef.
It's a fact of life with many scripting applications that things are just undef. And oftentimes this is perfectly fine. You don't want an annoying warning from the warnings pragma (so you do no warnings 'uninitialized'), and you certainly don't want your code to die because one little value, say the housenumber, is undef.
So without further ado, I want my Moose constructors to behave like straight Perl (i.e. without use warnings 'uninitialized'), which is to convert undef to 0 or the empty string as required. The attempt shown in this sample does not work for the case where the attribute name is present but the value is undef. I could think of using BUILDARGS to achieve what I want. But is there a declarative way in plain Moose without resorting to MooseX::UndefTolerant (which unfortunately I cannot use as it is not installed)?
package AAA;
use Moose;
has 'hu', is => 'ro', isa => 'Str';
has 'ba', is => 'ro', isa => 'Int';
no Moose; __PACKAGE__->meta->make_immutable;
package BBB;
use Moose; extends 'AAA';
has '+hu', default => ''; # don't want to die on undef
has '+ba', default => 0; # idem
no Moose; __PACKAGE__->meta->make_immutable;
package main;
use Test::More;
use Test::Exception;
# Those AAAs should die ...
throws_ok { AAA->new( hu => undef ) }
qr/Validation failed for 'Str' with value undef/;
throws_ok { AAA->new( ba => undef ) }
qr/Validation failed for 'Int' with value undef/;
# .. but these BBBs should live:
lives_ok { BBB->new( hu => undef ) } 'hu supplied as undef';
lives_ok { BBB->new( ba => undef ) } 'ba supplied as undef';
done_testing;
In Moose::Manual::Types is a way documented to deal with exactly this kind of problem.
Use the Maybe[a] type.
package AAA;
use Moose;
has 'hu', is => 'ro', isa => 'Str';
has 'ba', is => 'ro', isa => 'Int';
no Moose; __PACKAGE__->meta->make_immutable;
package BBB;
use Moose; extends 'AAA';
has 'hu', is => 'rw', isa => 'Maybe[Str]', default => ''; # will not die on undef
has 'ba', is => 'rw', isa => 'Maybe[Int]', default => 0; # idem
sub BUILD {
my $self = shift;
$self->hu('') unless defined $self->hu;
$self->ba(0) unless defined $self->ba;
}
no Moose; __PACKAGE__->meta->make_immutable;
package main;
use Test::More;
use Test::Exception;
# Those AAAs should die ...
throws_ok { AAA->new( hu => undef ) }
qr/Validation failed for 'Str' with value undef/;
throws_ok { AAA->new( ba => undef ) }
qr/Validation failed for 'Int' with value undef/;
# .. but these BBBs should live:
lives_ok { BBB->new( hu => undef ) } 'hu supplied as undef';
lives_ok { BBB->new( ba => undef ) } 'ba supplied as undef';
my $bbb = BBB->new( hu => undef, ba => undef );
is $bbb->hu, '', "hu is ''";
is $bbb->ba, 0, 'ba is 0';
done_testing;
Your complaint really is that Moose is doing exactly what it is supposed to be doing. If you explicitly pass undef as a value, but that value can only be an Int, then you should get an error.
So you need to make a choice. You can either change the type (via union) to allow undef as a valid value like so:
has 'hu', is => 'ro', isa => 'Str | Undef';
has 'ba', is => 'ro', isa => 'Int | Undef';
Or you can just not send in undefined values:
my %aa_params = ();
$aa_params{hu} = $foo if defined $foo;
$aa = AA->new( %aa_params );
Or finally, for some unknown reason you absolutely cannot resist sending in invalid undefined values for things which should not be explicitly set to undefined, just write a quick filter:
sub filt_undef {
my %hash = #_;
return map { $_ => $hash{$_} } grep { defined $hash{$_} } keys %hash;
}
$aa = AA->new( filt_undef( hu => undef ) );
But this seems rather awkward and awful.
Or use on-the-fly coercion:
package BBB;
use Moose;
use MooseX::AttributeShortcuts;
extends 'AAA';
has '+hu',
traits => [Shortcuts],
coerce => [ Undef => sub { '' } ],
;
In our classes we have a pattern where we create an attribute to represent a
calculated value. For obvious reasons we want to cache the calculated value
and then invalidate the cache when one of the underlying values change.
So we currently have this:
package FooBar;
use Moose;
has 'foo' => (
accessor => {
'foo' => sub {
my $self = shift;
if (#_ > 0) {
# writer
$self->{foo} = $_[0];
# reset fields that are dependant on me
$self->{bar} = undef;
}
# reader part;
return $self->{foo};
}
}
);
has 'bar' => (
accessor => {
'bar' => sub {
my $self = shift;
if (#_ > 0) {
# writer
$self->{bar} = $_[0];
}
# reader part;
$self->{bar} = calculate_bar($self->foo, $self->baz)
if (not defined($self->{bar}));
return $self->{bar};
}
}
);
sub calculate_bar { ... }
This long hand method is getting very tedious and error prone when calculated values
depend on other calculated values.
Is there a smarter/simpler way for 'bar' to monitor the attributes it depends on
vs having 'foo' know who is dependent on it? Also how can I avoid setting bar via hash
member access?
If I understand you correctly, you can use triggers to clear attributes when one is set. Here's an example:
has 'foo' => (
is => 'rw',
trigger => sub{
my ($self) = #_;
$self->clear_bar;
}
);
has 'bar' => (
is => 'rw',
clearer => 'clear_bar',
lazy => 1,
default => sub{
my ($self) = #_;
return calculate_bar( ... );
}
);
So, any writes to foo via $obj->foo($newvalue) will cause bar to be cleared, and recreated on next access.
I think it is quite possible that you're making this harder on yourself by using an Attributes implicit memoization with lazy, when you could just make the memoization explicit making your whole program more transparent
has [qw/foo bar baz/] => ( isa => 'Value', is => 'rw' );
use Memoize;
memoize('_memoize_this');
sub old_lazy_attr {
my $self = shift;
_memoize_this( $self->attr1, $self->attr2, $self->attr3 );
}
sub _memoize_this {
my #args = #_;
# complex stuff
return $result
}
See cpan's Memoize for information and control of the internal cache, also remember that a Memoized function can not be dependent on the state of the object. So the arguments must be passed in explicitly.
Would this work?
#!/usr/bin/perl
package Test;
use Modern::Perl;
use Moose;
has a => (is => 'rw', isa => 'Str', trigger => \&change_a);
has b => (is => 'rw', isa => 'Str', trigger => \&change_b);
has c => (is => 'rw', isa => 'Str');
sub change_a
{
my $self = shift;
say 'update b';
$self->b($self->a . ', bar');
}
sub change_b
{
my $self = shift;
say 'update c';
}
package main;
my $test = Test->new->a('Foo');
Output:
$ perl test.pl
update b
update c
I haven't done any poking around in Moose internals and the meta object protocol, but I think this is a good time to do it.
You want to patch the code generation so that when you specify an attribute as
has 'foo' => ();
has 'bar' => (
depends_on => [qw( foo )],
lazy => \&calculate_bar,
);
the code generation phase creates code for the foo and bar attributes as you specified above.
How to do this is an exercise left to the reader. If I had a clue, I'd try to give you a start. Unfortunately, all I can advise you with is "This is a job for the MOP".