Merge branch 'reporting'

lib/domain.ml

@@ -97,6 +97,26 @@ let combine_allocations a1 a2 =
 let get_first_day a1 = DateMap.min_binding a1 |> fst
 let get_last_day a1 = DateMap.max_binding a1 |> fst
 
+(** --- Entities ----------------------------- *)
+
+type person =
+  { email : string (** Email is the primary key for persons *)
+  ; full_name : string
+  ; github_handle : string option
+  ; slack_handle : string option
+  }
+
+type placeholder = { name : string }
+
+type entity =
+  | Person of person
+  | Placeholder of placeholder
+
+let get_entity_name = function
+  | Person p -> p.full_name
+  | Placeholder p -> Printf.sprintf "Placeholder: %s" p.name
+;;
+
 (** --- Project metadata --------------------- *)
 
 type project_plan =
@@ -169,28 +189,9 @@ type project =
   ; state : State.t
   ; programme : string option
   ; plan : project_plan option
+  ; assignees : person list
   }
 
-(** --- Entities ----------------------------- *)
-
-type person =
-  { email : string (** Email is the primary key for persons *)
-  ; full_name : string
-  ; github_handle : string option
-  ; slack_handle : string option
-  }
-
-type placeholder = { name : string }
-
-type entity =
-  | Person of person
-  | Placeholder of placeholder
-
-let get_entity_name = function
-  | Person p -> p.full_name
-  | Placeholder p -> Printf.sprintf "Placeholder: %s" p.name
-;;
-
 (** --- Emoji reactions ---------------------- *)
 
 type emoji =

lib/domain.mli

@@ -111,6 +111,25 @@ val get_last_day : 'a DateMap.t -> CalendarLib.Date.t
 
 (** {1 Entities relevant to scheduling and planning} *)
 
+(** A person *)
+type person =
+  { email : string (** Email is the primary key for persons *)
+  ; full_name : string
+  ; github_handle : string option
+  ; slack_handle : string option
+  }
+
+(** A placeholder on Forecast. *)
+type placeholder = { name : string }
+
+(** An entity is a person or a placeholder. *)
+type entity =
+  | Person of person
+  | Placeholder of placeholder
+
+(** Get the name of an entity. *)
+val get_entity_name : entity -> string
+
 (** A [plan] gives the constraints on the possible allocations to a project. *)
 type project_plan =
   { budget : FTE.t
@@ -154,30 +173,12 @@ type project =
   ; state : State.t
   ; programme : string option
   ; plan : project_plan option
+  ; assignees : person list
   }
 
 (** Convert the column name in GitHub to a variant type. May raise UnknownColumn *)
 val state_of_column : string -> State.t
 
-(** A person *)
-type person =
-  { email : string (** Email is the primary key for persons *)
-  ; full_name : string
-  ; github_handle : string option
-  ; slack_handle : string option
-  }
-
-(** A placeholder on Forecast. *)
-type placeholder = { name : string }
-
-(** An entity is a person or a placeholder. *)
-type entity =
-  | Person of person
-  | Placeholder of placeholder
-
-(** Get the name of an entity. *)
-val get_entity_name : entity -> string
-
 (** The types of emoji reactions we care about. *)
 type emoji =
   | Laugh

lib/github.ml

@@ -88,6 +88,15 @@ type person = GithubRaw.person =
   }
 [@@deriving show, ord]
 
+type issue =
+  { number : int (** The issue number from GitHub *)
+  ; name : string
+  ; state : Domain.State.t
+  ; programme : string option
+  ; plan : Domain.project_plan option
+  ; assignees : string list
+  }
+
 (* We recognise only floats, strings, and lists of strings as valid types in the metadata.
    We parse the YAML into this variant type first, and then pick the correct types for
    each field later. *)
@@ -325,7 +334,7 @@ let find_programme (issue : Raw.issue) =
   List.find_map parse_label issue.labels
 ;;
 
-let make_issue (col_name : string) (issue : Raw.issue) =
+let make_issue (col_name : string) (issue : Raw.issue) : issue =
   let plan =
     match parse_metadata issue with
     | None -> None
@@ -340,6 +349,7 @@ let make_issue (col_name : string) (issue : Raw.issue) =
   ; state = state_of_column col_name
   ; programme = find_programme issue
   ; plan
+  ; assignees = issue.assignees
   }
 ;;
 

lib/github.mli

