Initial Commit

database/perl/vendor/lib/Specio/Library/Structured/Dict.pm

@@ -0,0 +1,168 @@
+package Specio::Library::Structured::Dict;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.46';
+
+use Carp qw( confess );
+use List::Util ();
+use Scalar::Util qw( blessed );
+use Specio::Helpers qw( perlstring );
+use Specio::Library::Builtins;
+use Specio::TypeChecks qw( does_role );
+
+my $hashref = t('HashRef');
+
+sub parent {$hashref}
+
+## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)
+sub _inline {
+    $hashref->inline_check( $_[1] );
+}
+
+sub _parameterization_args_builder {
+    my $self = shift;
+    my $args = shift;
+
+    for my $p ( ( $args->{slurpy} || () ), values %{ $args->{kv} } ) {
+        my $type;
+        if ( blessed($p) ) {
+            $type = $p;
+        }
+        else {
+            if ( ref $p eq 'HASH' && $p->{optional} ) {
+                $type = $p->{optional};
+            }
+            else {
+                confess
+                    'Can only pass types, optional types, and slurpy types when defining a Dict';
+            }
+        }
+
+        does_role( $type, 'Specio::Constraint::Role::Interface' )
+            or confess
+            'All parameters passed to ->parameterize must be objects which do the Specio::Constraint::Role::Interface role';
+
+        confess
+            'All parameters passed to ->parameterize must be inlinable constraints'
+            unless $type->can_be_inlined;
+    }
+
+    return %{$args};
+}
+
+sub _name_builder {
+    my $self = shift;
+    my $p    = shift;
+
+    ## no critic (Subroutines::ProtectPrivateSubs)
+    my @kv;
+    for my $k ( sort keys %{ $p->{kv} } ) {
+        my $v = $p->{kv}{$k};
+        if ( blessed($v) ) {
+            push @kv, "$k => " . $self->_name_or_anon($v);
+        }
+        elsif ( $v->{optional} ) {
+            push @kv,
+                "$k => " . $self->_name_or_anon( $v->{optional} ) . '?';
+        }
+    }
+
+    if ( $p->{slurpy} ) {
+        push @kv, $self->_name_or_anon( $p->{slurpy} ) . '...';
+    }
+
+    return 'Dict{ ' . ( join ', ', @kv ) . ' }';
+}
+
+sub _structured_inline_generator {
+    my $self = shift;
+    my $val  = shift;
+    my %args = @_;
+
+    my @code = sprintf( '( %s )', $hashref->_inline_check($val) );
+
+    for my $k ( sort keys %{ $args{kv} } ) {
+        my $p      = $args{kv}{$k};
+        my $access = sprintf( '%s->{%s}', $val, perlstring($k) );
+
+        if ( !blessed($p) ) {
+            my $type = $p->{optional};
+
+            push @code,
+                sprintf(
+                '( exists %s ? ( %s ) : 1 )',
+                $access, $type->_inline_check($access)
+                );
+        }
+        else {
+            push @code, sprintf( '( %s )', $p->_inline_check($access) );
+        }
+    }
+
+    if ( $args{slurpy} ) {
+        my $check
+            = '( do { my %%_____known_____ = map { $_ => 1 } ( %s ); List::Util::all { %s } grep { ! $_____known_____{$_} } sort keys %%{ %s } } )';
+        push @code,
+            sprintf(
+            $check,
+            ( join ', ', map { perlstring($_) } keys %{ $args{kv} } ),
+            $args{slurpy}->_inline_check( sprintf( '%s->{$_}', $val ) ),
+            $val,
+            );
+    }
+
+    return '( ' . ( join ' && ', @code ) . ' )';
+}
+
+1;
+
+# ABSTRACT: Guts of Dict structured type
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Specio::Library::Structured::Dict - Guts of Dict structured type
+
+=head1 VERSION
+
+version 0.46
+
+=head1 DESCRIPTION
+
+There are no user facing parts here.
+
+=for Pod::Coverage .*
+
+=head1 SUPPORT
+
+Bugs may be submitted at L<https://github.com/houseabsolute/Specio/issues>.
+
+I am also usually active on IRC as 'autarch' on C<irc://irc.perl.org>.
+
+=head1 SOURCE
+
+The source code repository for Specio can be found at L<https://github.com/houseabsolute/Specio>.
+
+=head1 AUTHOR
+
+Dave Rolsky <autarch@urth.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is Copyright (c) 2012 - 2020 by Dave Rolsky.
+
+This is free software, licensed under:
+
+  The Artistic License 2.0 (GPL Compatible)
+
+The full text of the license can be found in the
+F<LICENSE> file included with this distribution.
+
+=cut

