Toby Inkster avatar Toby Inkster committed 6538f75

make_role convenience function for making anonymouse roles; Scalar::Does::MooseTypes exploits this

Comments (0)

Files changed (5)

+Improve test suite coverage for Scalar::Does::MooseTypes. (Scalar::Does itself has 100% coverage according to Devel::Cover.)

lib/Scalar/Does.pm

 	);
 }
 
+BEGIN {
+	package Scalar::Does::RoleChecker;
+	use overload
+		q[""]    => 'name',
+		q[&{}]   => 'code',
+		fallback => 1,
+	;
+	sub new {
+		my $class = shift;
+		my ($name, $coderef);
+		for my $p (@_)
+		{
+			if (Scalar::Does::does($p, 'CODE'))  { $coderef = $p }
+			if (Scalar::Does::does($p, 'HASH'))  { $coderef = $p->{where} }
+			if (Scalar::Does::does($p, 'Regexp')){ $coderef = sub { $_[0] =~ $p } }
+			if (not ref $p)                      { $name    = $p }
+		}
+		Carp::confess("Cannot make role without checker coderef or regexp.")
+			unless $coderef;
+		bless { name => $name, code => $coderef } => $class;
+	}
+	sub name  { $_[0]{name} }
+	sub code  { $_[0]{code} }
+	sub check { $_[0]{code}->($_[1]) }
+}
+
 use constant \%_CONSTANTS;
-use overload ();
 use Carp             0     qw( confess );
 use IO::Detect       0.001 qw( is_filehandle );
 use namespace::clean 0.19  qw();
 
 use Sub::Exporter -setup => {
 	exports => [
-		qw( does overloads blessed reftype looks_like_number ),
+		qw( does overloads blessed reftype looks_like_number make_role where ),
 		custom => \&_build_custom,
 		keys %_CONSTANTS,
 	],
 		default        => [qw( does )],
 		constants      => [qw( -default -only_constants )],
 		only_constants => [keys %_CONSTANTS],
+		make           => [qw( make_role where )],
 	},
 	installer => sub {
 		namespace::clean->import(
 	}
 }
 
+sub make_role
+{
+	return 'Scalar::Does::RoleChecker'->new(@_);
+}
+
+sub where (&)
+{
+	return +{ where => $_[0] };
+}
+
 "it does"
 __END__
 
 Perl 5.10+. You may wish to load L<UNIVERSAL::DOES> on earlier versions
 of Perl.
 
+=item C<< does($role) >>
+
+The single-argument form of C<does> returns a curried coderef.
+
 =item C<< overloads($scalar, $role) >>
 
 A function C<overloads> (which just checks overloading) is also available.
 
+=item C<< overloads($role) >>
+
+The single-argument form of C<overloads> returns a curried coderef.
+
 =item C<< blessed($scalar) >>, C<< reftype($scalar) >>, C<< looks_like_number($scalar) >>
 
 For convenience, this module can also re-export these functions from
 L<Scalar::Util>. C<looks_like_number> is generally more useful than
 C<< does($scalar, q[0+]) >>.
 
+=item C<< make_role $name, where { BLOCK } >>
+
+Returns an anonymous role object which can be used as a parameter to
+C<does>. The block is arbitrary code which should check whether $_[0]
+does the role.
+
+=item C<< where { BLOCK } >>
+
+Syntactic sugar for C<make_role>. Compatible with the C<where> function
+from L<Moose::Util::TypeConstraints>, so don't worry about conflicts.
+
 =back
 
 =head2 Constants
 
   use Scalar::Does -constants;
 
+The C<make_role> and C<where> functions can be exported like this:
+
+  use Scalar::Does -make;
+
 Or list specific functions/constants that you wish to import:
 
   use Scalar::Does qw( does ARRAY HASH STRING NUMBER );
 See also:
 L<Moose::Meta::TypeConstraint>,
 L<Moose::Util::TypeConstraints>,
-L<MooseX::Types>.
+L<MooseX::Types>,
+L<Scalar::Does::MooseTypes>.
+
+=head2 Relationship to Role::Tiny and Moo roles
+
+At the time of writing, Role::Tiny roles B<< do not >> work as roles for
+Scalar::Does. There is an open ticket against Role::Tiny which, if resolved,
+should fix this.
+
+See L<https://rt.cpan.org/Ticket/Display.html?id=79747>.
+
+Moo's role system is based on Role::Tiny, and consequently has the same
+limitation.
+
+=head2 Relationship to Moo type constraints
+
+Unlike Moose and Mouse, Moo does not have a type system, but the C<< does >>
+function can be used as ersatz type constraints.
+
+  has my_list => (
+    is     => 'rw',
+    isa    => does('ARRAY'),
+  );
 
 =head2 Relationship to Object::DOES
 

lib/Scalar/Does/MooseTypes.pm