@@ -50,13 +50,23 @@ type github_event =
 
 (* We reexport the Raw.person type so that no other module ever has a need to import
    anything from GithubRaw. *)
-
 type person = GithubRaw.person =
   { login : string
   ; name : string option
   ; email : string option
   }
 
+(* Intermediate type for a project. We cannot parse assignee usernames until we
+   have gotten to Schedule, because to do so requires data from Forecast.. *)
+type issue =
+  { number : int (** The issue number from GitHub *)
+  ; name : string
+  ; state : Domain.State.t
+  ; programme : string option
+  ; plan : Domain.project_plan option
+  ; assignees : string list
+  }
+
 (** A type for Github users. *)
 val show_person : person -> string
 
@@ -66,7 +76,7 @@ val compare_person : person -> person -> int
 
 (** Given a project board name, return a list of projects, one for each issue on the
     board. *)
-val get_project_issues : unit -> Domain.project list
+val get_project_issues : unit -> issue list
 
 (** This is re-exported from [GithubRaw] for convenience. See
     {!GithubRaw.get_all_users_async}. *)

lib/githubRaw.ml

@@ -143,8 +143,8 @@ type issue =
   ; title : string
   ; body : string
   ; state : issue_state
-  ; assignees : person list
   ; labels : string list
+  ; assignees : string list
   }
 
 let get_issue_async id =
@@ -167,14 +167,12 @@ let get_issue_async id =
     |> to_list
     |> List.map (fun a -> a |> member "login" |> to_string)
   in