database/perl/vendor/lib/Specio/Library/Structured/Map.pm

@@ -0,0 +1,124 @@
+package Specio::Library::Structured::Map;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.46';
+
+use Carp qw( confess );
+use List::Util ();
+use Specio::Library::Builtins;
+use Specio::TypeChecks qw( does_role );
+
+my $hashref = t('HashRef');
+
+sub parent {$hashref}
+
+## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)
+sub _inline {
+    $hashref->inline_check( $_[1] );
+}
+
+sub _parameterization_args_builder {
+    my $self = shift;
+    my $args = shift;
+
+    for my $k (qw( key value )) {
+        does_role(
+            $args->{$k},
+            'Specio::Constraint::Role::Interface'
+            )
+            or confess
+            qq{The "$k" parameter passed to ->parameterize must be one or more objects which do the Specio::Constraint::Role::Interface role};
+
+        confess
+            qq{The "$k" parameter passed to ->parameterize must be an inlinable constraint}
+            unless $args->{$k}->can_be_inlined;
+    }
+    return map { $_ => $args->{$_} } qw( key value );
+}
+
+sub _name_builder {
+    my $self = shift;
+    my $p    = shift;
+
+    ## no critic (Subroutines::ProtectPrivateSubs)
+    return
+          'Map{ '
+        . $self->_name_or_anon( $p->{key} ) . ' => '
+        . $self->_name_or_anon( $p->{value} ) . ' }';
+}
+
+sub _structured_inline_generator {
+    my $self = shift;
+    my $val  = shift;
+    my %args = @_;
+
+    my $code = <<'EOF';
+(
+    ( %s )
+    && ( List::Util::all { %s } keys %%{ %s } )
+    && ( List::Util::all { %s } values %%{ %s } )
+)
+EOF
+
+    return sprintf(
+        $code,
+        $hashref->_inline_check($val),
+        $args{key}->inline_check('$_'),
+        $val,
+        $args{value}->inline_check('$_'),
+        $val,
+    );
+}
+
+1;
+
+# ABSTRACT: Guts of Map structured type
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Specio::Library::Structured::Map - Guts of Map structured type
+
+=head1 VERSION
+
+version 0.46
+
+=head1 DESCRIPTION
+
+There are no user facing parts here.
+
+=for Pod::Coverage .*
+
+=head1 SUPPORT
+
+Bugs may be submitted at L<https://github.com/houseabsolute/Specio/issues>.
+
+I am also usually active on IRC as 'autarch' on C<irc://irc.perl.org>.
+
+=head1 SOURCE
+
+The source code repository for Specio can be found at L<https://github.com/houseabsolute/Specio>.
+
+=head1 AUTHOR
+
+Dave Rolsky <autarch@urth.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is Copyright (c) 2012 - 2020 by Dave Rolsky.
+
+This is free software, licensed under:
+
+  The Artistic License 2.0 (GPL Compatible)
+
+The full text of the license can be found in the
+F<LICENSE> file included with this distribution.
+
+=cut

database/perl/vendor/lib/Specio/Library/Structured/Tuple.pm

