Add full support for maps

proper-testing · Oct 25, 2022 · e602076 · e602076
1 parent 3bbd252
commit e602076
Show file tree

Hide file tree

Showing 2 changed files with 73 additions and 5 deletions.
diff --git a/src/proper_gen.erl b/src/proper_gen.erl
@@ -42,8 +42,8 @@
 	 binary_rev/1, binary_len_gen/1, bitstring_gen/1, bitstring_rev/1,
 	 bitstring_len_gen/1, list_gen/2, distlist_gen/3, vector_gen/2,
 	 union_gen/1, weighted_union_gen/1, tuple_gen/1, loose_tuple_gen/2,
-	 loose_tuple_rev/2, exactly_gen/1, fixed_list_gen/1, function_gen/2,
-	 any_gen/1, native_type_gen/2, safe_weighted_union_gen/1,
+	 loose_tuple_rev/2, exactly_gen/1, fixed_list_gen/1, fixed_map_gen/1,
+	 function_gen/2, any_gen/1, native_type_gen/2, safe_weighted_union_gen/1,
 	 safe_union_gen/1]).
 
 %% Public API types
@@ -576,6 +576,15 @@ fixed_list_gen({ProperHead,ImproperTail}) ->
 fixed_list_gen(ProperFields) ->
     [generate(F) || F <- ProperFields].
 
+%% @private
+-spec fixed_map_gen(map()) -> imm_instance().
+fixed_map_gen(Map) when is_map(Map) ->
+	maps:from_list([
+		{generate(KeyOrType), generate(ValueOrType)}
+	||
+		{KeyOrType, ValueOrType} <- maps:to_list(Map)
+	]).
+
 %% @private
 -spec function_gen(arity(), proper_types:type()) -> function().
 function_gen(Arity, RetType) ->

diff --git a/src/proper_types.erl b/src/proper_types.erl
@@ -141,8 +141,8 @@
 
 -export([integer/2, float/2, atom/0, binary/0, binary/1, bitstring/0,
 	 bitstring/1, list/1, vector/2, union/1, weighted_union/1, tuple/1,
-	 loose_tuple/1, exactly/1, fixed_list/1, function/2, map/0, map/2,
-	 any/0, shrink_list/1, safe_union/1, safe_weighted_union/1]).
+	 loose_tuple/1, exactly/1, fixed_list/1, fixed_map/1, function/2, map/0,
+     map/2, any/0, shrink_list/1, safe_union/1, safe_weighted_union/1]).
 -export([integer/0, non_neg_integer/0, pos_integer/0, neg_integer/0, range/2,
 	 float/0, non_neg_float/0, number/0, boolean/0, byte/0, char/0, nil/0,
 	 list/0, tuple/0, string/0, wunion/1, term/0, timeout/0, arity/0]).
@@ -258,7 +258,7 @@
     | {'shrinkers', [proper_shrink:shrinker()]}
     | {'noshrink', boolean()}
     | {'internal_type', raw_type()}
-    | {'internal_types', tuple() | maybe_improper_list(type(),type() | [])}
+    | {'internal_types', tuple() | map() | maybe_improper_list(type(),type() | [])}
       %% The items returned by 'remove' must be of this type.
     | {'get_length', fun((proper_gen:imm_instance()) -> length())}
       %% If this is a container type, this should return the number of elements
@@ -312,6 +312,8 @@ cook_outer(RawType) when is_tuple(RawType) ->
     tuple(tuple_to_list(RawType));
 cook_outer(RawType) when is_list(RawType) ->
     fixed_list(RawType); %% CAUTION: this must handle improper lists
+cook_outer(RawType) when is_map(RawType) ->
+    fixed_map(RawType);
 cook_outer(RawType) -> %% default case (integers, floats, atoms, binaries, ...)
     exactly(RawType).
 
@@ -1124,6 +1126,63 @@ map() ->
 map(K, V) ->
     ?LET(L, list({K, V}), maps:from_list(L)).
 
+%% @doc A map whose keys and values are defined by the given `Map'.
+%% Also written simply as a {@link maps. map}.
+-spec fixed_map(#{Key::raw_type() => Value::raw_type()}) -> proper_types:type().
+% fixed_map(Map) when is_map(Map) ->
+%     Pairs = maps:to_list(Map),
+%     ?LET(L, fixed_list(Pairs), maps:from_list(L)).
+
+fixed_map(Map) when is_map(Map) ->
+    ?CONTAINER([
+        {generator, {typed, fun map_gen/1}},
+        {is_instance, {typed, fun map_is_instance/2}},
+        {internal_types, Map},
+        {get_length, fun maps:size/1},
+        {join, fun maps:merge/2},
+        {get_indices, fun maps:keys/1},
+        {remove, fun maps:remove/2},
+        {retrieve, fun maps:get/2},
+        {update, fun maps:update/3}
+    ]).
+
+map_gen(Type) ->
+    Map = get_prop(internal_types, Type),
+    proper_gen:fixed_map_gen(Map).
+
+map_is_instance(Type, X) when is_map(X) ->
+    Map = get_prop(internal_types, Type),
+    map_all(
+        fun (Key, ValueType) when is_map_key(Key, X) ->
+                is_instance(maps:get(Key, X), ValueType);
+            (KeyOrType, ValueType) ->
+                case is_raw_type(KeyOrType) of
+                    true ->
+                        map_all(fun(Key, Value) ->
+                            case is_instance(Key, KeyOrType) of
+                                true -> is_instance(Value, ValueType);
+                                false -> true %% Ignore other keys
+                            end
+                        end, X);
+                    false ->
+                        %% The key not a type and not in `X'
+                        false
+                end
+        end,
+        Map
+    );
+map_is_instance(_Type, _X) ->
+    false.
+
+map_all(Fun, Map) when is_function(Fun, 2) andalso is_map(Map) ->
+    map_all_internal(Fun, maps:next(maps:iterator(Map)), true).
+
+map_all_internal(Fun, _, false) when is_function(Fun, 2) ->
+    false;
+map_all_internal(Fun, none, Result) when is_function(Fun, 2) andalso is_boolean(Result) ->
+    Result;
+map_all_internal(Fun, {Key, Value, NextIterator}, true) when is_function(Fun, 2) ->
+    map_all_internal(Fun, NextIterator, Fun(Key, Value)).
 
 %% @doc All Erlang terms (that PropEr can produce). For reasons of efficiency,
 %% functions are never produced as instances of this type.<br />