From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sat, 7 Apr 2018 17:41:11 +0000 (+0000)
Subject: pervasive type constraints
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2548ce615db02d9ebd44d15359c1220aaf06798f;p=scpubgit%2FDX.git

pervasive type constraints
---

diff --git a/bin/dx b/bin/dx
index cf0410e..e705dfc 100644
--- a/bin/dx
+++ b/bin/dx
@@ -9,6 +9,7 @@ use DX::Utils qw(:builders);
     return $line;
   }
   sub history_add {}
+  sub isa { require Caroline; return 1 if Caroline->isa($_[1]); }
 }
 
 use_module('DX::ShellFrontend')->new(
diff --git a/lib/DX/Action/AddValue.pm b/lib/DX/Action/AddValue.pm
index b9c8c69..8271f70 100644
--- a/lib/DX/Action/AddValue.pm
+++ b/lib/DX/Action/AddValue.pm
@@ -5,14 +5,16 @@ use DX::Class;
 
 with 'DX::Role::SimpleAction';
 
-has new_value => (is => 'ro', required => 1);
+has new_value => (is => 'ro', required => 1, isa => Value);
 
 sub _build__updates {
   my ($self) = @_;
-  DX::Update::AddValue->new(
-    target_path => $self->target_path,
-    new_value => $self->new_value,
-  );
+  [
+    DX::Update::AddValue->new(
+      target_path => $self->target_path,
+      new_value => $self->new_value,
+    )
+  ]
 }
 
 1;
diff --git a/lib/DX/Action/BindValue.pm b/lib/DX/Action/BindValue.pm
index c8f43d1..57b36d8 100644
--- a/lib/DX/Action/BindValue.pm
+++ b/lib/DX/Action/BindValue.pm
@@ -6,7 +6,7 @@ use DX::Class;
 
 with 'DX::Role::SimpleAction';
 
-has new_value => (is => 'ro', required => 1);
+has new_value => (is => 'ro', required => 1, isa => Value);
 
 sub for_deparse {
   my ($self) = @_;
@@ -22,10 +22,12 @@ sub for_deparse {
 
 sub _build__updates {
   my ($self) = @_;
-  DX::Update::SetValue->new(
-    target_path => $self->target_path,
-    new_value => $self->new_value,
-  );
+  [
+    DX::Update::SetValue->new(
+      target_path => $self->target_path,
+      new_value => $self->new_value,
+    )
+  ]
 }
 
 1;
diff --git a/lib/DX/Action/SetValue.pm b/lib/DX/Action/SetValue.pm
index d31ed58..12fe648 100644
--- a/lib/DX/Action/SetValue.pm
+++ b/lib/DX/Action/SetValue.pm
@@ -5,14 +5,16 @@ use DX::Class;
 
 with 'DX::Role::SimpleAction';
 
-has new_value => (is => 'ro', required => 1);
+has new_value => (is => 'ro', required => 1, isa => Value);
 
 sub _build__updates {
   my ($self) = @_;
-  DX::Update::SetValue->new(
-    target_path => $self->target_path,
-    new_value => $self->new_value,
-  );
+  [
+    DX::Update::SetValue->new(
+      target_path => $self->target_path,
+      new_value => $self->new_value,
+    )
+  ]
 }
 
 1;
diff --git a/lib/DX/ActionBuilder/BoundValue.pm b/lib/DX/ActionBuilder/BoundValue.pm
index 7c06e1c..db3cf22 100644
--- a/lib/DX/ActionBuilder/BoundValue.pm
+++ b/lib/DX/ActionBuilder/BoundValue.pm
@@ -7,13 +7,15 @@ use DX::Class;
 
 with 'DX::Role::ActionBuilder';
 
-has target_path => (is => 'ro', required => 1);
+has target_path => (is => 'ro', required => 1, isa => ValuePath);
 
-has rebind_path => (is => 'ro', required => 1);
+has rebind_path => (is => 'ro', required => 1, isa => ValuePath);
 
-has bound_to_path => (is => 'ro', required => 1);
+has bound_to_path => (is => 'ro', required => 1, isa => ValuePath);
 
-has inner_action_builder => (is => 'ro', required => 1);
+has inner_action_builder => (
+  is => 'ro', required => 1, isa => ActionBuilder
+);
 
 sub can_set_value { shift->inner_action_builder->can_set_value }
 
diff --git a/lib/DX/ActionBuilder/Normal.pm b/lib/DX/ActionBuilder/Normal.pm
index 8b3096e..de57498 100644
--- a/lib/DX/ActionBuilder/Normal.pm
+++ b/lib/DX/ActionBuilder/Normal.pm
@@ -7,7 +7,7 @@ use DX::Class;
 
 with 'DX::Role::ActionBuilder';
 
-has target_path => (is => 'ro', required => 1);
+has target_path => (is => 'ro', required => 1, isa => ValuePath);
 
 sub aperture_for_set_value {
   [ [ VALUE_SET ,=> @{$_[0]->target_path} ] ]
diff --git a/lib/DX/ActionBuilder/Null.pm b/lib/DX/ActionBuilder/Null.pm
index 5aac1b3..41109f6 100644
--- a/lib/DX/ActionBuilder/Null.pm
+++ b/lib/DX/ActionBuilder/Null.pm
@@ -4,13 +4,7 @@ use DX::Class;
 
 with 'DX::Role::ActionBuilder';
 
-has target_path => (is => 'ro');
-
-around target_path => sub {
-  my ($orig, $self) = (shift, shift);
-  return undef unless ref($self);
-  return $self->$orig(@_);
-};
+has target_path => (is => 'ro', isa => ValuePath);
 
 sub can_set_value { 0 }
 
diff --git a/lib/DX/ActionBuilder/ProxySetToAdd.pm b/lib/DX/ActionBuilder/ProxySetToAdd.pm
index e1e8bf8..06b0885 100644
--- a/lib/DX/ActionBuilder/ProxySetToAdd.pm
+++ b/lib/DX/ActionBuilder/ProxySetToAdd.pm
@@ -5,9 +5,9 @@ use DX::Class;
 
 with 'DX::Role::ActionBuilder';
 
-has target_path => (is => 'ro', required => 1);
+has target_path => (is => 'ro', required => 1, isa => ValuePath);
 
-has proxy_to => (is => 'ro', required => 1);
+has proxy_to => (is => 'ro', required => 1, isa => ActionBuilder);
 
 sub aperture_for_set_value {
   my ($self) = @_;
diff --git a/lib/DX/ActionBuilder/UnsetValue.pm b/lib/DX/ActionBuilder/UnsetValue.pm
index b2c1ddf..1baacc5 100644
--- a/lib/DX/ActionBuilder/UnsetValue.pm
+++ b/lib/DX/ActionBuilder/UnsetValue.pm
@@ -9,7 +9,7 @@ use DX::Class;
 
 with 'DX::Role::ActionBuilder';
 
-has target_path => (is => 'ro', required => 1);
+has target_path => (is => 'ro', required => 1, isa => ValuePath);
 
 sub aperture_for_set_value {
   [ [ VALUE_SET ,=> @{$_[0]->target_path} ] ]
diff --git a/lib/DX/Class.pm b/lib/DX/Class.pm
index 7d8987c..2f23881 100644
--- a/lib/DX/Class.pm
+++ b/lib/DX/Class.pm
@@ -6,7 +6,9 @@ sub import {
   strictures->import::into({ level => 1, version => 2 }); # should pass version
   DX::Types->import::into(1, ':types', ':assert');
   DX::Utils->import::into(1, '*trace');
-  Types::Standard->import::into(1, 'Maybe');
+  Types::Standard->import::into(
+    1, qw(Maybe ArrayRef HashRef Str Num Int Enum Bool)
+  );
   Try::Tiny->import::into(1);
   Moo->import::into(1);
   # This would not be safe with method modifiers, but since the role
diff --git a/lib/DX/Hypothesis.pm b/lib/DX/Hypothesis.pm
index 0131688..c3a8fe4 100644
--- a/lib/DX/Hypothesis.pm
+++ b/lib/DX/Hypothesis.pm
@@ -1,7 +1,6 @@
 package DX::Hypothesis;
 
 use DX::ActionPolicy::LockScope;
-use Types::Standard qw(ArrayRef);
 use DX::Utils qw(deparse);
 use DX::Class;
 
diff --git a/lib/DX/Proposition.pm b/lib/DX/Proposition.pm
index b173ca8..6c2d133 100644
--- a/lib/DX/Proposition.pm
+++ b/lib/DX/Proposition.pm
@@ -1,6 +1,5 @@
 package DX::Proposition;
 
-use Types::Standard qw(HashRef ArrayRef Str);
 use DX::Class;
 
 has predicate => (is => 'ro', isa => Str, required => 1);
diff --git a/lib/DX/PropositionSequence.pm b/lib/DX/PropositionSequence.pm
index 1756e15..3bf3341 100644
--- a/lib/DX/PropositionSequence.pm
+++ b/lib/DX/PropositionSequence.pm
@@ -1,6 +1,5 @@
 package DX::PropositionSequence;
 
-use Types::Standard qw(HashRef);
 use DX::Class;
 
 has members => (is => 'ro', isa => PropositionList, required => 1);
diff --git a/lib/DX/QueryState.pm b/lib/DX/QueryState.pm
index 9ef30a5..b378783 100644
--- a/lib/DX/QueryState.pm
+++ b/lib/DX/QueryState.pm
@@ -1,6 +1,5 @@
 package DX::QueryState;
 
-use Types::Standard qw(HashRef);
 use DX::Scope;
 use DX::Hypothesis;
 use DX::SearchProcess;
diff --git a/lib/DX/ResolvedPropositionSet.pm b/lib/DX/ResolvedPropositionSet.pm
index 74b29db..89a3d5e 100644
--- a/lib/DX/ResolvedPropositionSet.pm
+++ b/lib/DX/ResolvedPropositionSet.pm
@@ -1,7 +1,6 @@
 package DX::ResolvedPropositionSet;
 
 use DX::DependencyMap;
-use Types::Standard qw(ArrayRef Int);
 use DX::Utils qw(deparse);
 use DX::Class;
 
diff --git a/lib/DX/Role.pm b/lib/DX/Role.pm
index a15f9cb..fb69a74 100644
--- a/lib/DX/Role.pm
+++ b/lib/DX/Role.pm
@@ -6,7 +6,9 @@ sub import {
   strictures->import::into({ level => 1, version => 2 });
   DX::Types->import::into(1, ':types', ':assert');
   DX::Utils->import::into(1, '*trace');
-  Types::Standard->import::into(1, 'Maybe');
+  Types::Standard->import::into(
+    1, qw(Maybe ArrayRef HashRef Str Num Enum Bool)
+  );
   Try::Tiny->import::into(1);
   Moo::Role->import::into(1);
 }
diff --git a/lib/DX/Role/BoundValueAction.pm b/lib/DX/Role/BoundValueAction.pm
index 3bd125e..ed8d586 100644
--- a/lib/DX/Role/BoundValueAction.pm
+++ b/lib/DX/Role/BoundValueAction.pm
@@ -4,15 +4,15 @@ use DX::Role;
 
 with 'DX::Role::Action';
 
-has target_path => (is => 'ro', required => 1);
+has target_path => (is => 'ro', required => 1, isa => ValuePath);
 
-has bound_to_path => (is => 'ro', required => 1);
+has bound_to_path => (is => 'ro', required => 1, isa => ValuePath);
 
-has rebind_path => (is => 'ro', required => 1);
+has rebind_path => (is => 'ro', required => 1, isa => ValuePath);
 
-has new_value => (is => 'ro', required => 1);
+has new_value => (is => 'ro', required => 1, isa => Value);
 
-has inner_action => (is => 'ro', required => 1);
+has inner_action => (is => 'ro', required => 1, isa => Action);
 
 requires 'update_class';
 
diff --git a/lib/DX/Role/SimpleAction.pm b/lib/DX/Role/SimpleAction.pm
index 62bf837..193716e 100644
--- a/lib/DX/Role/SimpleAction.pm
+++ b/lib/DX/Role/SimpleAction.pm
@@ -4,9 +4,9 @@ use DX::Role;
 
 with 'DX::Role::Action';
 
-has target_path => (is => 'ro', required => 1);
+has target_path => (is => 'ro', required => 1, isa => ValuePath);
 
-has _updates => (is => 'lazy');
+has _updates => (is => 'lazy', isa => ArrayRef[Update]);
 
 requires '_build__updates';
 
@@ -21,7 +21,7 @@ sub for_deparse {
 
 sub dry_run {
   my ($self, $hyp) = @_;
-  my ($scope, @events) = $hyp->scope->apply_updates($self->_updates);
+  my ($scope, @events) = $hyp->scope->apply_updates(@{$self->_updates});
   return (
     $hyp->but(
       scope => $scope,
diff --git a/lib/DX/Role/Update.pm b/lib/DX/Role/Update.pm
index f7cfcb5..97ee6c5 100644
--- a/lib/DX/Role/Update.pm
+++ b/lib/DX/Role/Update.pm
@@ -2,7 +2,7 @@ package DX::Role::Update;
 
 use DX::Role;
 
-has target_path => (is => 'ro', required => 1);
+has target_path => (is => 'ro', required => 1, isa => ValuePath);
 
 sub _with_value_at_path {
   my ($self, $scope, $final_value, @path) = @_;
diff --git a/lib/DX/Role/Value.pm b/lib/DX/Role/Value.pm
index 41ff6dc..ef89517 100644
--- a/lib/DX/Role/Value.pm
+++ b/lib/DX/Role/Value.pm
@@ -3,9 +3,12 @@ package DX::Role::Value;
 use DX::ActionBuilder::Null;
 use DX::Role;
 
+my $_null = DX::ActionBuilder::Null->new;
+
 has action_builder => (
   is => 'ro',
-  default => 'DX::ActionBuilder::Null',
+  isa => ActionBuilder,
+  default => sub { $_null },
   handles => [ qw(can_set_value aperture_for_set_value action_for_set_value) ],
 );
 
diff --git a/lib/DX/Scope.pm b/lib/DX/Scope.pm
index ea0914f..489f9a3 100644
--- a/lib/DX/Scope.pm
+++ b/lib/DX/Scope.pm
@@ -1,6 +1,5 @@
 package DX::Scope;
 
-use Types::Standard qw(HashRef ArrayRef Str);
 use DX::Class;
 
 has predicates => (is => 'ro', isa => HashRef[Predicate], required => 1);
diff --git a/lib/DX/SearchState.pm b/lib/DX/SearchState.pm
index 8b08596..3ab4a66 100644
--- a/lib/DX/SearchState.pm
+++ b/lib/DX/SearchState.pm
@@ -1,6 +1,5 @@
 package DX::SearchState;
 
-use Types::Standard qw(Maybe Bool);
 use DX::Step::Backtrack;
 use DX::Step::ConsiderProposition;
 use DX::Step::MarkAsSolution;
diff --git a/lib/DX/ShellFrontend.pm b/lib/DX/ShellFrontend.pm
index 29eac40..3c95506 100644
--- a/lib/DX/ShellFrontend.pm
+++ b/lib/DX/ShellFrontend.pm
@@ -1,7 +1,7 @@
 package DX::ShellFrontend;
 
-use Types::Standard qw(Enum);
 use IO::Handle;
+use Types::Standard qw(InstanceOf);
 use Caroline;
 use DX::Class;
 
@@ -12,7 +12,10 @@ has session => (
 
 has session_mode => (is => 'rwp', isa => Enum['shell','query'], required => 1);
 
-has readline => (is => 'lazy', builder => sub { Caroline->new });
+has readline => (
+  is => 'lazy', isa => InstanceOf['Caroline'],
+  builder => sub { Caroline->new }
+);
 
 sub BUILD { STDOUT->autoflush(1) }
 
diff --git a/lib/DX/ShellSession.pm b/lib/DX/ShellSession.pm
index eae1349..589117b 100644
--- a/lib/DX/ShellSession.pm
+++ b/lib/DX/ShellSession.pm
@@ -7,16 +7,17 @@ use DX::Proposition;
 use DX::ActionBuilder::Normal;
 use DX::RuleDefinitionContext;
 use DX::Utils qw(deparse);
+use Types::Standard qw(InstanceOf);
 use DX::Class;
 
 has shell_state => (is => 'rwp', required => 1, isa => ShellState);
 
 has expander => (
   is => 'lazy', builder => sub { DX::Expander->new(tcl => $_[0]->tcl) },
-  handles => [ qw(expand_args) ],
+  isa => InstanceOf['DX::Expander'], handles => [ qw(expand_args) ],
 );
 
-has tcl => (is => 'lazy', builder => sub {
+has tcl => (is => 'lazy', isa => InstanceOf['Tcl'], builder => sub {
   my ($self) = @_;
   weaken $self;
   my $tcl = Tcl->new;
diff --git a/lib/DX/Step/ResolveProposition.pm b/lib/DX/Step/ResolveProposition.pm
index 0e28efc..a064b5f 100644
--- a/lib/DX/Step/ResolveProposition.pm
+++ b/lib/DX/Step/ResolveProposition.pm
@@ -3,7 +3,6 @@ package DX::Step::ResolveProposition;
 use DX::Step::EnterRecheck;
 use DX::Step::Backtrack;
 
-use Types::Standard qw(ArrayRef);
 use DX::Utils qw(expand_deps);
 
 use DX::Class;
diff --git a/lib/DX/TraceFormatter.pm b/lib/DX/TraceFormatter.pm
index bd6ea47..f23cc67 100644
--- a/lib/DX/TraceFormatter.pm
+++ b/lib/DX/TraceFormatter.pm
@@ -8,7 +8,7 @@ our $WS;
 our $Extra = 0;
 
 has ambient_indent_level => (
-  is => 'rwp', lazy => 1, clearer => 1, default => 0
+  is => 'rwp', lazy => 1, clearer => 1, default => 0, isa => Int
 );
 
 sub indent_by { '    ' }
diff --git a/lib/DX/Types.pm b/lib/DX/Types.pm
index b34565b..5a8756f 100644
--- a/lib/DX/Types.pm
+++ b/lib/DX/Types.pm
@@ -10,11 +10,11 @@ use Type::Library
       ResolutionSpace ResolutionStrategy Resolution
     )),
     (our @ROLES = qw(
-      Step Action ActionPolicy Predicate Value
+      Step Action ActionPolicy Predicate Value ActionBuilder Update
     )),
     qw(
       DependencyType _DependencyTree DependencySpec
-      One DependencyGroupEntry DependencyGroup
+      One DependencyGroupEntry DependencyGroup ValuePath
     ),
   )
 ;
@@ -34,6 +34,8 @@ foreach my $role (our @ROLES) {
 
 class_type DictValue => { class => 'DX::Value::Dict' };
 
+declare ValuePath => as ArrayRef[Str];
+
 declare PropositionList => as ArrayRef[Proposition];
 
 declare DecisionList => as ArrayRef[Tuple[ResolutionSpace, SearchState]];
diff --git a/lib/DX/Update/AddValue.pm b/lib/DX/Update/AddValue.pm
index 1b9ee1c..e0b2f9b 100644
--- a/lib/DX/Update/AddValue.pm
+++ b/lib/DX/Update/AddValue.pm
@@ -5,7 +5,7 @@ use DX::Class;
 
 with 'DX::Role::Update';
 
-has new_value => (is => 'ro', required => 1);
+has new_value => (is => 'ro', required => 1, isa => Value);
 
 sub apply_to {
   my ($self, $scope) = @_;
diff --git a/lib/DX/Update/SetValue.pm b/lib/DX/Update/SetValue.pm
index 1cce847..ae252c8 100644
--- a/lib/DX/Update/SetValue.pm
+++ b/lib/DX/Update/SetValue.pm
@@ -5,7 +5,7 @@ use DX::Class;
 
 with 'DX::Role::Update';
 
-has new_value => (is => 'ro', required => 1);
+has new_value => (is => 'ro', required => 1, isa => Value);
 
 sub apply_to {
   my ($self, $scope) = @_;
diff --git a/lib/DX/Value/Dict.pm b/lib/DX/Value/Dict.pm
index 8c61afe..914fe8f 100644
--- a/lib/DX/Value/Dict.pm
+++ b/lib/DX/Value/Dict.pm
@@ -12,7 +12,7 @@ has '+action_builder' => (
   ) ]
 );
 
-has members => (is => 'ro', required => 1);
+has members => (is => 'ro', required => 1, isa => HashRef[Value]);
 
 sub for_deparse {
   [ dict => $_[0]->members ]
diff --git a/lib/DX/Value/Number.pm b/lib/DX/Value/Number.pm
index 10500df..0805165 100644
--- a/lib/DX/Value/Number.pm
+++ b/lib/DX/Value/Number.pm
@@ -4,7 +4,7 @@ use DX::Class;
 
 with 'DX::Role::Value';
 
-has number_value => (is => 'ro', required => 1);
+has number_value => (is => 'ro', required => 1, isa => Num);
 
 sub for_deparse { [ number => $_[0]->number_value ] }
 
diff --git a/lib/DX/Value/String.pm b/lib/DX/Value/String.pm
index 33b110a..c50bd3c 100644
--- a/lib/DX/Value/String.pm
+++ b/lib/DX/Value/String.pm
@@ -4,7 +4,7 @@ use DX::Class;
 
 with 'DX::Role::Value';
 
-has string_value => (is => 'ro', required => 1);
+has string_value => (is => 'ro', required => 1, isa => Str);
 
 sub for_deparse { [ string => $_[0]->string_value ] }