view release on metacpan or  search on metacpan

lib/Hades.pm  view on Meta::CPAN

					$sub_code .= $self->build_type($k, $v, $new_value, $new_error_string, ($v !~ m/^(Optional|Any|Item)/ ? qq|! defined($new_value) \|\|| : q||));
				}
				my $code = qq|
					if ((ref($value) \|\| "") ne "HASH") {
						$error_string
					} $sub_code|;
				return $code;
			},
			qr/^((Optional|Maybe)\[(.*)\])$/ => sub {
				my ($val, @matches) = @_;
				my $sub_code = $self->build_type($name, $matches[2], $value, $error_string);
				my $code = qq|
					if (defined $value) { $sub_code
					}|;
				return $code;
			};
		$code .= $switch->($type);
		$self->debug_step(sprintf(debug_step_26, $name), $code);
	}
	return $code;
}

sub extend_error_string {
	my ($self, $new_error_string, $value, $new_value, $message, $type) = @_;
	my $old_type = quotemeta(qq|$value = defined $value ? $value : 'undef';|);
	$new_error_string =~ s/^$old_type//;
 	$new_error_string =~ s/\Q$value\E/$new_value/;
	$new_error_string =~ s/};$/$message};/;
	if ($type && $type !~ m/^(Optional|Any|Item)/) {
		$new_error_string = qq|$new_value = defined $new_value ? $new_value : 'undef';| . $new_error_string;
	}
	return $new_error_string;
}

