Allow fields to be optional

masak · Oct 6, 2017 · a2b153a · a2b153a
1 parent 819aaaa
commit a2b153a
Show file tree

Hide file tree

Showing 2 changed files with 16 additions and 12 deletions.
diff --git a/lib/_007/Object.pm b/lib/_007/Object.pm
@@ -125,7 +125,11 @@ sub create(_007::Type $type, *%properties) is export {
 
         my $value = %properties{$property};
         my $type-union = %fields{$property}<type>;
-        for $type-union.split(/ \h* "|" \h* /) -> $fieldtypename {
+        my @type-union = $type-union.split(/ \h* "|" \h* /);
+        if %fields{$property}<optional> {
+            @type-union.push("NoneType");
+        }
+        for @type-union -> $fieldtypename {
             my $fieldtype = TYPE{$fieldtypename}
                 or die "No such type {$fieldtypename}";
             next PROPERTY
@@ -134,16 +138,15 @@ sub create(_007::Type $type, *%properties) is export {
         die X::Type.new(
             :operation("instantiation of {$type.name} with property $property"),
             :got($value),
-            :expected(_007::Type.new(:name($type-union))),
+            :expected(_007::Type.new(:name(@type-union.join(" | ")))),
         );
     }
-    # XXX: need to screen for required properties by traversing @.fields, but we don't have the
-    #      infrastructure in terms of a way to mark up a field as required
 
-    # XXX: for now, let's pretend all properties are required. not pleasant, but we can live with it for a short time
-    for %fields.keys -> $field {
-        die "Need to pass property '$field' when creating a {$type.name}"
-            unless $field (elem) $seen;
+    for %fields.kv -> $name, $field {
+        next if $field<optional>;
+
+        die "Need to pass property '$name' when creating a {$type.name}"
+            unless $name (elem) $seen;
     }
 
     # XXX: ditto for property default values

diff --git a/lib/_007/Parser/Actions.pm b/lib/_007/Parser/Actions.pm
@@ -673,19 +673,20 @@ class _007::Parser::Actions {
         my $type = $<identifier>.ast.properties<name>.value;
         my $type-obj = $*runtime.get-var($type);
 
-        my $known-properties = set($type-obj.type-chain.reverse.map({ .fields }).flat.map({ .<name> }));
+        my @known-properties = $type-obj.type-chain.reverse.map({ .fields }).flat;
         my $seen-properties = set();
         for $<propertylist>.ast.properties<properties>.value -> $p {
             my $property = $p.properties<key>.value;
             # Here we make a slight exception for the wrapped types
             next if $property eq "value" && $type eq "Int" | "Str" | "Array" | "Dict";
             die X::Property::NotDeclared.new(:$type, :$property)
-                unless $property (elem) $known-properties;
+                unless $property (elem) @known-properties.map({ .<name> });
             $seen-properties (|)= $property;
         }
-        for $known-properties.keys -> $property {
-            # XXX: once we handle optional properties, we will `next` here
+        for @known-properties -> $p {
+            next if $p<optional>;
 
+            my $property = $p<name>;
             die X::Property::Required.new(:$type, :$property)
                 unless $property (elem) $seen-properties;
         }