view release on metacpan or  search on metacpan

lib/Zydeco.pm  view on Meta::CPAN

	has field param
	constant method symmethod multi factory before after around
	type_name coerce
	version authority overload
	>;
	goto \&Exporter::Tiny::unimport;
}

sub _predeclare {
	my ($me, $caller, $types, @names) = @_;
	
	for my $name (@names) {
		my $cached;
		my $T = sub () {
			if ( !$cached or $cached->isa('Type::Tiny::_DeclaredType') ) {
				my $got = $types->can('get_type') && $types->get_type($name);
				$cached = $got if $got;
				$cached ||= 'Type::Tiny::_DeclaredType'->new(
					name    => $name,
					library => $types,
				);
			}
			$cached;
		};
		eval qq{
			package Zydeco; # allow namespace::autoclean to clean them
			no warnings 'redefine';
			*$caller\::$name        = \$T;
			*$caller\::is_$name     = sub (\$) { \$T->()->check(\@_) };
			*$caller\::assert_$name = sub (\$) { \$T->()->assert_return(\@_) };
			1;
		} or die($@);
	}
}

sub import {
	no warnings 'closure';
	my ($me, %opts) = (shift, @_);
	my $caller = ($opts{caller} ||= caller);
	
	if ('Zydeco::_Gather'->_already($caller)) {
		require Carp;
		Carp::croak("Zydeco is already in scope");
	}
	
	require MooX::Press;
	'MooX::Press'->_apply_default_options(\%opts);
	
	my %want = map +($_ => 1), @{ $opts{keywords} || \@EXPORTABLES };
	
	# Optionally export wrapper subs for pre-declared types
	#
	if ($opts{declare}) {
		my $types = $opts{type_library};
		$me->_predeclare($caller, $types, @{ $opts{declare} });
	}
	
	# Export utility stuff
	#
	Zydeco::_Gather->import::into($caller, -gather => %opts);
	strict->import::into($caller);
	warnings->import::into($caller);
	MooX::Press::Keywords->import::into($caller, $_)
		for grep $want{$_}, qw(-booleans -privacy -util);
	Syntax::Keyword::Try->import::into($caller) if $want{try};
	if ($] >= 5.018) {
		feature->import::into($caller, qw( say state unicode_strings unicode_eval evalbytes current_sub fc ))
			if $want{-features};
	}
	elsif ($] >= 5.014) {
		feature->import::into($caller, qw( say state unicode_strings ))
			if $want{-features};
	}
	my @libs = qw/ Types::Standard Types::Common::Numeric Types::Common::String /;
	push @libs, $opts{type_library} if $opts{type_library}->isa('Type::Library');
	for my $library (@libs) {
		$library->import::into($caller, { replace => 1 }, $_)
			for grep $want{$_}, qw( -types -is -assert );
	}
	
	# `include` keyword
	#
	Keyword::Simple::define include => sub {
		my $ref = shift;
		
		$$ref =~ _fetch_re('MxpIncludeSyntax', anchor => 'start') or $me->_syntax_error(
			'include directive',
			'include <name>',
			$ref,
		);
		
		my ($pos, $name) = ($+[0], $+{name});
		my $qualified = 'MooX::Press'->qualify_name($name, $opts{prefix});
		$me->_inject($ref, $pos, sprintf('BEGIN { eval(q[%s]->_include(%s)) or die($@) };', $me, B::perlstring($qualified)));
	} if $want{include};

	# `class` keyword
	#
	Keyword::Simple::define class => sub {
		my $ref = shift;
		
#		my $re = _fetch_re('MxpCompactRoleList', anchor => 'start');
#		my @r  = "Foo with Bar" =~ /($re)/;
#		use Data::Dumper;
#		die Dumper($r[0], $re);

		$$ref =~ _fetch_re('MxpClassSyntax', anchor => 'start') or $me->_syntax_error(
			'class declaration',
			'class <name> (<signature>) { <block> }',
			'class <name> { <block> }',
			'class <name>',
			'class (<signature>) { <block> }',
			'class { <block> }',
			'class;',
			$ref,
		);
		
		my ($pos, $plus, $name, $version, $sig, $compact_extends, $compact_with, $block) = ($+[0], $+{plus}, $+{name}, $+{version}, $+{sig}, $+{compact_extends}, $+{compact_with}, $+{block});
		my $has_sig = !!exists $+{sig};
		$plus  ||= '';
		$block ||= '{}';