Merge pull request #328 from tom-binary/feature/checks

Constraint checking via Data::Checks

Makefile.PL

@@ -28,6 +28,7 @@ my %WriteMakefileArgs = (
     "Class::Method::Modifiers" => 0,
     "Compress::Zstd" => "0.20",
     "Config::Any" => "0.33",
+    "Data::Checks" => "0.07",
     "Devel::MAT::Dumper" => 0,
     "Future" => "0.50",
     "Future::AsyncAwait" => "0.66",
@@ -58,6 +59,7 @@ my %WriteMakefileArgs = (
     "Net::Async::OpenTracing" => "1.001",
     "Net::Async::Redis" => "6.000",
     "Object::Pad" => "0.808",
+    "Object::Pad::FieldAttr::Checked" => 0,
     "OpenTelemetry" => "0.023",
     "OpenTelemetry::Exporter::OTLP" => "0.016",
     "OpenTelemetry::SDK" => "0.022",
@@ -68,6 +70,8 @@ my %WriteMakefileArgs = (
     "Ryu" => "3.005",
     "Ryu::Async" => "0.020",
     "Scope::Guard" => 0,
+    "Signature::Attribute::Checked" => 0,
+    "Sublike::Extended" => 0,
     "Syntax::Keyword::Defer" => "0.10",
     "Syntax::Keyword::Dynamically" => "0.13",
     "Syntax::Keyword::Match" => "0.14",
@@ -76,11 +80,12 @@ my %WriteMakefileArgs = (
     "Sys::Hostname" => 0,
     "Time::Moment" => "0.44",
     "Unicode::UTF8" => 0,
-    "XS::Parse::Keyword" => "== 0.42",
+    "XS::Parse::Keyword" => "0.42",
     "XS::Parse::Sublike" => "0.21",
     "YAML::XS" => "0.89",
     "bareword::filehandles" => 0,
     "curry" => "2.000001",
+    "experimental" => "0.032",
     "indirect" => 0,
     "meta" => "0.004",
     "mro" => 0,
@@ -116,6 +121,7 @@ my %FallbackPrereqs = (
   "Class::Method::Modifiers" => 0,
   "Compress::Zstd" => "0.20",
   "Config::Any" => "0.33",
+  "Data::Checks" => "0.07",
   "Devel::MAT::Dumper" => 0,
   "ExtUtils::MakeMaker" => 0,
   "File::Spec" => 0,
@@ -152,6 +158,7 @@ my %FallbackPrereqs = (
   "Net::Async::OpenTracing" => "1.001",
   "Net::Async::Redis" => "6.000",
   "Object::Pad" => "0.808",
+  "Object::Pad::FieldAttr::Checked" => 0,
   "OpenTelemetry" => "0.023",
   "OpenTelemetry::Exporter::OTLP" => "0.016",
   "OpenTelemetry::SDK" => "0.022",
@@ -162,6 +169,8 @@ my %FallbackPrereqs = (
   "Ryu" => "3.005",
   "Ryu::Async" => "0.020",
   "Scope::Guard" => 0,
+  "Signature::Attribute::Checked" => 0,
+  "Sublike::Extended" => 0,
   "Syntax::Keyword::Defer" => "0.10",
   "Syntax::Keyword::Dynamically" => "0.13",
   "Syntax::Keyword::Match" => "0.14",
@@ -178,11 +187,12 @@ my %FallbackPrereqs = (
   "Test::NoTabs" => 0,
   "Time::Moment" => "0.44",
   "Unicode::UTF8" => 0,
-  "XS::Parse::Keyword" => "== 0.42",
+  "XS::Parse::Keyword" => "0.42",
   "XS::Parse::Sublike" => "0.21",
   "YAML::XS" => "0.89",
   "bareword::filehandles" => 0,
   "curry" => "2.000001",
+  "experimental" => "0.032",
   "indirect" => 0,
   "meta" => "0.004",
   "mro" => 0,

cpanfile

@@ -4,7 +4,8 @@ requires 'mro';
 requires 'indirect';
 requires 'multidimensional';
 requires 'bareword::filehandles';
-requires 'XS::Parse::Keyword', '== 0.42';
+requires 'experimental', '>= 0.032';
+requires 'XS::Parse::Keyword', '>= 0.42';
 requires 'Syntax::Keyword::Dynamically', '>= 0.13';
 requires 'Syntax::Keyword::Try', '>= 0.29';
 requires 'Syntax::Keyword::Defer', '>= 0.10';
@@ -18,6 +19,10 @@ requires 'Future::IO', '>= 0.15';
 requires 'XS::Parse::Sublike', '>= 0.21';
 requires 'Object::Pad', '>= 0.808';
 requires 'Role::Tiny', '>= 2.002004';
+requires 'Data::Checks', '>= 0.07';
+requires 'Object::Pad::FieldAttr::Checked';
+requires 'Sublike::Extended';
+requires 'Signature::Attribute::Checked';
 # Streams
 requires 'Ryu', '>= 3.005';
 requires 'Ryu::Async', '>= 0.020';

lib/Myriad/Class.pm

@@ -53,7 +53,9 @@ The following Perl language features and modules are applied:
 
 =item * L<Syntax::Keyword::Dynamically>
 
-=item * L<Syntax::Keyword::Defer>
+=item * L<Syntax::Keyword::Defer> - or the standard Perl built-in defer since C< :v2 >
+
+=item * L<Syntax::Operator::Equ> - added in C< :v2 >
 
 =item * L<Future::AsyncAwait>
 
@@ -63,6 +65,8 @@ The following Perl language features and modules are applied:
 
 =item * provides L<List::Util/min>, L<List::Util/max>, L<List::Util/sum0>
 
+=item * provides L<List::Util/uniqstr> - added in C< :v2 >
+
 =item * provides L<List::Keywords/any>, L<List::Keywords/all>
 
 =item * provides L<JSON::MaybeUTF8/encode_json_text>, L<JSON::MaybeUTF8/encode_json_utf8>,
@@ -94,6 +98,72 @@ In addition, the following core L<feature>s are enabled:
 
 =back
 
+=head2 Constraints and checks
+
+From C<:v2> onwards, L<Data::Checks> is imported with the following constraints available: 
+
+=over 4
+
+=item * Defined
+
+=item * Object
+
+=item * Str
+
+=item * Num
+
+=item * StrEq
+
+=item * NumGT
+
+=item * NumGE
+
+=item * NumLE
+
+=item * NumLT
+
+=item * NumRange
+
+=item * NumEq
+
+=item * Isa
+
+=item * ArrayRef
+
+=item * HashRef
+
+=item * Callable
+
+=item * Maybe
+
+=item * Any
+
+=item * All
+
+=back
+
+Note that L<Data::Checks> provides the underlying support for constraints, but
+actual usage involves a combination of other modules:
+
+=head3 Field constraints
+
+These are supported through L<Object::Pad::FieldAttr::Checked>:
+
+ package Example;
+ use Myriad::Class qw(:v2);
+ field $checked :Checked(Str);
+
+=head3 Method parameter constraints
+
+These use L<Signature::Attribute::Checked> to provide method parameter checks.
+Note that the C<extended> keyword is required, see L<Sublike::Extended> for more information.
+
+ package Example;
+ use Myriad::Class qw(:v2);
+ extended method example ($v :Checked(Num)) { }
+
+=head2 Class features
+
 The calling package will be marked as an L<Object::Pad> class, providing the
 L<Object::Pad/method>, L<Object::Pad/has> and C<async method> keywords.
 
@@ -121,6 +191,10 @@ no bareword::filehandles;
 use mro;
 use experimental qw(signatures);
 use curry;
+use Data::Checks;
+use Object::Pad::FieldAttr::Checked;
+use Sublike::Extended;
+use Signature::Attribute::Checked;
 use Future::AsyncAwait;
 use Future::AsyncAwait::Hooks;
 use Syntax::Keyword::Try;
@@ -164,13 +238,14 @@ sub import {
     warnings->import;
     utf8->import;
 
-    # We want mostly the 5.26 featureset, but since that includes `say` and `switch`
+    # We want mostly the 5.36 featureset, but since that includes `say` and `switch`
     # we need to customise the list somewhat
     feature->import(qw(
         bitwise
         current_sub
         evalbytes
         fc
+        module_true
         postderef_qq
         state
         unicode_eval
@@ -199,6 +274,36 @@ sub import {
     # Helper functions which are used often enough to be valuable as a default
     Scalar::Util->export($pkg => qw(refaddr blessed weaken));
     List::Util->export($pkg => qw(min max sum0));
+
+    # Additional features in :v2 onwards
+    if($version >= 2) {
+        List::Util->export($pkg => qw(uniqstr));
+        # eval "package $pkg; use Object::Pad::FieldAttr::Checked; use Data::Checks qw(NumGE); 1" or die $@;
+        Object::Pad::FieldAttr::Checked->import($pkg);
+        Sublike::Extended->import($pkg);
+        Signature::Attribute::Checked->import($pkg);
+        Data::Checks->import(qw(
+            Defined
+            Object
+            Str
+            Num
+            StrEq
+            NumGT
+            NumGE
+            NumLE
+            NumLT
+            NumRange
+            NumEq
+            Isa
+            ArrayRef
+            HashRef
+            Callable
+            Maybe
+            Any
+            All
+        ));
+    }
+
     {
         no strict 'refs';
         *{$pkg . '::' . $_} = JSON::MaybeUTF8->can($_) for qw(

t/syntax.t

@@ -152,6 +152,7 @@ subtest 'Myriad::Class :v2' => sub {
             await $f;
             return;
         }
+        extended method checked ($v : Checked(NumGE(5))) { 'ok' }
         __PACKAGE__
     }), 'local::v2') or diag $@;
     my $obj = local::v2->new;
@@ -161,6 +162,15 @@ subtest 'Myriad::Class :v2' => sub {
     $pending->done;
     is($obj->suspended // 0, 1, 'have still suspended once');
     is($obj->resumed // 0, 1, 'and resumed once now');
+    is(exception {
+        $obj->checked(5)
+    }, undef, 'can check numeric >= 5');
+    like(exception {
+        $obj->checked(-3)
+    }, qr/\Qsatisfying :Checked(NumGE(5))/, 'numeric check fails on number out of range');
+    like(exception {
+        $obj->checked('xx')
+    }, qr/\Qsatisfying :Checked(NumGE(5))/, 'numeric check fails on invalid number');
     done_testing;
 };
 done_testing;