add some better type constraints and coercions

2 files changed, 45 insertions, 2 deletions

diff --git a/lib/Web/Response.pm b/lib/Web/Response.pm
index e7b96c9..970f322 100644
--- a/lib/Web/Response.pm
+++ b/lib/Web/Response.pm
@@ -3,17 +3,20 @@ use Moose;
 
 use HTTP::Headers;
 
+use Web::Response::Types ();
+
 has status => (
     is      => 'rw',
-    isa     => 'Int', # XXX restrict to /^[1-5][0-9][0-9]$/
+    isa     => 'Web::Response::Types::HTTPStatus',
     lazy    => 1,
     default => sub { confess "Status was not supplied" },
 );
 
 has headers => (
     is      => 'rw',
-    isa     => 'HTTP::Headers', # XXX coerce from array/hashref
+    isa     => 'Web::Response::Types::HTTP::Headers',
     lazy    => 1,
+    coerce  => 1,
     default => sub { HTTP::Headers->new },
     handles => {
         header           => 'header',
@@ -26,7 +29,9 @@ has headers => (
 
 has body => (
     is      => 'rw',
+    isa     => 'Web::Response::Types::PSGIBody',
     lazy    => 1,
+    coerce  => 1,
     default => sub { [] },
 );
 
diff --git a/lib/Web/Response/Types.pm b/lib/Web/Response/Types.pm
new file mode 100644
index 0000000..297eab2
--- /dev/null
+++ b/lib/Web/Response/Types.pm
@@ -0,0 +1,38 @@
+package Web::Response::Types;
+use strict;
+use warnings;
+
+use Moose::Util::TypeConstraints;
+
+class_type('HTTP::Headers');
+
+subtype 'Web::Response::Types::StringLike',
+    as 'Object',
+    where {
+        return unless overload::Method($_, '""');
+        my $tc = find_type_constraint('Web::Response::Types::PSGIBodyObject');
+        return !$tc->check($_);
+    };
+
+duck_type 'Web::Response::Types::PSGIBodyObject' => ['getline', 'close'];
+
+subtype 'Web::Response::Types::PSGIBody',
+    as 'ArrayRef[Str]|FileHandle|Web::Response::Types::PSGIBodyObject';
+
+subtype 'Web::Response::Types::HTTPStatus',
+    as 'Int',
+    where { /^[1-5][0-9][0-9]$/ };
+
+subtype 'Web::Response::Types::HTTP::Headers',
+    as 'HTTP::Headers';
+coerce 'Web::Response::Types::HTTP::Headers',
+    from 'ArrayRef',
+    via { HTTP::Headers->new(@$_) },
+    from 'HashRef',
+    via { HTTP::Headers->new(%$_) };
+
+coerce 'Web::Response::Types::PSGIBody',
+    from 'Str|Web::Response::Types::StringLike',
+    via { [ $_ ] };
+
+1;