More precise class diff in case of enum constraint changes

Summary:
What the title says. So far there was no details for what changed in the enum constraints.
We also export the old class kind at the top-level because it will be used for optimistic fanout algorithm.

Reviewed By: bobrenjc93

Differential Revision: D37887340

fbshipit-source-id: d0ebe08e9c757a6bfe663bcae2a0f74fb09a0f7e

Author: CatherineGasnier

hphp/hack/src/decl/classDiff.ml

@@ -257,7 +257,16 @@ module ValueChange = struct
     | Modified of 'change
   [@@deriving eq, show { with_path = false }]
 
-  let to_json x = Hh_json.string_ @@ show (fun _ _ -> ()) x
+  let to_json change_to_json = function
+    | Added -> Hh_json.string_ "Added"
+    | Removed -> Hh_json.string_ "Removed"
+    | Modified change ->
+      Hh_json.JSON_Object [("Modified", change_to_json change)]
+
+  let map ~f = function
+    | Added -> Added
+    | Removed -> Removed
+    | Modified x -> Modified (f x)
 end
 
 module NamedItemsListChange = struct
@@ -281,22 +290,15 @@ type parent_changes = {
 }
 [@@deriving eq, show { with_path = false }]
 
+let classish_kind_to_json kind =
+  Hh_json.string_ @@ Ast_defs.show_classish_kind kind
+
 module KindChange = struct
-  type t = {
-    old_kind: Ast_defs.classish_kind;
-    new_kind: Ast_defs.classish_kind;
-  }
+  type t = { new_kind: Ast_defs.classish_kind }
   [@@deriving eq, show { with_path = false }]
 
-  let classish_kind_to_json kind =
-    Hh_json.string_ @@ Ast_defs.show_classish_kind kind
-
-  let to_json { old_kind; new_kind } =
-    Hh_json.JSON_Object
-      [
-        ("old_kind", classish_kind_to_json old_kind);
-        ("new_kind", classish_kind_to_json new_kind);
-      ]
+  let to_json { new_kind } =
+    Hh_json.JSON_Object [("new_kind", classish_kind_to_json new_kind)]
 end
 
 module BoolChange = struct
@@ -308,7 +310,23 @@ module BoolChange = struct
   let to_json x = Hh_json.string_ @@ show x
 end
 
+module ValueDiff = struct
+  type 'value t = {
+    old_value: 'value;
+    new_value: 'value;
+  }
+  [@@deriving eq, show { with_path = false }]
+end
+
+type enum_type_change = {
+  base_change: Typing_defs.decl_ty ValueDiff.t option;
+  constraint_change: Typing_defs.decl_ty ValueDiff.t ValueChange.t option;
+  includes_change: unit NamedItemsListChange.t NamedItemsListChange.t option;
+}
+[@@deriving eq, show { with_path = false }]
+
 type class_shell_change = {
+  classish_kind: Ast_defs.classish_kind;
   parent_changes: parent_changes option;
   type_parameters_change: unit NamedItemsListChange.t option;
   kind_change: KindChange.t option;
@@ -321,7 +339,7 @@ type class_shell_change = {
   module_change: unit ValueChange.t option;
   xhp_enum_values_change: bool;
   user_attributes_changes: unit NamedItemsListChange.t option;
-  enum_type_change: unit ValueChange.t option;
+  enum_type_change: enum_type_change ValueChange.t option;
 }
 [@@deriving eq, show { with_path = false }]
 
@@ -450,7 +468,45 @@ module ClassShellChangeCategory = struct
         ]
   end
 
