[litho] organize functions for GraphQL getters and required props into separate modules

Summary: It was getting a bit difficult to tell which functions belonged where.

Reviewed By: jvillard

Differential Revision: D6764764

fbshipit-source-id: f9faada

infer/src/checkers/Litho.ml

@@ -60,13 +60,9 @@ module LithoFramework = struct
         false
 end
 
-module TransferFunctions (CFG : ProcCfg.S) = struct
+module GraphQLGetters = struct
-  module CFG = CFG
+  (* return true if this is a graphql getter *)
-  module Domain = Domain
+  let is_function procname summary =
-
-  type extras = ProcData.no_extras
-
-  let is_graphql_getter procname summary =
     Option.is_none summary
     (* we skip analysis of all GraphQL procs *)
     &&
@@ -84,6 +80,112 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
         false
 
 
+  let should_report proc_desc =
+    LithoFramework.is_on_create_layout (Procdesc.get_proc_name proc_desc)
+
+
+  let report astate summary =
+    let report_graphql_getter access_path call_chain =
+      let call_strings =
+        List.map ~f:(Typ.Procname.to_simplified_string ~withclass:false) call_chain
+      in
+      let call_string = String.concat ~sep:"." call_strings in
+      let message = F.asprintf "%a.%s" AccessPath.pp access_path call_string in
+      let exn =
+        Exceptions.Checkers (IssueType.graphql_field_access, Localise.verbatim_desc message)
+      in
+      let loc = Specs.get_loc summary in
+      let ltr = [Errlog.make_trace_element 0 loc message []] in
+      Reporting.log_error summary ~loc ~ltr exn
+    in
+    Domain.iter_call_chains ~f:report_graphql_getter astate
+end
+
+module RequiredProps = struct
+  let get_required_props typename tenv =
+    let is_required annot_list =
+      List.exists
+        ~f:(fun ({Annot.class_name; parameters}, _) ->
+          String.is_suffix class_name ~suffix:Annotations.prop
+          && (* Don't count as required if it's @Prop(optional = true) *)
+             not (List.exists ~f:(fun annot_string -> String.equal annot_string "true") parameters)
+          )
+        annot_list
+    in
+    match Tenv.lookup tenv typename with
+    | Some {fields} ->
+        List.filter_map
+          ~f:(fun (fieldname, _, annot) ->
+            if is_required annot then Some (Typ.Fieldname.Java.get_field fieldname) else None )
+          fields
+    | None ->
+        []
+
+
+  let report_missing_required_prop summary prop_string loc =
+    let message =
+      F.asprintf "@Prop %s is required, but not set before the call to build()" prop_string
+    in
+    let exn =
+      Exceptions.Checkers (IssueType.missing_required_prop, Localise.verbatim_desc message)
+    in
+    let ltr = [Errlog.make_trace_element 0 loc message []] in
+    Reporting.log_error summary ~loc ~ltr exn
+
+
+  (* walk backward through [call_chain] and return the first type T <: Component that is not part of
+     the Litho framework (i.e., is client code) *)
+  let find_client_component_type call_chain =
+    List.find_map
+      ~f:(fun pname ->
+        match pname with
+        | Typ.Procname.Java java_pname ->
+            Typ.Name.Java.get_outer_class (Typ.Procname.Java.get_class_type_name java_pname)
+        | _ ->
+            None )
+      call_chain
+
+
+  let should_report proc_desc tenv =
+    let pname = Procdesc.get_proc_name proc_desc in
+    not (LithoFramework.is_function pname)
+    && not (LithoFramework.is_component_build_method pname tenv)
+    && Procdesc.get_access proc_desc <> PredSymb.Private
+
+
+  let report astate tenv summary =
+    let check_required_prop_chain _ call_chain =
+      let rev_chain = List.rev call_chain in
+      match rev_chain with
+      | pname :: _ when LithoFramework.is_component_build_method pname tenv -> (
+        match
+          (* Here, we'll have a type name like MyComponent$Builder in hand. Truncate the $Builder
+               part from the typename, then look at the fields of MyComponent to figure out which
+               ones are annotated with @Prop *)
+          find_client_component_type call_chain
+        with
+        | Some parent_typename ->
+            let required_props = get_required_props parent_typename tenv in
+            let prop_set = List.map ~f:Typ.Procname.get_method call_chain |> String.Set.of_list in
+            List.iter
+              ~f:(fun required_prop ->
+                if not (String.Set.mem prop_set required_prop) then
+                  report_missing_required_prop summary required_prop (Specs.get_loc summary) )
+              required_props
+        | _ ->
+            () )
+      | _ ->
+          ()
+    in
+    Domain.iter_call_chains ~f:check_required_prop_chain astate
+end
+
+module TransferFunctions (CFG : ProcCfg.S) = struct
+  module CFG = CFG
+  module Domain = Domain
+
+  type extras = ProcData.no_extras
+
   let apply_callee_summary summary_opt caller_pname ret_opt actuals astate =
     match summary_opt with
     | Some summary ->