@@ -0,0 +1,218 @@
+package Specio::Library::Structured::Tuple;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.46';
+
+use Carp qw( confess );
+use List::Util ();
+use Scalar::Util qw( blessed );
+use Specio::Library::Builtins;
+use Specio::TypeChecks qw( does_role );
+
+my $arrayref = t('ArrayRef');
+
+sub parent {$arrayref}
+
+## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)
+sub _inline {
+    $arrayref->inline_check( $_[1] );
+}
+
+sub _parameterization_args_builder {
+    my $self = shift;
+    my $args = shift;
+
+    my $saw_slurpy;
+    my $saw_optional;
+    for my $p ( @{$args} ) {
+        if ($saw_slurpy) {
+            confess
+                'A Tuple cannot have any parameters after a slurpy parameter';
+        }
+        if ( $saw_optional && blessed($p) ) {
+            confess
+                'A Tuple cannot have a non-optional parameter after an optional parameter';
+        }
+
+        my $type;
+        if ( blessed($p) ) {
+            $type = $p;
+        }
+        else {
+            if ( ref $p eq 'HASH' ) {
+                if ( $p->{optional} ) {
+                    $saw_optional = 1;
+                    $type         = $p->{optional};
+                }
+                if ( $p->{slurpy} ) {
+                    $saw_slurpy = 1;
+                    $type       = $p->{slurpy};
+                }
+            }
+            else {
+                confess
+                    'Can only pass types, optional types, and slurpy types when defining a Tuple';
+            }
+        }
+
+        if ( $saw_optional && $saw_slurpy ) {
+            confess
+                'Cannot defined a slurpy Tuple with optional slots as well';
+        }
+
+        does_role( $type, 'Specio::Constraint::Role::Interface' )
+            or confess
+            'All parameters passed to ->parameterize must be objects which do the Specio::Constraint::Role::Interface role';
+
+        confess
+            'All parameters passed to ->parameterize must be inlinable constraints'
+            unless $type->can_be_inlined;
+    }
+
+    return ( of => $args );
+}
+
+sub _name_builder {
+    my $self = shift;
+    my $p    = shift;
+
+    my @names;
+    for my $m ( @{ $p->{of} } ) {
+        ## no critic (Subroutines::ProtectPrivateSubs)
+        if ( blessed($m) ) {
+            push @names, $self->_name_or_anon($m);
+        }
+        elsif ( $m->{optional} ) {
+            push @names, $self->_name_or_anon( $m->{optional} ) . '?';
+        }
+        elsif ( $m->{slurpy} ) {
+            push @names, $self->_name_or_anon( $m->{slurpy} ) . '...';
+        }
+    }
+
+    return 'Tuple[ ' . ( join ', ', @names ) . ' ]';
+}
+
+sub _structured_inline_generator {
+    my $self = shift;
+    my $val  = shift;
+    my %args = @_;
+
+    my @of = @{ $args{of} };
+
+    my $slurpy;
+    $slurpy = ( pop @of )->{slurpy}
+        if !blessed( $of[-1] ) && $of[-1]->{slurpy};
+
+    my @code = sprintf( '( %s )', $arrayref->_inline_check($val) );
+
+    unless ($slurpy) {
+        my $min = 0;
+        my $max = 0;
+        for my $p (@of) {
+
+            # Unblessed values are optional.
+            if ( blessed($p) ) {
+                $min++;
+                $max++;
+            }
+            else {
+                $max++;
+            }
+        }
+
+        if ($min) {
+            push @code,
+                sprintf(
+                '( @{ %s } >= %d && @{ %s } <= %d  )',
+                $val, $min, $val, $max
+                );
+        }
+    }
+
+    for my $i ( 0 .. $#of ) {
+        my $p      = $of[$i];
+        my $access = sprintf( '%s->[%d]', $val, $i );
+
+        if ( !blessed($p) ) {
+            my $type = $p->{optional};
+
+            push @code,
+                sprintf(
+                '( @{%s} >= %d ? ( %s ) : 1 )', $val, $i + 1,
+                $type->_inline_check($access)
+                );
+        }
+        else {
+            push @code,
+                sprintf( '( %s )', $p->_inline_check($access) );
+        }
+    }
+
+    if ($slurpy) {
+        my $non_slurpy = scalar @of;
+        my $check
+            = '( @{%s} > %d ? ( List::Util::all { %s } @{%s}[%d .. $#{%s}] ) : 1 )';
+        push @code,
+            sprintf(
+            $check,
+            $val, $non_slurpy, $slurpy->_inline_check('$_'),
+            $val, $non_slurpy, $val,
+            );
+    }
+
+    return '( ' . ( join ' && ', @code ) . ' )';
+}
+
+1;
+
+# ABSTRACT: Guts of Tuple structured type
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Specio::Library::Structured::Tuple - Guts of Tuple structured type
+
+=head1 VERSION
+
+version 0.46
+
+=head1 DESCRIPTION
+
+There are no user facing parts here.
+
+=for Pod::Coverage .*
+
+=head1 SUPPORT
+
+Bugs may be submitted at L<https://github.com/houseabsolute/Specio/issues>.
+
+I am also usually active on IRC as 'autarch' on C<irc://irc.perl.org>.
+
+=head1 SOURCE
+
+The source code repository for Specio can be found at L<https://github.com/houseabsolute/Specio>.
+
+=head1 AUTHOR
+
+Dave Rolsky <autarch@urth.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is Copyright (c) 2012 - 2020 by Dave Rolsky.
+
+This is free software, licensed under:
+
+  The Artistic License 2.0 (GPL Compatible)
+
+The full text of the license can be found in the
+F<LICENSE> file included with this distribution.
+
+=cut