+  let unit_to_json () = Hh_json.JSON_Null
+
+  module EnumTypeChangeCategory = struct
+    type t = {
+      has_base_change: bool;
+      constraint_change_category: unit ValueChange.t option;
+      includes_change_category: ListChange.t option;
+    }
+
+    let of_enum_type_change (change : enum_type_change) : t =
+      let { base_change; constraint_change; includes_change } = change in
+      {
+        has_base_change = Option.is_some base_change;
+        constraint_change_category =
+          Option.map (ValueChange.map ~f:(fun _ -> ())) constraint_change;
+        includes_change_category =
+          Option.map ListChange.of_list_change_map includes_change;
+      }
+
+    let to_json
+        {
+          has_base_change;
+          constraint_change_category;
+          includes_change_category;
+        } =
+      Hh_json.JSON_Object
+        [
+          ("has_base_change", Hh_json.bool_ has_base_change);
+          ( "constraint_change_category",
+            Hh_json.opt_
+              (ValueChange.to_json unit_to_json)
+              constraint_change_category );
+          ( "includes_change_category",
+            Hh_json.opt_ ListChange.to_json includes_change_category );
+        ]
+  end
+
   type t = {
+    classish_kind: Ast_defs.classish_kind;
     parent_changes_category: ParentsChangeCategory.t option;
     type_parameters_change_category: ListChange.t option;
     kind_change_category: KindChange.t option;
@@ -463,26 +519,29 @@ module ClassShellChangeCategory = struct
     module_change_category: unit ValueChange.t option;
     xhp_enum_values_change_category: bool;
     user_attributes_changes_category: ListChange.t option;
-    enum_type_change_category: unit ValueChange.t option;
+    enum_type_change_category: EnumTypeChangeCategory.t ValueChange.t option;
   }
 
   let of_class_shell_change
-      {
-        parent_changes;
-        type_parameters_change;
-        kind_change;
-        final_change;
-        abstract_change;
-        is_xhp_change;
-        internal_change;
-        has_xhp_keyword_change;
-        support_dynamic_type_change;
-        module_change;
-        xhp_enum_values_change;
-        user_attributes_changes;
-        enum_type_change;
-      } =
+      ({
+         classish_kind;
+         parent_changes;
+         type_parameters_change;
+         kind_change;
+         final_change;
+         abstract_change;
+         is_xhp_change;
+         internal_change;
+         has_xhp_keyword_change;
+         support_dynamic_type_change;
+         module_change;
+         xhp_enum_values_change;
+         user_attributes_changes;
+         enum_type_change;
+       } :
+        class_shell_change) =
     {
+      classish_kind;
       parent_changes_category =
         Option.map ParentsChangeCategory.of_parents_change parent_changes;
       type_parameters_change_category =
@@ -498,11 +557,15 @@ module ClassShellChangeCategory = struct
       xhp_enum_values_change_category = xhp_enum_values_change;
       user_attributes_changes_category =
         Option.map ListChange.of_list_change_map user_attributes_changes;
-      enum_type_change_category = enum_type_change;
+      enum_type_change_category =
+        Option.map
+          (ValueChange.map ~f:EnumTypeChangeCategory.of_enum_type_change)
+          enum_type_change;
     }
 
   let to_json
       {
+        classish_kind;
         parent_changes_category;
         type_parameters_change_category;
         kind_change_category;
@@ -520,6 +583,7 @@ module ClassShellChangeCategory = struct
     let open Hh_json in
     JSON_Object
       [
+        ("classish_kind", classish_kind_to_json classish_kind);
         ( "parent_changes",
           Hh_json.opt_ ParentsChangeCategory.to_json parent_changes_category );
         ( "type_parameters_change",
@@ -537,12 +601,15 @@ module ClassShellChangeCategory = struct
           Hh_json.opt_ BoolChange.to_json support_dynamic_type_change_category
         );
         ( "module_change",
-          Hh_json.opt_ ValueChange.to_json module_change_category );
+          Hh_json.opt_ (ValueChange.to_json unit_to_json) module_change_category
+        );
         ("xhp_enum_values_change", Hh_json.bool_ xhp_enum_values_change_category);
         ( "user_attributes_changes",
           Hh_json.opt_ ListChange.to_json user_attributes_changes_category );
         ( "enum_type_change",
-          Hh_json.opt_ ValueChange.to_json enum_type_change_category );
+          Hh_json.opt_
+            (ValueChange.to_json EnumTypeChangeCategory.to_json)
+            enum_type_change_category );
       ]
 end
 

