view release on metacpan or  search on metacpan

lib/Type/Tiny/Enum.pm  view on Meta::CPAN

	
	require Type::Utils;
	!defined( $value )
		? [
		sprintf(
			'"%s" requires that the value is defined',
			$self,
		),
		]
		: @$self < 13 ? [
		sprintf(
			'"%s" requires that the value is equal to %s',
			$self,
			Type::Utils::english_list( \"or", map B::perlstring( $_ ), @$self ),
		),
		]
		: [
		sprintf(
			'"%s" requires that the value is one of an enumerated list of strings',
			$self,
		),
		];
} #/ sub validate_explain

sub has_sorter {
	!!1;
}

sub _enum_order_hash {
	my $self = shift;
	my %hash;
	my $i = 0;
	for my $value ( @{ $self->values } ) {
		next if exists $hash{$value};
		$hash{$value} = $i++;
	}
	return %hash;
} #/ sub _enum_order_hash

sub sorter {
	my $self = shift;
	my %hash = $self->_enum_order_hash;
	return [
		sub { $_[0] <=> $_[1] },
		sub { exists( $hash{ $_[0] } ) ? $hash{ $_[0] } : 2_100_000_000 },
	];
}

my $canon;

sub closest_match {
	require Types::Standard;
	
	my ( $self, $given ) = ( shift, @_ );
	
	return unless Types::Standard::is_Str $given;
	
	return $given if $self->check( $given );
	
	$canon ||= eval(
		$] lt '5.016'
		? q< sub { ( my $var = lc($_[0]) ) =~ s/(^\s+)|(\s+$)//g; $var } >
		: q< sub { CORE::fc($_[0]) =~ s/(^\s+)|(\s+$)//gr; } >
	);
	
	$self->{_lookups} ||= do {
		my %lookups;
		for ( @{ $self->values } ) {
			my $key = $canon->( $_ );
			next if exists $lookups{$key};
			$lookups{$key} = $_;
		}
		\%lookups;
	};
	
	my $cgiven = $canon->( $given );
	return $self->{_lookups}{$cgiven}
		if $self->{_lookups}{$cgiven};
		
	my $best;
	VALUE: for my $possible ( @{ $self->values } ) {
		my $stem = substr( $possible, 0, length $cgiven );
		if ( $cgiven eq $canon->( $stem ) ) {
			if ( defined( $best ) and length( $best ) >= length( $possible ) ) {
				next VALUE;
			}
			$best = $possible;
		}
	}
	
	return $best if defined $best;
	
	return $self->values->[$given]
		if Types::Standard::is_Int $given;
		
	return $given;
} #/ sub closest_match

push @Type::Tiny::CMP, sub {
	my $A = shift->find_constraining_type;
	my $B = shift->find_constraining_type;
	return Type::Tiny::CMP_UNKNOWN
		unless $A->isa( __PACKAGE__ ) && $B->isa( __PACKAGE__ );
		
	my %seen;
	for my $word ( @{ $A->unique_values } ) {
		$seen{$word} += 1;
	}
	for my $word ( @{ $B->unique_values } ) {
		$seen{$word} += 2;
	}
	
	my $values = join( '', CORE::values %seen );
	if ( $values =~ /^3*$/ ) {
		return Type::Tiny::CMP_EQUIVALENT;
	}
	elsif ( $values !~ /2/ ) {
		return Type::Tiny::CMP_SUPERTYPE;
	}
	elsif ( $values !~ /1/ ) {
		return Type::Tiny::CMP_SUBTYPE;