@@ -123,7 +225,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
         let receiver = Domain.LocalAccessPath.make receiver_ap caller_pname in
         if ( LithoFramework.is_component_builder callee_procname proc_data.tenv
            (* track Builder's in order to check required prop's *)
-           || is_graphql_getter callee_procname summary
+           || GraphQLGetters.is_function callee_procname summary
            || (* track GraphQL getters in order to report graphql field accesses *)
               Domain.mem receiver astate
               (* track anything called on a receiver we're already tracking *) )
@@ -162,106 +264,16 @@ end
 
 module Analyzer = LowerHil.MakeAbstractInterpreter (ProcCfg.Exceptional) (TransferFunctions)
 
-let should_report proc_desc = LithoFramework.is_on_create_layout (Procdesc.get_proc_name proc_desc)
-
-let report_graphql_getters summary access_path call_chain =
-  let call_strings = List.map ~f:(Typ.Procname.to_simplified_string ~withclass:false) call_chain in
-  let call_string = String.concat ~sep:"." call_strings in
-  let message = F.asprintf "%a.%s" AccessPath.pp access_path call_string in
-  let exn = Exceptions.Checkers (IssueType.graphql_field_access, Localise.verbatim_desc message) in
-  let loc = Specs.get_loc summary in
-  let ltr = [Errlog.make_trace_element 0 loc message []] in
-  Reporting.log_error summary ~loc ~ltr exn
-
-
-let postprocess astate formal_map : Domain.astate =
-  let f_sub access_path = Domain.LocalAccessPath.to_formal_option access_path formal_map in
-  Domain.substitute ~f_sub astate
-
-
-let get_required_props typename tenv =
-  let is_required annot_list =
-    List.exists
-      ~f:(fun ({Annot.class_name; parameters}, _) ->
-        String.is_suffix class_name ~suffix:Annotations.prop
-        && (* Don't count as required if it's @Prop(optional = true) *)
-           not (List.exists ~f:(fun annot_string -> String.equal annot_string "true") parameters)
-        )
-      annot_list
-  in
-  match Tenv.lookup tenv typename with
-  | Some {fields} ->
-      List.filter_map
-        ~f:(fun (fieldname, _, annot) ->
-          if is_required annot then Some (Typ.Fieldname.Java.get_field fieldname) else None )
-        fields
-  | None ->
-      []
-
-
-let report_missing_required_prop summary prop_string loc =
-  let message =
-    F.asprintf "@Prop %s is required, but not set before the call to build()" prop_string
-  in
-  let exn =
-    Exceptions.Checkers (IssueType.missing_required_prop, Localise.verbatim_desc message)
-  in
-  let ltr = [Errlog.make_trace_element 0 loc message []] in
-  Reporting.log_error summary ~loc ~ltr exn
-
-
-(* walk backward through [call_chain] and return the first type T <: Component that is not part of
-   the Litho framework (i.e., is client code) *)
-let find_client_component_type call_chain =
-  List.find_map
-    ~f:(fun pname ->
-      match pname with
-      | Typ.Procname.Java java_pname ->
-          Typ.Name.Java.get_outer_class (Typ.Procname.Java.get_class_type_name java_pname)
-      | _ ->
-          None )
-    call_chain
-
-
-let check_required_props astate tenv summary =
-  let check_required_prop_chain _ call_chain =
-    let rev_chain = List.rev call_chain in
-    match rev_chain with
-    | pname :: _ when LithoFramework.is_component_build_method pname tenv -> (
-      match
-        (* Here, we'll have a type name like MyComponent$Builder in hand. Truncate the $Builder part
-           from the typename, then look at the fields of MyComponent to figure out which ones are
-           annotated with @Prop *)
-        find_client_component_type call_chain
-      with
-      | Some parent_typename ->
-          let required_props = get_required_props parent_typename tenv in
-          let prop_set = List.map ~f:Typ.Procname.get_method call_chain |> String.Set.of_list in
-          List.iter
-            ~f:(fun required_prop ->
-              if not (String.Set.mem prop_set required_prop) then
-                report_missing_required_prop summary required_prop (Specs.get_loc summary) )
-            required_props
-      | _ ->
-          () )
-    | _ ->
-        ()
-  in
-  Domain.iter_call_chains ~f:check_required_prop_chain astate
-
-
 let checker {Callbacks.summary; proc_desc; tenv} =
   let proc_data = ProcData.make_default proc_desc tenv in
   match Analyzer.compute_post proc_data ~initial:Domain.empty with
   | Some post ->
-      let pname = Procdesc.get_proc_name proc_desc in
+      if RequiredProps.should_report proc_desc tenv then RequiredProps.report post tenv summary ;
-      if not (LithoFramework.is_function pname)
+      if GraphQLGetters.should_report proc_desc then GraphQLGetters.report post summary ;
-         && not (LithoFramework.is_component_build_method pname tenv)
+      let postprocess astate formal_map : Domain.astate =
-         && Procdesc.get_access proc_desc <> PredSymb.Private
+        let f_sub access_path = Domain.LocalAccessPath.to_formal_option access_path formal_map in
-      then check_required_props post tenv summary ;
+        Domain.substitute ~f_sub astate
-      ( if should_report proc_desc then
+      in
-          let f = report_graphql_getters summary in
-          Domain.iter_call_chains ~f post ) ;
       let payload = postprocess post (FormalMap.make proc_desc) in
       Summary.update_summary payload summary
   | None ->

infer/src/checkers/LithoDomain.ml

@@ -63,6 +63,10 @@ let substitute ~(f_sub: LocalAccessPath.t -> LocalAccessPath.t option) astate =
       add access_path' call_set' acc )
     astate empty
 
+
+(** Unroll the domain to enumerate all the call chains ending in [call] and apply [f] to each
+    maximal chain. For example, if the domain encodes the chains foo().bar().goo() and foo().baz(),
+    [f] will be called once on foo().bar().goo() and once on foo().baz() *)
 let iter_call_chains_with_suffix ~f call_suffix astate =
   let max_depth = cardinal astate in
   let rec unroll_call_ ({receiver; procname}: MethodCall.t) (acc, depth) =
@@ -83,6 +87,7 @@ let iter_call_chains_with_suffix ~f call_suffix astate =
   in
   unroll_call_ call_suffix ([], 0)
 
+
 let iter_call_chains ~f astate =
   iter
     (fun _ call_set ->

infer/src/checkers/LithoDomain.mli

@@ -38,11 +38,5 @@ val substitute : f_sub:(LocalAccessPath.t -> LocalAccessPath.t option) -> astate
 (** Substitute each access path in the domain using [f_sub]. If [f_sub] returns None, the
     original access path is retained; otherwise, the new one is used *)
 
-val iter_call_chains_with_suffix :
-  f:(AccessPath.t -> Typ.Procname.t list -> unit) -> MethodCall.t -> astate -> unit
-(** Unroll the domain to enumerate all the call chains ending in [call] and apply [f] to each
-    maximal chain. For example, if the domain encodes the chains foo().bar().goo() and foo().baz(),
-    [f] will be called once on foo().bar().goo() and once on foo().baz() *)
-
 val iter_call_chains : f:(AccessPath.t -> Typ.Procname.t list -> unit) -> astate -> unit
 (** Apply [f] to each maximal call chain encoded in [astate] *)