hphp/hack/src/decl/classDiff.mli

@@ -57,11 +57,7 @@ type parent_changes = {
 }
 
 module KindChange : sig
-  type t = {
-    old_kind: Ast_defs.classish_kind;
-    new_kind: Ast_defs.classish_kind;
-  }
-  [@@deriving eq, show]
+  type t = { new_kind: Ast_defs.classish_kind } [@@deriving eq, show]
 end
 
 module BoolChange : sig
@@ -71,7 +67,23 @@ module BoolChange : sig
   [@@deriving eq, show]
 end
 
+module ValueDiff : sig
+  type 'value t = {
+    old_value: 'value;
+    new_value: 'value;
+  }
+  [@@deriving eq, show]
+end
+
+type enum_type_change = {
+  base_change: Typing_defs.decl_ty ValueDiff.t option;
+  constraint_change: Typing_defs.decl_ty ValueDiff.t ValueChange.t option;
+  includes_change: unit NamedItemsListChange.t NamedItemsListChange.t option;
+}
+[@@deriving eq, show]
+
 type class_shell_change = {
+  classish_kind: Ast_defs.classish_kind;
   parent_changes: parent_changes option;
   type_parameters_change: unit NamedItemsListChange.t option;
   kind_change: KindChange.t option;
@@ -84,7 +96,7 @@ type class_shell_change = {
   module_change: unit ValueChange.t option;
   xhp_enum_values_change: bool;
   user_attributes_changes: unit NamedItemsListChange.t option;
-  enum_type_change: unit ValueChange.t option;
+  enum_type_change: enum_type_change ValueChange.t option;
 }
 [@@deriving eq, show]
 

hphp/hack/src/decl/shallow_class_diff.ml

@@ -487,7 +487,7 @@ let diff_of_equal equal x y =
   else
     Some ()
 
-let diff_parent_lists =
+let diff_type_lists =
   diff_value_lists
     ~equal:Typing_defs.ty_equal
     ~get_name_value:type_name
@@ -503,26 +503,25 @@ let diff_parents (c1 : Parents.t) (c2 : Parents.t) : parent_changes option =
   else
     Some
       {
-        extends_changes =
-          diff_parent_lists c1.Parents.extends c2.Parents.extends;
+        extends_changes = diff_type_lists c1.Parents.extends c2.Parents.extends;
         implements_changes =
-          diff_parent_lists c1.Parents.implements c2.Parents.implements;
+          diff_type_lists c1.Parents.implements c2.Parents.implements;
         req_extends_changes =
-          diff_parent_lists c1.Parents.req_extends c2.Parents.req_extends;
+          diff_type_lists c1.Parents.req_extends c2.Parents.req_extends;
         req_implements_changes =
-          diff_parent_lists c1.Parents.req_implements c2.Parents.req_implements;
+          diff_type_lists c1.Parents.req_implements c2.Parents.req_implements;
         req_class_changes =
-          diff_parent_lists c1.Parents.req_class c2.Parents.req_class;
-        uses_changes = diff_parent_lists c1.Parents.uses c2.Parents.uses;
+          diff_type_lists c1.Parents.req_class c2.Parents.req_class;
+        uses_changes = diff_type_lists c1.Parents.uses c2.Parents.uses;
         xhp_attr_changes =
-          diff_parent_lists c1.Parents.xhp_attr_uses c2.Parents.xhp_attr_uses;
+          diff_type_lists c1.Parents.xhp_attr_uses c2.Parents.xhp_attr_uses;
       }
 
 let diff_kinds kind1 kind2 =
   if Ast_defs.equal_classish_kind kind1 kind2 then
     None
   else
-    Some { KindChange.old_kind = kind1; new_kind = kind2 }
+    Some { KindChange.new_kind = kind2 }
 
 let diff_bools b1 b2 =
   match (b1, b2) with
@@ -532,20 +531,60 @@ let diff_bools b1 b2 =
   | (false, true) -> Some BoolChange.Became
   | (true, false) -> Some BoolChange.No_more
 
-let diff_options option1 option2 ~equal =
+let diff_options option1 option2 ~diff =
   match (option1, option2) with
   | (None, None) -> None
   | (None, Some _) -> Some ValueChange.Added
   | (Some _, None) -> Some ValueChange.Removed
   | (Some value1, Some value2) ->
-    if equal value1 value2 then
-      None
-    else
-      Some (ValueChange.Modified ())
+    (match diff value1 value2 with
+    | None -> None
+    | Some diff -> Some (ValueChange.Modified diff))
+
+let diff_modules = diff_options ~diff:(diff_of_equal Ast_defs.equal_id)
+
+let diff
+    (type value)
+    ~(equal : value -> value -> bool)
+    (old_value : value)
+    (new_value : value) : value ValueDiff.t option =
+  if equal old_value new_value then
+    None
+  else
+    Some { ValueDiff.old_value; new_value }
+
+let diff_types = diff ~equal:Typing_defs.ty_equal
+
+let diff_enum_types
+    (enum_type1 : Typing_defs.enum_type) (enum_type2 : Typing_defs.enum_type) :
+    enum_type_change option =
+  if Typing_defs.equal_enum_type enum_type1 enum_type2 then
+    None
+  else
+    Option.some
+    @@
+    let {
+      Typing_defs.te_base = base1;
+      te_constraint = constraint1;
+      te_includes = includes1;
+    } =
+      enum_type1
+    in
+    let {
+      Typing_defs.te_base = base2;
+      te_constraint = constraint2;
+      te_includes = includes2;
+    } =
+      enum_type2
+    in
 
-let diff_modules = diff_options ~equal:Ast_defs.equal_id
+    {
+      base_change = diff_types base1 base2;
+      constraint_change = diff_options ~diff:diff_types constraint1 constraint2;
+      includes_change = diff_type_lists includes1 includes2;
+    }
 
-let diff_enum_types = diff_options ~equal:Typing_defs.equal_enum_type
+let diff_enum_type_options = diff_options ~diff:diff_enum_types
 
 let user_attribute_name_value
     { Typing_defs.ua_name = (_, name); ua_classname_params } =
@@ -556,6 +595,7 @@ type string_list = string list [@@deriving eq]
 let diff_class_shells (c1 : shallow_class) (c2 : shallow_class) :
     class_shell_change =
   {
+    classish_kind = c1.sc_kind;
     parent_changes =
       diff_parents (Parents.of_shallow_class c1) (Parents.of_shallow_class c2);
     type_parameters_change =
@@ -584,7 +624,7 @@ let diff_class_shells (c1 : shallow_class) (c2 : shallow_class) :
         ~equal:Typing_defs.equal_user_attribute
         ~get_name_value:user_attribute_name_value
         ~diff:(diff_of_equal equal_string_list);
-    enum_type_change = diff_enum_types c1.sc_enum_type c2.sc_enum_type;
+    enum_type_change = diff_enum_type_options c1.sc_enum_type c2.sc_enum_type;
   }
 
 let diff_class (c1 : shallow_class) (c2 : shallow_class) : ClassDiff.t =

hphp/hack/src/utils/hh_json/hh_json.ml

@@ -592,6 +592,9 @@ let opt_ (to_json : 'a -> json) (x : 'a option) : json =
 
 let array_ (f : 'a -> json) (xs : 'a list) : json = JSON_Array (List.map ~f xs)
 
+let string_map (to_json : 'a -> json) (map : 'a SMap.t) : json =
+  JSON_Object (SMap.bindings map |> List.map ~f:(fun (k, v) -> (k, to_json v)))
+
 let get_object_exn = function
   | JSON_Object o -> o
   | _ -> assert false