-  let* assignee_opts = assignee_usernames |> List.map find_person_by_login |> Lwt.all in
-  let assignees = assignee_opts |> List.filter_map Fun.id in
   Lwt.return
     { number = id
     ; title = issue_json |> member "title" |> to_string
     ; body = issue_json |> member "body" |> to_string
     ; state = issue_json |> member "state" |> to_string |> state_of_string
-    ; assignees
+    ; assignees = assignee_usernames
     ; labels =
         issue_json
         |> member "labels"

lib/githubRaw.mli

@@ -83,8 +83,8 @@ type issue =
   ; title : string
   ; body : string
   ; state : issue_state
-  ; assignees : person list
   ; labels : string list
+  ; assignees : string list
   }
 
 (** A GitHub issue, but with reactions. We have a separate type for this because

lib/log.ml

@@ -72,7 +72,7 @@ let isDebug e =
 
 (* Printing --------------------------------------------------- *)
 
-(* TODO implement this function properly *)
+(* Attempt to get an issue number from an event. *)
 let extract_issue_number event =
   match event.entity with
   | RawForecastProject (Right n) -> Some n
@@ -81,7 +81,8 @@ let extract_issue_number event =
   | _ -> None
 ;;
 
-(* TODO implement this function properly *)
+(* Show the source of an event, which is often an issue, but some other string
+when we can't get an issue. *)
 let extract_source event =
   match event.entity with
   | RawForecastProject (Right n) -> Printf.sprintf "Issue %-5d" n
@@ -104,12 +105,13 @@ type code_spec =
   | Only of level list
   | All
 
+(* Determine if an event should be shown, given the various options. *)
 let should_be_shown ~verbose ~restrict_codes ~restrict_issues (issue_number, event) =
   (* Check if the issue number is in restrict_issues *)
   let pred1 =
     match restrict_issues, issue_number with
     | None, _ -> true
-    | Some _, None -> true
+    | Some _, None -> false
     | Some numbers, Some n -> List.mem n numbers
   in
   (* Check that the error code is consistent with restrict_codes *)
@@ -148,6 +150,7 @@ let pretty_print_event ~use_color (_, e) =
   Printf.printf "%s\n" e.message
 ;;
 
+(* Gather all events together in a list. *)
 let gather_events ~verbose ~restrict_codes ~restrict_issues : (int option * event) list =
   let compare_events (n1, e1) (n2, e2) =
     (* Compare on issue number first, then error code *)
@@ -173,6 +176,8 @@ let gather_events ~verbose ~restrict_codes ~restrict_issues : (int option * even
   |> List.stable_sort compare_events
 ;;
 
+(* Gather events, but with a different type signature from the above. Events are
+   grouped by the issue that they relate to. *)
 let gather_events' ~verbose ~restrict_codes ~restrict_issues
   : (int option * event list) list
   =

lib/person.ml

@@ -50,6 +50,15 @@ let print_info ~(use_color : bool) (psn : person) =
   prout ~use_color [ ANSI.Bold ] (make_box s)
 ;;
 
+let print_github_assignments ~(use_color : bool) (prjs : project list) =
+  print_heading ~use_color "GitHub issue assignments";
+  match prjs with
+  | [] -> print_endline "None found."
+  | _ ->
+    let print_prj prj = Printf.printf "#%-4d %s\n" prj.number prj.name in
+    List.iter print_prj prjs
+;;
+
 let print_assignments ~(use_color : bool) (asns : assignment list) =
   let make_name asn = Printf.sprintf "#%-4d %s" asn.project.number asn.project.name in
   print_heading ~use_color "Recent Forecast assignments";
@@ -152,9 +161,17 @@ let print
             >= CL.Date.add (CL.Date.today ()) (CL.Date.Period.month (-2)))
     |> List.sort Assignment.compare_by_date
   in
+  let this_github_prjs =
+    prjs
+    |> IntMap.filter (fun _ v -> List.mem psn v.assignees)
+    |> IntMap.bindings
+    |> List.map snd
+  in
   print_info ~use_color psn;
   print_endline "";
   print_endline "";
+  print_github_assignments ~use_color this_github_prjs;
+  print_endline "";
   print_assignments ~use_color this_asns;
   print_endline "";
   print_capacity ~use_color this_asns;

lib/project.ml

@@ -28,30 +28,33 @@ let print_metadata ~(use_color : bool) (prj : project) =
   (match prj.programme with
    | None -> prout ~use_color [ ANSI.red ] "Programme           : Not found\n"
    | Some s -> printf "Programme           : %s\n" s);
-  match prj.plan with
-  | None -> print_endline "Remaining metadata could not be parsed from GitHub."
-  | Some plan ->
-    let earliest_start_date_string =
-      match plan.earliest_start_date with
-      | None -> "None"
-      | Some d -> CalendarLib.Printer.Date.to_string d
-    in
-    let latest_end_date_string =
-      match plan.latest_end_date with
-      | None -> "None"
-      | Some d -> CalendarLib.Printer.Date.to_string d
-    in
-    (match plan.finance_codes with
-     | [] -> prout ~use_color [ ANSI.red ] "Finance codes       : Not found\n"
-     | xs -> printf "Finance codes       : %s\n" (String.concat ", " xs));
-    printf "Earliest start date : %s\n" earliest_start_date_string;
-    printf
-      "Latest start date   : %s\n"
-      (CalendarLib.Printer.Date.to_string plan.latest_start_date);
-    printf "Latest end date     : %s\n" latest_end_date_string;
-    printf "Minimum FTE         : %.0f%%\n" plan.min_fte_percent;
-    printf "Nominal FTE         : %.0f%%\n" plan.nominal_fte_percent;
-    printf "Maximum FTE         : %.0f%%\n" plan.max_fte_percent
+  (match prj.plan with
+   | None -> print_endline "Remaining metadata could not be parsed from GitHub."
+   | Some plan ->
+     let earliest_start_date_string =
+       match plan.earliest_start_date with
+       | None -> "None"
+       | Some d -> CalendarLib.Printer.Date.to_string d
+     in
+     let latest_end_date_string =
+       match plan.latest_end_date with
+       | None -> "None"
+       | Some d -> CalendarLib.Printer.Date.to_string d
+     in
+     (match plan.finance_codes with
+      | [] -> prout ~use_color [ ANSI.red ] "Finance codes       : Not found\n"
+      | xs -> printf "Finance codes       : %s\n" (String.concat ", " xs));
+     printf "Earliest start date : %s\n" earliest_start_date_string;
+     printf
+       "Latest start date   : %s\n"
+       (CalendarLib.Printer.Date.to_string plan.latest_start_date);
+     printf "Latest end date     : %s\n" latest_end_date_string;
+     printf "Minimum FTE         : %.0f%%\n" plan.min_fte_percent;
+     printf "Nominal FTE         : %.0f%%\n" plan.nominal_fte_percent;
+     printf "Maximum FTE         : %.0f%%\n" plan.max_fte_percent);
+  printf
+    "GitHub assignees    : %s\n"
+    (List.map (fun p -> p.full_name) prj.assignees |> String.concat ", ")
 ;;
 
 (** [asns] must be subsetted to only those belonging to this project *)