+package Scalar::Does::MooseTypes;
+
+use Scalar::Does qw( blessed does looks_like_number -make );
+
+my @ROLES;
+my @NAMES;
+BEGIN {
+	@ROLES = (
+		make_role('Any',       sub { 1 }),
+		make_role('Item',      sub { 1 }),
+		make_role('Undef',     sub { !defined $_[0] }),
+		make_role('Defined',   sub { defined $_[0] }),
+		make_role('Bool',      sub { !defined $_[0] || $_[0] eq q() || $_[0] eq '0' || $_[0] eq '1' }),
+		make_role('Value',     sub { defined $_[0] && !ref $_[0] }),
+		make_role('Ref',       sub { ref $_[0] }),
+		make_role('Str',       sub { defined $_[0] && (ref(\($_[0])) eq 'SCALAR' || ref(\(my $val = $_[0])) eq 'SCALAR') }),
+		make_role('Num',       sub { defined $_[0] && !ref($_[0]) && looks_like_number($_[0]) }),
+		make_role('Int',       sub { defined $_[0] && !ref($_[0]) && $_[0] =~ /\A-?[0-9]+\z/ }),
+		make_role('CodeRef',   sub { ref $_[0] eq 'CODE' }),
+		make_role('RegexpRef', sub { ref $_[0] eq 'Regexp' }),
+		make_role('GlobRef',   sub { ref $_[0] eq 'GLOB' }),
+		make_role('FileHandle',\&IO::Detect::is_filehandle),
+		make_role('Object',    sub { blessed($_[0]) }),
+		make_role('ClassName', sub { !ref($_[0]) && UNIVERSAL::can($_[0], 'can') }),
+		make_role('RoleName',  sub { !ref($_[0]) && UNIVERSAL::can($_[0], 'can') }),
+		make_role('ScalarRef', sub { ref $_[0] eq 'SCALAR' || ref $_[0] eq 'REF' }),
+		make_role('ArrayRef',  sub { ref $_[0] eq 'ARRAY' }),
+		make_role('HashRef',   sub { ref $_[0] eq 'HASH' }),
+	);
+	@NAMES = map("$_", @ROLES);
+}
+
+use constant +{ map {;"$_"=>$_} @ROLES };
+use Sub::Exporter -setup => {
+	exports  => \@NAMES,
+	groups   => {
+		constants      => \@NAMES,
+		only_constants => \@NAMES,
+	},
+};
+
+1;
+
+__END__
+
+=head1 NAME
+
+Scalar::Does::MooseTypes - additional constants for Scalar::Does, inspired by the built-in Moose type constraints
+
+=head1 SYNOPSIS
+
+  use 5.010;
+  use Scalar::Does qw(does);
+  use Scalar::Does::MooseTypes -all;
+  
+  my $var = [];
+  if (does $var, ArrayRef) {
+    say "It's an arrayref!";
+  }
+
+=head1 DESCRIPTION
+
+=head2 Constants
+
+=over
+
+=item C<Any>
+
+=item C<Item>
+
+=item C<Bool>
+
+=item C<Undef>
+
+=item C<Defined>
+
+=item C<Value>
+
+=item C<Str>
+
+=item C<Num>
+
+=item C<Int>
+
+=item C<ClassName>
+
+=item C<RoleName>
+
+=item C<Ref>
+
+=item C<ScalarRef>
+
+=item C<ArrayRef>
+
+=item C<HashRef>
+
+=item C<CodeRef>
+
+=item C<RegexpRef>
+
+=item C<GlobRef>
+
+=item C<FileHandle>
+
+=item C<Object>
+
+=back
+
+=head1 SEE ALSO
+
+L<Scalar::Does>,
+L<Moose::Util::TypeConstraints>.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is copyright (c) 2012 by Toby Inkster.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=head1 DISCLAIMER OF WARRANTIES
+
+THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
+WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+
+use Test::More tests => 11;
+use Scalar::Does does => -make;
+
+my $positive = make_role 'Positive Integer', where { $_[0] > 0 };
+
+can_ok $positive => 'check';
+is("$positive", "Positive Integer");
+
+ok does($positive->name, q[""]);
+ok does($positive->code, q[&{}]);
+
+ok does("1", $positive);
+ok does("1hello", $positive);
+ok !does("-1", $positive);
+ok !does("", $positive);
+
+ok not eval {
+	make_role();
+};
+
+my $name = make_role qr{^Toby$}i;
+ok does("TOBY", $name);
+ok !does("TOBIAS", $name);
+use strict;
+use Test::More;
+use Scalar::Does qw(does);
+use Scalar::Does::MooseTypes -constants;
+
+my $var = "Hello world";
+
+ok does(\$var, ScalarRef);
+ok does([], ArrayRef);
+ok does(+{}, HashRef);
+ok does(sub {0}, CodeRef);
+ok does(\*STDOUT, GlobRef);
+ok does(\(\"Hello"), Ref);
+ok does(\*STDOUT, FileHandle);
+ok does(qr{x}, RegexpRef);
+ok does(1, Str);
+ok does(1, Num);
+ok does(1, Int);
+ok does(1, Defined);
+ok does(1, Value);
+ok does(undef, Undef);
+ok does(undef, Item);
+ok does(undef, Any);
+ok does('Scalar::Does', ClassName);
+ok does('Scalar::Does', RoleName);
+
+ok does(undef, Bool);
+ok does('', Bool);
+ok does(0, Bool);
+ok does(1, Bool);
+ok !does(7, Bool);
+
+ok !does(undef, Str);
+ok !does(undef, Num);
+ok !does(undef, Int);
+ok !does(undef, Defined);
+ok !does(undef, Value);
+
+done_testing;
+
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.