sub build_macro_attributes {
	my ($self, $name, $token, $meta) = @_;
	return (
		'default' => sub {
			my $value = shift;
			push @{$meta->{$name}->{caught}}, $value;
		},
		qr/^(\:a|\:alias)/ => sub {
			my $value = shift;
			$value =~ s/^\:(a|alias)\(\s*(.*)\s*\)$/$2/sg;
			push @{$meta->{$name}->{alias}}, split(' ', $value);
		},
		qr/^(\{)/ => sub {
			my $value = shift;
			$value =~ s/^\{|\}$//g;
			$meta->{$name}->{code} = eval qq|sub { my (\$self, \$mg, \@params) = \@_; $value }|;
		},
	);
}

sub build_macro {
	my ($self, $mg, $class) = @_;
	my $meta = $self->{macros};
	for my $macro (@{$class}) {
		$self->debug_step(debug_step_6, $macro);
		if ($macro->[-1] !~  m/^{/) {
			my $include = sprintf "Hades::Macro::%s", shift @{$macro};
			$self->debug_step(sprintf(debug_step_7, $include), $macro);
			eval qq|require $include|;
			die $@ if $@;
			my $include_meta = $include->new($macro->[0] ? do {
				$macro->[0] =~ s/^\[|\]$//g;
				( eval qq|$macro->[0]| );
			} : ())->meta;
			$self->debug_step(sprintf(debug_step_8, $include), $include_meta);
			$meta = {%{$meta}, %{$include_meta}};
		} else {
			my $name = shift @{$macro};
			$self->debug_step(sprintf(debug_step_9, $name), $macro);
			$meta->{$name}->{meta} = 'MACRO';
			my $switch = switch(
				$self->build_macro_attributes($name, $macro, $meta)
			);
			$switch->(shift @{$macro}) while scalar @{$macro};
			$self->debug_step(sprintf(debug_step_10, $name), $meta->{$name});
			if ($meta->{$name}->{alias}) {
				for (@{$meta->{$name}->{alias}}) {
					$meta->{$_} = $meta->{$name};
				}
			}
		}
	}
	$self->debug_step(debug_step_11, $meta);
	$self->{macros} = $meta;
}

sub index {
	my ($self, $index) = @_;
	return substr $self->{eval}, $index, 1;
}

sub build_test_data {
	my ($self, $type, $name, $required) = @_;
	my $switch = switch
		qr/^(Any)$/ => sub {
			return $self->_generate_test_string;
		},
		qr/^(Item)$/ => sub {
			return $self->_generate_test_string;
		},
		qr/^(Bool)$/ => sub {
			return (q|1|, q|[]|, q|{}|);
		},
		qr/^(Str)$/ => sub {
			return ($self->_generate_test_string, q|[]|, q|\1|);
		},
		qr/^(Num)$/ => sub {
			return (q|100.555|, q|[]|, $self->_generate_test_string);
		},
		qr/^(Int)$/ => sub {
			return (q|10|, q|[]|, $self->_generate_test_string);
		},
		qr/^(Ref)$/ => sub {
			return (q|{ test => 'test' }|, $self->_generate_test_string, q|1|);
		},
		qr/^(Ref\[(.*)\])$/ => sub {
			my ($val, @matches) = @_;

lib/Hades.pm  view on Meta::CPAN

	dokimi :t(CodeRef)

=cut

=head3 RegexpRef

A value where ref($value) eq "Regexp"

	dokimi :t(RegexpRef)

=cut

=head3 GlobRef

A value where ref($value) eq "GLOB"

	dokimi :t(GlobRef)

=cut

=head3 Object

A blessed object.

	dokimi :t(Object)

=cut

=head3 Map

Similar to HashRef but parameterized with type constraints for both the key and value. The constraint for keys would typically be a subtype of Str.

	dokimi :t(Map[Str, Int])

=cut

=head3 Tuple

Accepting a list of type constraints for each slot in the array.

	dokimi :t(Tuple[Str, Int, HashRef])

=cut

=head3 Dict

Accepting a list of type constraints for each slot in the hash.

	dokimi :t(Dict[onoma => Str, id => Optional[Int], epiloges => Dict[onama => Str]])

=cut

=head3 Optional

Used in conjunction with Dict and Tuple to specify slots that are optional and may be omitted.

	dokimi :t(Optional[Str])

=cut

=head2 Macros

Hades has a concept of macros that allow you to write re-usable code. see L<https://metacpan.org/source/LNATION/Hades-0.27/macro-fh.hades> for an example of how to extend via macros.

	macro {
		FH [ macro => [qw/read_file write_file/], alias => { read_file => [qw/rf/], write_file => [qw/wf/] } ]
		str2ArrayRef :a(s2ar) {
			return qq|$params[0] = [ $params[0] ];|;
		}
		ArrayRef2Str :a(ar2s) {
			return qq|$params[0] = $params[0]\->[0];|;
		}
	}
	MacroKosmos {
		eros $eros :t(Str) :d(t/test.txt) {
			€s2ar('$eros');
			€ar2s('$eros');
			€wf('$eros', q|'this is a test'|);
			return $eros;
		}
		psyche $psyche :t(Str) :d(t/test.txt) {
			€rf('$psyche');
			return $content;
		}
	}

	... generates ...

	package MacroKosmos;
	use strict;
	use warnings;
	our $VERSION = 0.01;

	sub new {
		my ( $cls, %args ) = ( shift(), scalar @_ == 1 ? %{ $_[0] } : @_ );
		my $self = bless {}, $cls;
		my %accessors = ();
		for my $accessor ( keys %accessors ) {
			my $value
			    = $self->$accessor(
				defined $args{$accessor}
				? $args{$accessor}
				: $accessors{$accessor}->{default} );
			unless ( !$accessors{$accessor}->{required} || defined $value ) {
				die "$accessor accessor is required";
			}
		}
		return $self;
	}

	sub eros {
		my ( $self, $eros ) = @_;
		$eros = defined $eros ? $eros : "t/test.txt";
		if ( !defined($eros) || ref $eros ) {
			$eros = defined $eros ? $eros : 'undef';
			die qq{Str: invalid value $eros for variable \$eros in method eros};
		}

		$eros = [$eros];
		$eros = $eros->[0];
		open my $wh, ">", $eros or die "cannot open file for writing: $!";
		print $wh 'this is a test';
		close $wh;
		return $eros;

	}

	sub psyche {
		my ( $self, $psyche ) = @_;
		$psyche = defined $psyche ? $psyche : "t/test.txt";
		if ( !defined($psyche) || ref $psyche ) {
			$psyche = defined $psyche ? $psyche : 'undef';
			die
			    qq{Str: invalid value $psyche for variable \$psyche in method psyche};
		}

		open my $fh, "<", $psyche or die "cannot open file for reading: $!";
		my $content = do { local $/; <$fh> };
		close $fh;
		return $content;
	}

	1;

	__END__

=head2 Testing

Hades can auto-generate test files. If you take the following example: