Re: Moose type question

I faced the same problem and used:

my $date_constraint = Moose::Util::TypeConstraints::find_type_constrai
+nt('MyApp::DateOnly');

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my %args  = ( @_ == 1 ? %{ $_[0] } : @_ );

    # Maybe[] doesn't coerce
    $args{$foo} = $date_constraint->coerce($args{foo})
        if defined($args{$foo});

    return $class->$orig(%args);
};

has foo => (
    reader  => 'get_foo',
    writer  => '_set_foo',
    isa     => 'Maybe[MyApp::DateOnly]',
    coerce  => 1,
    handles => {

        set_foo => sub {
            my ($self, $arg) = @_;
            # Maybe[] doesn't coerce
            $arg = $date_constraint->coerce($arg)
                if defined($arg);
            $self->_set_foo($arg);
        },

    },
);
[download]

I use MooseX::FollowPBP which creates get_foo and set_foo accessors for is => 'rw'. If you use the default accessor style, adjust appropriately.

As an aside, it seems to me that

type 'MyApp::DateOnly'
    => where {     blessed($_)
               &&  $_->isa('DateTime')
               &&  $_->hour == 0  &&  $_->min == 0  && $_->sec == 0
           };
[download]

would be more clear when written as

subtype 'MyApp::DateOnly'
    => as 'DateTime'
    => where { $_->hour == 0  &&  $_->min == 0  && $_->sec == 0 };
[download]

Comment on Re: Moose type question Select or Download Code

Replies are listed 'Best First'.
Re^2: Moose type question by Sue D. Nymme (Monk) on Jun 07, 2010 at 19:12 UTC
Thanks... I can see how your `BUILDARGS`/`handles` solution would work, but it sure is ugly. :-/ I was hoping there'd be a built-in way. Like, you know, Maybe[] handling it! Also, I like your tip for making my where clause more clear. Much simpler, thanks.	[reply] [d/l] [select]
Re^3: Moose type question by ikegami (Patriarch) on Jun 07, 2010 at 20:28 UTC
[ Reported in https://rt.cpan.org/Ticket/Display.html?id=58387. ] If you care to file a bug report or add the missing functionality yourself, here's a test case: BEGIN { package Class; use strict; use warnings; use Moose; has val => ( is => 'rw', isa => 'Num', required => 1, ); use Moose::Util::TypeConstraints; coerce __PACKAGE__ => from 'Num' => via { __PACKAGE__->new(val => $_) }; } BEGIN { package Container; use strict; use warnings; use Moose; has always => ( is => 'rw', isa => 'Class', coerce => 1, default => sub { Class->new(val => 0) }, ); has maybe => ( is => 'rw', isa => 'Maybe[Class]', coerce => 1, default => undef, ); } use strict; use warnings; use Test::More tests => 15; my $always_fail = qr/^Attribute $always$ does not pass the type cons +traint/; my $maybe_fail = qr/^Attribute $maybe$ does not pass the type const +raint/; my $o = Class->new(val => 123); eval { Container->new() }; is($@, ''); eval { Container->new(always => $o) }; is($@, ''); eval { Container->new(always => 123) }; is($@, ''); eval { Container->new(always => "abc") }; like($@, $always_fail); eval { Container->new(maybe => undef) }; is($@, ''); eval { Container->new(maybe => $o) }; is($@, ''); eval { Container->new(maybe => 123) }; is($@, ''); eval { Container->new(maybe => "abc") }; like($@, $maybe_fail); my $c = Container->new(); eval { $c->always($o) }; is($@, ''); eval { $c->always(123) }; is($@, ''); eval { $c->always("abc") }; like($@, $always_fail); eval { $c->maybe(undef) }; is($@, ''); eval { $c->maybe($o) }; is($@, ''); eval { $c->maybe(123) }; is($@, ''); eval { $c->maybe("abc") }; like($@, $maybe_fail); [download] Currently failing: `eval { Container->new(maybe => 123) }; is($@, ''); eval { $c->maybe(undef) }; is($@, ''); eval { $c->maybe($o) }; is($@, ''); eval { $c->maybe(123) }; is($@, ''); eval { $c->maybe("abc") }; like($@, $maybe_fail);` [download]	[reply] [d/l] [select]