Source file t.ml

(*********************************************************************************)
(*                Statocaml                                                      *)
(*                                                                               *)
(*    Copyright (C) 2025 INRIA All rights reserved.                              *)
(*    Author: Maxence Guesdon (INRIA Saclay)                                     *)
(*      with Gabriel Scherer (INRIA Paris) and Florian Angeletti (INRIA Paris)   *)
(*                                                                               *)
(*    This program is free software; you can redistribute it and/or modify       *)
(*    it under the terms of the GNU General Public License as                    *)
(*    published by the Free Software Foundation, version 3 of the License.       *)
(*                                                                               *)
(*    This program is distributed in the hope that it will be useful,            *)
(*    but WITHOUT ANY WARRANTY; without even the implied warranty of             *)
(*    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the               *)
(*    GNU General Public License for more details.                               *)
(*                                                                               *)
(*    You should have received a copy of the GNU General Public                  *)
(*    License along with this program; if not, write to the Free Software        *)
(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
(*    02111-1307  USA                                                            *)
(*                                                                               *)
(*    As a special exception, you have permission to link this program           *)
(*    with the OCaml compiler and distribute executables, as long as you         *)
(*    follow the requirements of the GNU GPL in regard to all of the             *)
(*    software in the executable aside from the OCaml compiler.                  *)
(*                                                                               *)
(*    Contact: Maxence.Guesdon@inria.fr                                          *)
(*                                                                               *)
(*********************************************************************************)

(** Types *)

module S = Statocaml
module GH = Statocaml_github
module CH = Changelog
module Log = S.Log

module Period = S.Period

type user_id = int

type thresholds = {
      th_reviewer : int ;
      th_reviewed : int ;
      th_commits : int ;
      th_issues : int ;
    }

let thresholds ?(reviewer=3) ?(reviewed=2) ?(commits=3) ?(issues=1) () =
  { th_reviewer = reviewer ; th_reviewed = reviewed ;
    th_commits = commits ; th_issues = issues ;
  }

let string_of_thresholds_ comp logic t =
  Printf.sprintf "reviewer_of %s %d %s reviewed_by %s %d %s commits %s %d %s issues %s %d"
    comp t.th_reviewer logic comp t.th_reviewed logic comp t.th_commits logic comp t.th_issues

let string_of_thresholds = string_of_thresholds_ ">=" "&&"
let string_of_thresholds_inv = string_of_thresholds_ "<" "||"

let thresholds_of_string str =
  try Scanf.sscanf str "%d,%d,%d,%d"
    (fun reviewer reviewed commits issues ->
       thresholds ~reviewer ~reviewed ~commits ~issues ())
  with Scanf.Scan_failure msg ->
      failwith (Printf.sprintf "Invalid thresholds %S: %s" str msg)

let raw_string_of_thresholds t =
  Printf.sprintf "%d,%d,%d,%d" t.th_reviewer t.th_reviewed t.th_commits t.th_issues

let geometric_average =
  let f (x, coeff) acc = log (coeff *. x +. 1.) +. acc in
  fun values -> exp (List.fold_right f values 0. -. log 1.)

type group_membership_period =
  { start: Ptime.t option [@ocf Ocf.Wrapper.option GH.Types.ptime_wrapper, None] ;
    stop: Ptime.t option [@ocf Ocf.Wrapper.option GH.Types.ptime_wrapper, None] ;
  } [@@ocf]
type group_membership_periods = group_membership_period list

let string_of_group_membership_period p =
  match p.start, p.stop with
  | None, None -> "always"
  | Some d, None ->
      let (y,m,d) = Ptime.to_date d in
      Printf.sprintf "since %04d/%02d/%02d" y m d
  | None, Some d ->
      let (y,m,d) = Ptime.to_date d in
      Printf.sprintf "until %04d/%02d/%02d" y m d
  | Some d1, Some d2 ->
      let (y1,m1,d1) = Ptime.to_date d1 in
      let (y2,m2,d2) = Ptime.to_date d2 in
      Printf.sprintf "from %04d/%02d/%02d to %04d/%02d/%02d " y1 m1 d1 y2 m2 d2

let group_members_wrapper =
  Ocf.Wrapper.string_map
    ~fold:S.Smap.fold ~add:S.Smap.add
    ~empty:S.Smap.empty (Ocf.Wrapper.list group_membership_period_wrapper)

type 'a group = {
  members : group_membership_periods S.Smap.t
      [@ocf group_members_wrapper, S.Smap.empty] ;
  gh_account : 'a option
      [@ocf Ocf.Wrapper.option, None] ;
} [@@ocf]

type options = {
    mutable dot_reviewers_directed : bool ;
    mutable dot_reviewers_thresholds : thresholds ;
    mutable top_cumul_threshold : float ; (* between 0. and 1.0 *)
    mutable top_max_kept : int ;
    mutable groups : GH.Types.full_user group S.Smap.t ;
  }

let default_options () =
  {
    dot_reviewers_directed = true ;
    dot_reviewers_thresholds = thresholds ();
    top_cumul_threshold = 0.8 ;
    top_max_kept = 20 ;
    groups = S.Smap.empty ;
  }

module type S = sig
    module Subs: Subsys.S
    type dated = {
        mutable commits : S.Sset.t ; (* set of commit SHAs *)
        mutable lines_added : int ;
        mutable lines_deleted : int ;

        mutable issues : S.Iset.t ; (* id of issues the user taked action in, not including pull requests *)
        mutable issues_created : S.Iset.t ;
        mutable issue_comments : S.Iset.t ;
        mutable issues_reviewed : S.Iset.t ; (* from changelog if one is provided *)

        mutable prs : S.Iset.t ;
        mutable prs_created : S.Iset.t ;
        mutable prs_created_merged : S.Iset.t ;
        mutable pr_author_commits : S.Sset.t ;

        mutable lines_added_in_prs_as_author : int list;
        mutable lines_deleted_in_prs_as_author : int list;
        mutable avg_lines_added_by_pr_as_author : float option ;
        mutable avg_lines_deleted_by_pr_as_author : float option ;
        mutable pr_comments : S.Iset.t ;
        mutable pr_review_comments : S.Iset.t ;
        mutable pr_review_commits : S.Sset.t ;
        mutable lines_added_in_prs_as_reviewer : int list;
        mutable lines_deleted_in_prs_as_reviewer : int list;
        mutable avg_lines_added_by_pr_as_reviewer : float option ;
        mutable avg_lines_deleted_by_pr_as_reviewer : float option ;
        mutable prs_reviewed : S.Iset.t ;
        mutable prs_reviewed_from_changelog : S.Iset.t ;

        mutable subsys_issues : float Subs.Map.t ;
        (* contributions in subsystems, 1 issue/pr = +1 for impacted subsystems *)
        mutable subsys_commits : float Subs.Map.t ;
        (* same but with 1 commit = +1 for impacted subsystems *)
        mutable subsys_committed_files : float Subs.Map.t ;
        (* same but with 1 committed file = +1 for impacted subsystem *)
        mutable subsys_committed_lines : float Subs.Map.t ;
        (* same but with 1 committed line (added/deleted) = +1 for impacted subsystem *)

        mutable reviewer_of_shared : float S.Imap.t;
        mutable reviewed_by_shared : float S.Imap.t ;
        mutable reviewer_of : float S.Imap.t;
        mutable reviewed_by : float S.Imap.t ;

        mutable as_author : S.Iset.t (* issues/PRs from changelog *) ;
        mutable as_analyst : S.Iset.t (* issues/PRs from changelog *) ;
        mutable as_reviewer : S.Iset.t (* issues/PRs from changelog *) ;
        mutable as_reporter : S.Iset.t (* issues/PRs from changelog *) ;
        mutable as_suggester : S.Iset.t (* issues/PRs from changelog *) ;
        mutable as_other : S.Iset.t (* issues/PRs from changelog *) ;

        mutable activity_score : float;
      }
    val new_dated : unit -> dated
    val merge_dated : src:dated -> dst:dated -> unit

    val pp_dated : Format.formatter -> dated -> unit

    type profile_kind = Person | Group of (profile * group_membership_periods) S.Imap.t

    and profile = {
        id : user_id ;
        kind : profile_kind ;
        gh_user : GH.Types.full_user option ;
        name : string ;
        mutable dateds : dated Period.Map.t ;
      }

    and profiles = profile S.Imap.t
    val get_dated : profile -> Period.t -> dated
    val opt_dated : profile -> Period.t -> dated option
    val dateds_by_year : profile -> dated S.Imap.t

    type finger

    val finger_find : ?email:string -> ?login:string ->
      ?name:string -> ?commit:GH.Types.commit -> ?id:user_id -> finger -> profile option

    type predefined_profile =
      { names : string list [@ocf Ocf.Wrapper.(list string), []] ;
        gh_login : string [@ocf Ocf.Wrapper.string, ""];
        emails : string list [@ocf Ocf.Wrapper.(list string), []];
      }[@@ocf]
    val predefined_profiles_from_file : string -> predefined_profile list Lwt.t
    val groups_from_file : string -> string group S.Smap.t Lwt.t

    type pr = {
        issue : GH.Types.issue ;
        merge_date : Ptime.t option ;
        pr : GH.Types.pull_request ;
        authors : S.Iset.t (* profile ids *) ;
        reviewers : S.Iset.t (* profile ids *) ;
        author_commits : S.Sset.t ; (* SHAs *)
        review_commits : S.Sset.t ; (* SHAs *)
        comments : GH.Types.comment S.Imap.t ;
        review_comments : GH.Types.review_comment S.Imap.t ;
        merger : user_id option ;
      }

    type gstats = {
        mutable g_issues :  GH.Types.issue S.Imap.t ;
        mutable g_prs : pr S.Imap.t ;
        mutable g_commits : GH.Types.commit S.Smap.t ;
        mutable g_committers : (user_id * int) list ;
        mutable g_pr_commits : GH.Types.commit S.Smap.t ;
        mutable g_pr_committers : (user_id * int) list ;

        mutable g_issue_comments : int ;
        mutable g_issue_commenters : (user_id * int) list ;
        mutable g_issue_participants : (user_id * int) list ;
        mutable g_issue_creators : (user_id * int) list ;
        mutable g_issue_reviewers : (user_id * int) list ;

        mutable g_pr_comments : int ;
        mutable g_pr_commenters : (user_id * int) list ;
        mutable g_pr_participants : (user_id * int) list ;
        mutable g_pr_creators : (user_id * int) list ;
        mutable g_pr_reviewers : (user_id * int) list ;
        mutable g_pr_reviewers_from_changelog : (user_id * int) list ;
        mutable g_prs_of_subsys : S.Iset.t Subs.Map.t ;

        mutable g_subsys_commits : float Subs.Map.t ;

        mutable g_active_contributors : (user_id * float) list ;
      }

    val gstats : unit -> gstats

    type max = {
        mutable max_committer : int * user_id ;
        mutable max_issue_commenter : int * user_id ;
        mutable max_issue_reviewer : int * user_id ;
        mutable max_issue_creator : int * user_id ;
        mutable max_pr_commenter : int * user_id ;
        mutable max_pr_creator : int * user_id ;
        mutable max_pr_reviewer : int * user_id ;
        mutable max_pr_reviewer_from_changelog : int * user_id ;
        mutable max_subsys_commits : (int * user_id) Subs.Map.t ;
      }

    type t = {
        repo_name : string ;
        finger : finger ;
        mutable stats : gstats Period.Map.t;
        mutable max : max Period.Map.t ;
        orig_issues : GH.Types.issue S.Imap.t ;
        orig_commits : GH.Types.commit S.Smap.t ;
        get_gh_user : string -> GH.Types.full_user option ;
        orig_changelog : Changelog.t option ;
        orig_events : S.Types.event list ;
        has_changelog : bool ;
      }
    val create : repo_name:string ->
      ?finger:(finger * S.Iset.t) -> ?predef:predefined_profile list ->
      ?events:S.Types.event list -> ?changelog:Changelog.t ->
      (string -> GH.Types.full_user option) ->
      GH.Types.issue S.Imap.t -> GH.Types.commit S.Smap.t -> t Lwt.t

    val dup : t -> t

    val profiles : t -> profiles
    val profile : t -> user_id -> profile
    val profile_opt : t -> user_id -> profile option
    val with_profiles : t -> profiles -> t

    val group_profiles : thresholds -> t -> profile S.Imap.t Period.Map.t

    val make_groups : ?events:S.Types.event list ->
      t -> GH.Types.full_user group S.Smap.t -> t Lwt.t

    val dot_review : title:string -> ?profile_link:(profile->string) ->
      file:string -> ?output_type:string -> directed:bool ->
      profile S.Imap.t -> unit Lwt.t

    val issue_creation_year : GH.Types.issue -> int
  end

module Make (Subs:Subsys.S) : S = struct
    module Subs = Subs

    type dated = {
        mutable commits : S.Sset.t ; (* set of commit SHAs*)
        mutable lines_added : int ;
        mutable lines_deleted : int ;

        mutable issues : S.Iset.t ; (* id of issues the user taked action in, not including pull requests *)
        mutable issues_created : S.Iset.t ;
        mutable issue_comments : S.Iset.t ;
        mutable issues_reviewed : S.Iset.t ; (* from changelog if one is provided *)

        mutable prs : S.Iset.t ; (* pull requests *)
        mutable prs_created : S.Iset.t ;
        mutable prs_created_merged : S.Iset.t ;
        mutable pr_author_commits : S.Sset.t ;

        mutable lines_added_in_prs_as_author : int list;
        mutable lines_deleted_in_prs_as_author : int list ;
        mutable avg_lines_added_by_pr_as_author : float option ;
        mutable avg_lines_deleted_by_pr_as_author : float option ;
        mutable pr_comments : S.Iset.t ;
        mutable pr_review_comments : S.Iset.t ;
        mutable pr_review_commits : S.Sset.t ;
        mutable lines_added_in_prs_as_reviewer : int list;
        mutable lines_deleted_in_prs_as_reviewer : int list;
        mutable avg_lines_added_by_pr_as_reviewer : float option ;
        mutable avg_lines_deleted_by_pr_as_reviewer : float option ;
        mutable prs_reviewed : S.Iset.t ;
        mutable prs_reviewed_from_changelog : S.Iset.t ;

        mutable subsys_issues : float Subs.Map.t ;
        mutable subsys_commits : float Subs.Map.t ;
        mutable subsys_committed_files : float Subs.Map.t ;
        mutable subsys_committed_lines : float Subs.Map.t ;

        mutable reviewer_of_shared : float S.Imap.t;
        mutable reviewed_by_shared : float S.Imap.t ;
        mutable reviewer_of : float S.Imap.t;
        mutable reviewed_by : float S.Imap.t ;

        mutable as_author : S.Iset.t (* issues/PRs from changelog *) ;
        mutable as_analyst : S.Iset.t (* issues/PRs from changelog *) ;
        mutable as_reviewer : S.Iset.t (* issues/PRs from changelog *) ;
        mutable as_reporter : S.Iset.t (* issues/PRs from changelog *) ;
        mutable as_suggester : S.Iset.t (* issues/PRs from changelog *) ;
        mutable as_other : S.Iset.t (* issues/PRs from changelog *) ;

        mutable activity_score : float;
      }
    let dup_dated d = { d with commits = d.commits }

    let pp_icard ppf x = Format.fprintf ppf "%d" (S.Iset.cardinal x)
    let pp_scard ppf x = Format.fprintf ppf "%d" (S.Sset.cardinal x)
    let pp_dated ppf d =
      let p fmt = Format.fprintf ppf fmt in
      p "{ commits: %a, lines_added: %d, lines_deleted: %d\n"
        pp_scard d.commits d.lines_added d.lines_deleted ;
      p "  issues: %a, issues_created: %a, issue_comments: %a, issues_reviewed: %a,\n"
        pp_icard d.issues pp_icard d.issues_created pp_icard d.issue_comments
        pp_icard d.issues_reviewed ;
      p "  prs: %a, prs_created: %a, pr_comments: %a, prs_reviewed: %a,\n"
        pp_icard d.prs pp_icard d.prs_created pp_icard d.pr_comments
        pp_icard d.prs_reviewed ;
      p "}"

    type profile_kind = Person | Group of (profile * group_membership_periods) S.Imap.t

    (** A contributor's profile *)
    and profile = {
        id : user_id ;
        kind : profile_kind ;
        gh_user : GH.Types.full_user option ;
        name : string ;
        mutable dateds : dated Period.Map.t ;
      }

    and profiles = profile S.Imap.t

    let dup_profile p = { p with dateds = Period.Map.map dup_dated p.dateds }

    type finger = {
        default_periods : Period.t list ;
        profiles : profiles ;
        name_map : user_id S.Smap.t ;
        login_map : user_id S.Smap.t ;
        email_map : user_id S.Smap.t ;
        map_by_date : (Ptime.t -> profile -> profile) option ;
        get_gh_user : string -> GH.Types.full_user option ;
        }
    let dup_finger (f:finger) = { f with profiles = S.Imap.map dup_profile f.profiles }

(*    let finger_add_group (f:finger) group profiles =
      let ids = S.Imap.fold (fun id _ acc -> S.Iset.add id acc) profiles S.Iset.empty in
      let pred x = S.Iset.mem x ids in
      let profiles = S.Imap.filter (fun id _ -> not (pred id)) f.profiles in
      let profiles = S.Imap.add group.id group profiles in
      let map m = S.Smap.map (fun id -> if pred id then group.id else id) m in
      { profiles ;
        name_map = map f.name_map ;
        login_map = map f.login_map ;
        email_map = map f.email_map ;
      }
      *)

    type predefined_profile =
      { names : string list [@ocf Ocf.Wrapper.(list string), []] ;
        gh_login : string [@ocf Ocf.Wrapper.string, ""];
        emails : string list [@ocf Ocf.Wrapper.(list string), []];
      }[@@ocf]
    let predefined_profiles_from_file file =
      let%lwt string = Lwt_io.(with_file ~mode:Input file read) in
      let o = Ocf.(option (Wrapper.list predefined_profile_wrapper) []) in
      let g = Ocf.as_group o in
      Ocf.from_string g string ;
      Lwt.return (Ocf.get o)

    let groups_from_file =
      let wrapper = Ocf.Wrapper.string_map
        ~fold:S.Smap.fold ~add:S.Smap.add
        ~empty:S.Smap.empty (group_wrapper Ocf.Wrapper.string)
      in
      fun file ->
        let%lwt string = Lwt_io.(with_file ~mode:Input file read) in
        let o = Ocf.(option wrapper) S.Smap.empty in
        let g = Ocf.as_group o in
        Ocf.from_string g string ;
        Lwt.return (Ocf.get o)

    type pr = {
        issue : GH.Types.issue ;
        merge_date : Ptime.t option ;
        pr : GH.Types.pull_request ;
        authors : S.Iset.t ;
        reviewers : S.Iset.t ;
        author_commits : S.Sset.t ;
        review_commits : S.Sset.t ;
        comments : GH.Types.comment S.Imap.t ;
        review_comments : GH.Types.review_comment S.Imap.t ;
        merger : user_id option ;
      }

    let pp_iset ppf set = Format.pp_print_string ppf
      (String.concat ", " (List.map string_of_int (S.Iset.elements set)))
    let pp_sset ppf set = Format.pp_print_string ppf
      (String.concat ", " (S.Sset.elements set))

    let pp_pr ppf pr =
       Format.fprintf ppf "PR %d:\n  authors: %a\n  reviewers: %a\n  author_commits: %a\n  review_commits: %a"
        pr.issue.number pp_iset pr.authors pp_iset pr.reviewers
        pp_sset pr.author_commits pp_sset pr.review_commits

    type gstats = {
        mutable g_issues :  GH.Types.issue S.Imap.t ;
        mutable g_prs : pr S.Imap.t ;
        mutable g_commits : GH.Types.commit S.Smap.t ;
        mutable g_committers : (user_id * int) list ;
        mutable g_pr_commits : GH.Types.commit S.Smap.t ;
        mutable g_pr_committers : (user_id * int) list ;

        mutable g_issue_comments : int ;
        mutable g_issue_commenters : (user_id * int) list ;
        mutable g_issue_participants : (user_id * int) list ;
        mutable g_issue_creators : (user_id * int) list ;
        mutable g_issue_reviewers : (user_id * int) list ;

        mutable g_pr_comments : int ;
        mutable g_pr_commenters : (user_id * int) list ;
        mutable g_pr_participants : (user_id * int) list ;
        mutable g_pr_creators : (user_id * int) list ;
        mutable g_pr_reviewers : (user_id * int) list ;
        mutable g_pr_reviewers_from_changelog : (user_id * int) list ;
        mutable g_prs_of_subsys : S.Iset.t Subs.Map.t ;

        mutable g_subsys_commits : float Subs.Map.t ;
        mutable g_active_contributors : (user_id * float) list ;
      }

    let gstats () = {
        g_issues = S.Imap.empty ;
        g_prs = S.Imap.empty ;
        g_commits = S.Smap.empty ;
        g_committers = [] ;
        g_pr_commits = S.Smap.empty ;
        g_pr_committers = [] ;
        g_issue_comments = -1 ;
        g_issue_commenters = [] ;
        g_issue_participants = [] ;
        g_issue_creators = [] ;
        g_issue_reviewers = [] ;
        g_pr_comments = -1 ;
        g_pr_commenters = [] ;
        g_pr_participants = [] ;
        g_pr_creators = [] ;
        g_pr_reviewers = [] ;
        g_pr_reviewers_from_changelog = [] ;
        g_prs_of_subsys = Subs.Map.empty ;
        g_subsys_commits = Subs.Map.empty ;
        g_active_contributors = [] ;
      }
    let dup_gstats s = { s with g_issues = s.g_issues }

    type max = {
        mutable max_committer : int * user_id ;
        mutable max_issue_commenter : int * user_id ;
        mutable max_issue_reviewer : int * user_id ;
        mutable max_issue_creator : int * user_id ;
        mutable max_pr_commenter : int * user_id ;
        mutable max_pr_creator : int * user_id ;
        mutable max_pr_reviewer : int * user_id ;
        mutable max_pr_reviewer_from_changelog : int * user_id ;
        mutable max_subsys_commits : (int * user_id) Subs.Map.t ;
      }
    let new_max () =
      let default = 0, -1 in
      { max_committer = default ;
        max_issue_commenter = default ;
        max_issue_reviewer = default ;
        max_issue_creator = default ;
        max_pr_commenter = default ;
        max_pr_creator = default ;
        max_pr_reviewer = default ;
        max_pr_reviewer_from_changelog = default ;
        max_subsys_commits = Subs.Map.empty ;
      }
    let dup_max m = { m with max_committer = m.max_committer }

    type t = {
        repo_name : string ;
        finger : finger ;
        mutable stats : gstats Period.Map.t ;
        mutable max : max Period.Map.t ;
        orig_issues : GH.Types.issue S.Imap.t ;
        orig_commits : GH.Types.commit S.Smap.t ;
        get_gh_user : string -> GH.Types.full_user option ;
        orig_changelog : Changelog.t option ;
        orig_events : S.Types.event list ;
        has_changelog : bool ;
      }

    let dup t = {
        repo_name = t.repo_name ;
        finger = dup_finger t.finger;
        stats = Period.Map.map dup_gstats t.stats ;
        max = Period.Map.map dup_max t.max;
        orig_issues = t.orig_issues ;
        orig_commits = t.orig_commits ;
        get_gh_user = t.get_gh_user ;
        orig_changelog = t.orig_changelog ;
        orig_events = t.orig_events ;
        has_changelog = t.has_changelog ;
      }

    let dot_node_decl t ?(more="") dot_id =
      let b = Buffer.create 256 in
      let subsys_sum = Subs.Map.fold (fun _ count acc -> count +. acc) t.subsys_commits 0. in
      Printf.bprintf b "%s [%s shape=circle style=wedged fillcolor=\"" dot_id more ;
      Buffer.add_string b (String.concat ":"
       (List.map (fun (s, f) -> Printf.sprintf "%s;%.2f" (Subs.to_dot_color s) (f /. subsys_sum))
        (Subs.Map.bindings t.subsys_commits)));
      Printf.bprintf b "\"];\n";
      Buffer.contents b

    let keep_commit_file (f:GH.Types.commit_file) =
      match Subs.list with
      | [] -> true
      | _ -> Subs.list_of_filename f.filename <> []

    let new_dated () = {
        commits = S.Sset.empty ;
        lines_added = 0 ;
        lines_deleted = 0 ;
        issues = S.Iset.empty ;
        issues_created = S.Iset.empty ;
        issue_comments = S.Iset.empty ;
        issues_reviewed = S.Iset.empty ;
        prs = S.Iset.empty ;
        prs_created = S.Iset.empty ;
        prs_created_merged = S.Iset.empty ;
        pr_author_commits = S.Sset.empty ;
        lines_added_in_prs_as_author = [] ;
        lines_deleted_in_prs_as_author = [] ;
        avg_lines_added_by_pr_as_author = None ;
        avg_lines_deleted_by_pr_as_author = None ;
        pr_comments = S.Iset.empty ;
        pr_review_comments = S.Iset.empty ;
        pr_review_commits = S.Sset.empty ;
        lines_added_in_prs_as_reviewer = [] ;
        lines_deleted_in_prs_as_reviewer = [] ;
        avg_lines_added_by_pr_as_reviewer = None ;
        avg_lines_deleted_by_pr_as_reviewer = None ;
        prs_reviewed = S.Iset.empty ;
        prs_reviewed_from_changelog = S.Iset.empty ;
        subsys_issues = Subs.Map.empty ;
        subsys_commits = Subs.Map.empty ;
        subsys_committed_files = Subs.Map.empty ;
        subsys_committed_lines = Subs.Map.empty ;
        reviewer_of_shared = S.Imap.empty ;
        reviewed_by_shared = S.Imap.empty ;
        reviewer_of = S.Imap.empty ;
        reviewed_by = S.Imap.empty ;
        as_author = S.Iset.empty;
        as_analyst = S.Iset.empty;
        as_reviewer = S.Iset.empty;
        as_reporter = S.Iset.empty;
        as_suggester = S.Iset.empty;
        as_other = S.Iset.empty;
        activity_score = 0. ;
      }

    let new_profile =
      let user_id = ref (-1) in
      fun ?gh_user ?(kind=Person) name ->
        let id = incr user_id ; !user_id in
        let u = { id ;
            gh_user ; kind ; name ;
            dateds = Period.Map.empty ;
          }
        in
        u

    let new_finger ?(default_periods=[]) get_gh_user =
      {
        default_periods ;
        profiles = S.Imap.empty ;
        name_map = S.Smap.empty ;
        login_map = S.Smap.empty ;
        email_map = S.Smap.empty ;
        map_by_date = None ;
        get_gh_user ;
      }

    let finger_map_by_date f date p =
      match f.map_by_date with
      | None -> p
      | Some m -> m date p

    let finger_find_by_ find map v (f:finger) =
      match find v map with
      | None -> None
      | Some id -> S.Imap.find_opt id f.profiles

    let finger_find_by_name name f = finger_find_by_ S.Smap.find_opt f.name_map name f
    let finger_find_by_email email f = finger_find_by_ S.Smap.find_opt f.email_map email f
    let finger_find_by_login login f = finger_find_by_ S.Smap.find_opt f.login_map login f
    let finger_find_by_id id (f:finger) = S.Imap.find_opt id f.profiles

    let rec finger_find ?email ?login ?name ?commit ?id f =
      match match id with
        | None -> None
        | Some id -> finger_find_by_id id f
      with
      | (Some _) as r -> r
      | None ->
          match match name with
            | None -> None
            | Some name -> finger_find_by_name name f
          with
          | (Some _) as r -> r
          | None ->
              match match email with
                | None -> None
                | Some email -> finger_find_by_email email f
              with
              | (Some _) as r -> r
              | None ->
                  match match login with
                    | None -> None
                    | Some login -> finger_find_by_login login f
                  with
                  | (Some _) as r -> r
                  | None ->
                      match commit with
                      | None -> None
                      | Some (c:GH.Types.commit) ->
                          let a = c.git_commit.author in
                          match c.author with
                          | None ->
                              finger_find ~name:a.cu_name ~login:a.cu_name ~email:a.cu_email f
                          | Some u ->
                              finger_find ~login:u.login ~name:a.cu_name ~email:a.cu_email f

    let opt_dated (u:profile) period = Period.Map.find_opt period u.dateds

    let get_dated (u:profile) period =
      match opt_dated u period with
      | None ->
          let d = new_dated () in
          u.dateds <- Period.Map.add period d u.dateds ;
          d
      | Some d -> d

    let finger_add (finger:finger) ?email ?login ?name p =
      List.iter
        (fun period -> ignore(get_dated p period))
        finger.default_periods ;
      let smap_add sopt map =
        match sopt with
        | None | Some "" -> map
        | Some s -> S.Smap.add s p.id map
      in
      let profiles, name_map, login_map, email_map =
        match S.Imap.find_opt p.id finger.profiles with
        | Some p2 ->
            let profiles =
              match p2.gh_user, p.gh_user with
              | None, Some _ -> S.Imap.add p.id p finger.profiles
              | _ -> finger.profiles
            in
            (profiles, finger.name_map, finger.login_map, finger.email_map)
        | None ->
            let profiles = S.Imap.add p.id p finger.profiles in
            let name_map = smap_add (Some p.name) finger.name_map in
            let name_map = smap_add (Some (S.Misc.normalize_name p.name)) name_map in
            let login_map, email_map =
              match p.gh_user with
              | None -> (finger.login_map, finger.email_map)
              | Some ghu ->
                  (smap_add (Some ghu.login) finger.login_map,
                   smap_add ghu.email finger.email_map)
            in
            (profiles, name_map, login_map, email_map)
      in
      let email_map = smap_add email email_map in
      let login_map = smap_add login login_map in
      let name_map = smap_add name name_map in
      let name_map = smap_add (Option.map S.Misc.normalize_name name) name_map in
      { finger with profiles ; email_map ; login_map ; name_map }

    let issue_creation_year (i:GH.Types.issue) = let (y,_,_) = Ptime.to_date i.created_at in y
    let comment_year (c:GH.Types.comment) = let (y,_,_) = Ptime.to_date c.created_at in y
    let review_comment_year (c:GH.Types.review_comment) = let (y,_,_) = Ptime.to_date c.created_at in y
    let commit_ptime (c:GH.Types.commit) = c.git_commit.author.cu_date
    let commit_year (c:GH.Types.commit) = let (y,_,_) = Ptime.to_date (commit_ptime c) in y
    let is_merge_commit (c:GH.Types.commit) = List.length c.parents >= 2

    let dateds_by_year =
      let f period d acc =
        match period with
        | Period.Year y -> S.Imap.add y d acc
        | _ -> acc
      in
      fun p -> Period.Map.fold f p.dateds S.Imap.empty

    let on_period (u:profile) p f = let d = get_dated u p in f d
    let on_all (u:profile) f = on_period u Period.All f
    let on_year (u:profile) year f = on_period u (Period.Year year) f
    let on_dintervals (u:profile) date f =
      Period.Map.iter (fun period d ->
         match period with
         | (S.Period.DInterval _)
             when S.Period.ptime_in_period period date -> f d
         |_ -> ()
      ) u.dateds

    let on_year_and_dintervals (u:profile) date f =
      let (y,_,_) = Ptime.to_date date in
      on_year u y f ;
      on_dintervals u date f

    let rec contribution_date profile = function
    | `Pr { merge_date = Some d } -> d
    | `Pr pr -> contribution_date profile (`Issue pr.issue)
    | `Issue i ->
        match i.GH.Types.closed_at with
        | None -> i.created_at
        | Some d -> d

    let contribution_year profile k = S.Misc.ptime_year (contribution_date profile k)

    let rev_sort_events_by_date =
      let comp (e1:GH.Types.event) (e2:GH.Types.event) =
        Ptime.compare e2.created_at e1.created_at
      in
      List.sort comp

    let most_recent_issue_event_date (issue:GH.Types.issue) =
      match rev_sort_events_by_date issue.events with
      | [] -> issue.created_at
      | e :: _ -> e.created_at


    let contrib_of_commit finger (c:GH.Types.commit) =
      match c.author with
      | None ->
          Log.err (fun m -> m "No author for commit %s" c.sha);
          None
      | Some u -> finger_find_by_id u.contrib_id finger

    let contrib_of_comment finger (c:GH.Types.comment) =
      if c.user.contrib_id < 0 then
        (
          Log.err (fun m -> m "No contributor for comment %d" c.id);
          None
        )
      else
        finger_find_by_id c.user.contrib_id finger

    let contrib_of_review_comment finger (c:GH.Types.review_comment) =
      match c.user with
      | None ->
          (* review comment with no user are typically attributed to "ghost"
             user, i.e. account not existing anymore. Let's ignore silently.*)
          None
      | Some u ->
          if u.contrib_id < 0 then
            (
             Log.err (fun m -> m "No contributor for review comment %d" c.id);
             None
            )
          else
            finger_find_by_id u.contrib_id finger

    let contrib_of_issue finger (i:GH.Types.issue) =
      if i.user.contrib_id < 0 then
        (
          Log.err (fun m -> m "No contributor for issue %s" i.id);
          None
        )
      else
        finger_find_by_id i.user.contrib_id finger

    let contrib_of_event finger (e:GH.Types.event) =
      match e.author with
      | Some u -> finger_find_by_id u.contrib_id finger
      | None ->
          match e.actor with
          | Some u -> finger_find_by_id u.contrib_id finger
          | None ->
              match e.user with
              | Some u -> finger_find_by_id u.contrib_id finger
              | None ->
                  Log.debug (fun m -> m "No author, actor or user for event %d" e.id);
                  None

    let issue_event_dates_of_user finger u (issue:GH.Types.issue) =
      let pred (e:GH.Types.event) =
        match contrib_of_event finger e with
        | Some u2 when u2.id = u.id ->
            (match e.event with
             | `Closed | `Commented | `Committed | `Line_commented | `Merged
             | `Ready_for_review | `Renamed | `Reopened | `Reviewed -> true
             | _ -> false
            )
        | _ -> false
      in
      List.filter pred issue.events

    let commit_info_of_author finger author (gh_user:GH.Types.full_user) get_commit (issue:GH.Types.issue) shas =
      let f_sha sha (commits,added,deleted) =
        match get_commit sha with
        | None ->
            Log.warn (fun m -> m "Commit %S not found ??" sha);
            (commits, added, deleted)
        | Some (c:GH.Types.commit) ->
            match contrib_of_commit finger c with
            | None -> (commits, added, deleted)
            | Some cb ->
                match cb.id = author.id with
                | false ->
                    (commits, added, deleted)
                | true ->
                    let files = List.filter keep_commit_file c.files in
                    let (a,d) = List.fold_left (fun (add,del) (f:GH.Types.commit_file) ->
                         (add + f.additions, del + f.deletions)) (0,0) files
                    in
                    let warn nb typ =
                      let url = Iri.to_string gh_user.html_url in
                      Log.warn (fun m -> m "User %s (%s): %d lines %s in commit %s (PR %a)"
                         (Option.value ~default:"" gh_user.name)
                           url nb typ c.sha Iri.pp issue.html_url)
                    in
                    if a > 3000 then warn a "added";
                    if d > 3000 then warn d "deleted";
                    (S.Sset.add sha commits, added + a, deleted + d)
      in
      S.Sset.fold f_sha shas (S.Sset.empty, 0, 0)

    let gh_users_not_found = ref S.Sset.empty

    let authors_of_commits pred commits =
      List.fold_left
        (fun acc c ->
           if pred (c:GH.Types.commit) then
             match c.author with
             | Some u -> S.Sset.add u.login acc
             | None -> acc
           else
             acc)
        S.Sset.empty commits

    let contrib_ids_of_commits finger pred commits =
      List.fold_left
        (fun acc c ->
           if pred (c:GH.Types.commit) then
             match contrib_of_commit finger c with
             | None -> acc
             | Some p -> S.Iset.add p.id acc
           else
             acc)
        S.Iset.empty commits

    let shas_of_commits (commits:GH.Types.commit list) =
      List.fold_left (fun acc c -> S.Sset.add c.GH.Types.sha acc)
        S.Sset.empty commits

    let merge_info_of_timeline finger commits id (timeline:GH.Types.timeline) =
      match List.find_opt (fun e -> e.GH.Types.event = `Merged) timeline with
      | None -> None, None
      | Some e ->
          let merge_date = Some e.created_at in
          let profile =
            match contrib_of_event finger e with
            | Some c -> Some c
            | None ->
                match e.commit_id with
                | None ->
                    Log.warn (fun m -> m "PR %d: no commit id for merged event" id);
                    None
                | Some sha ->
                    match S.Smap.find_opt sha commits with
                    | None ->
                        Log.warn (fun m -> m "PR %d: commit %s not found in timeline" id sha);
                        None
                    | Some (c:GH.Types.commit) -> contrib_of_commit finger c
          in
          match profile with
          | None -> None, merge_date
          | Some (p:profile) -> Some p.id, merge_date

    let reviewers_of_timeline finger (timeline:GH.Types.timeline) =
      let f acc e =
        match e.GH.Types.event with
        | `Reviewed ->
            (match contrib_of_event finger e with
             | None -> acc
             | Some c -> S.Iset.add c.id acc
            )
        | _ -> acc
      in
      List.fold_left f S.Iset.empty timeline

    let split_pr_commits finger (issue:GH.Types.issue) (pr:GH.Types.pull_request) =
      (* first author commits are the ones with a date before the
         creation date of the pr *)
      let first_commits = List.filter
        (fun (c:GH.Types.commit) ->
           let d = c.git_commit.author.cu_date in
           Ptime.is_earlier ~than:issue.created_at d)
          pr.commits
      in
      let authors = List.fold_left
        (fun acc c ->
           match contrib_of_commit finger c with
           | None ->
               Log.warn (fun m -> m "split_pr_commits: no author for commit %s" c.sha);
               acc
           | Some p -> S.Iset.add p.id acc
        )
          (* always add PR creator as author *)
          (match contrib_of_issue finger issue with
           | None -> S.Iset.empty
           | Some p -> S.Iset.singleton p.id)
          first_commits
      in
      let committers = contrib_ids_of_commits finger
        (fun _ -> true (*S.Sset.mem c.sha orig_commit_shas*))
          pr.commits
      in
      let author_commits, review_commits = List.partition
        (fun c -> match contrib_of_commit finger c with
           | None -> false
           | Some p -> S.Iset.mem p.id authors
           )
          pr.commits
      in
      let reviewers = S.Iset.diff committers authors in
      (* do not keep merge commits *)
      let author_commits = List.filter (fun c -> not (is_merge_commit c)) author_commits in
      let review_commits = List.filter (fun c -> not (is_merge_commit c)) review_commits in
      (shas_of_commits author_commits,
       authors,
       shas_of_commits review_commits,
       reviewers)

    let prs_of_issues =
      let f trunk_commits finger _ (i:GH.Types.issue) =
        match i.pull_request with
        | None -> None
        | Some pr ->
            let comments = List.fold_left
              (fun acc (c:GH.Types.comment) -> S.Imap.add c.id c acc)
                S.Imap.empty i.comments
            in
            let review_comments = List.fold_left
              (fun acc (c:GH.Types.review_comment) -> S.Imap.add c.id c acc)
                S.Imap.empty pr.review_comments
            in
            let author_commits, authors, review_commits, reviewers =
              split_pr_commits finger i pr
            in
            let reviewers = S.Imap.fold
              (fun _id (c:GH.Types.comment) acc ->
                 match contrib_of_comment finger c with
                 | Some p when not (S.Iset.mem p.id authors) -> S.Iset.add p.id acc
                 | _ -> acc
              )
                comments reviewers
            in
            let reviewers = S.Imap.fold
              (fun _id (c:GH.Types.review_comment) acc ->
                 match contrib_of_review_comment finger c with
                 | Some p when not (S.Iset.mem p.id authors) -> S.Iset.add p.id acc
                 | _ -> acc
              )
                review_comments reviewers
            in
            let reviewers_from_timeline =
              S.Iset.diff (reviewers_of_timeline finger i.timeline) authors
            in
            let reviewers = S.Iset.union reviewers reviewers_from_timeline in
            let merger, merge_date = merge_info_of_timeline finger trunk_commits i.number i.timeline in
            let pr =
              { issue = i ; pr ;
                authors ; reviewers ; author_commits ; review_commits ;
                comments ; review_comments ; merger ; merge_date ;
              }
            in
            (*if pr.issue.number = 102 || pr.issue.number = 1655 then Log.warn (fun m -> m "%a" pp_pr pr);*)
            Some pr
      in
      fun trunk_commits finger -> S.Imap.filter_map (f trunk_commits finger)

    let rec get_profile ?commit finger = function
    | `GH_user (ghu:GH.Types.user) ->
        (match finger_find ~login:ghu.login ~name:ghu.login ?commit finger with
         | Some p -> (p, finger)
         | None ->
             match finger.get_gh_user ghu.login with
             | None ->
                 S.Sset.(match mem ghu.login !gh_users_not_found with
                  | false ->
                      gh_users_not_found := add ghu.login !gh_users_not_found ;
                      Log.info (fun m -> m "github user not found from github login: %s" ghu.login);
                  | true -> ());
                 get_profile finger (`Changelog_name ghu.login)
             | Some gh_user ->
                 match finger_find ?name:gh_user.name finger with
                 | None ->
                     let u = new_profile ~gh_user (Option.value ~default:ghu.login gh_user.name) in
                     let finger = finger_add finger u in
                     (u, finger)
                 | Some ({ gh_user = Some _ } as p)->
                     (* unify both on name, by adding ghu.login as key for the profile found *)
                     let finger = finger_add finger ~login:ghu.login p in
                     (p, finger)
                 | Some p ->
                     (* p has no github user, set it *)
                     let p = { p with gh_user = Some gh_user } in
                     Log.warn (fun m -> m "adding gh_user with login %s to already existing profile %s"
                        gh_user.login p.name);
                     let finger = finger_add finger ~login:ghu.login p in
                     (p,finger)
        )
    | `Changelog_name name ->
        (match finger_find ~name ~login:name finger with
         | Some p -> (p, finger)
         | None ->
             Log.warn (fun m -> m "User \"%s\" from change log not found in profiles, adding it" name);
             let u = new_profile name in
             let finger = finger_add finger u in
             (u, finger)
        )
    | `Commit c ->
        match finger_find ~commit:c finger with
        | Some p -> (p, finger)
        | None ->
            let name = c.git_commit.author.cu_name in
            Log.warn (fun m -> m "User \"%s\" from commit %s not found in profiles, adding it" name c.sha);
            let p = new_profile name in
            let finger = finger_add finger ~name ~email:c.git_commit.author.cu_email p in
            (p,finger)

    let set_user_contrib finger ?commit (u:GH.Types.user) =
      let (c,finger) = get_profile ?commit finger (`GH_user u) in
      { u with contrib_id = c.id }, finger

    let set_comment_contrib finger (comment:GH.Types.comment) =
      let (user, finger) = set_user_contrib finger comment.user in
      (*Log.warn (fun m -> m "comment %d: contributor %d" comment.id user.contrib_id);*)
      { comment with user }, finger

    let set_comments_contrib finger comments =
      List.fold_left (fun (coms, finger) c ->
         let (c,finger) = set_comment_contrib finger c in
         (c::coms, finger))
        ([],finger) comments

    let set_review_comment_contrib finger (comment:GH.Types.review_comment) =
        match comment.user with
        | None -> comment, finger
        | Some user ->
            let (u, finger) = set_user_contrib finger user in
            { comment with user = Some u}, finger

    let set_review_comments_contrib finger comments =
     List.fold_left (fun (coms, finger) c ->
         let (c,finger) = set_review_comment_contrib finger c in
         (c::coms, finger))
        ([],finger) comments

    let set_event_contrib finger (ev:GH.Types.event) =
      let f finger = function
      | None -> None, finger
      | Some ({login=""}:GH.Types.user) -> None, finger
      | Some u ->
          let (u,finger) = set_user_contrib finger u in
          Some u, finger
      in
      let actor, finger = f finger ev.actor in
      let author, finger = f finger ev.author in
      let user, finger = f finger ev.user in
      { ev with actor ; author ; user }, finger

    let mapped_events = [`Merged;`Reviewed]
    let set_event_list_contrib finger events =
     List.fold_left (fun (events, finger) e ->
        if List.mem e.GH.Types.event mapped_events then
           let (e,finger) = set_event_contrib finger e in
           (e::events, finger)
         else
           (e::events, finger)
      )
        ([],finger) events

    let commit_is_from_svn =
      let re = Re.(compile (str "git-svn-id")) in
      fun (c:GH.Types.commit) ->
        match Re.exec_opt re c.git_commit.message with
        | None -> false
        | Some _ -> true

    let set_commit_contrib finger (c:GH.Types.commit) =
      if c.files = [] && not (is_merge_commit c) && not (commit_is_from_svn c) then
        Log.info (fun m -> m "commit %s: not a merge commit and not from svn, but no file" c.sha);
      match c.author with
      | Some u ->
          let (u, finger) = set_user_contrib finger ~commit:c u in
          { c with author = Some u }, finger
      | None ->
          let p, finger = get_profile finger (`Commit c) in
          let (u:GH.Types.user) =
            match p.gh_user with
            | None ->
                { login = "" ; id = -1 ; url = Iri.of_string "" ; contrib_id = p.id }
            | Some u ->
              { login = u.login ; id = u.id ; url = u.url ; contrib_id = p.id }
          in
          { c with author = Some u }, finger

    let set_commits_contrib finger commits =
      S.Smap.fold (fun _sha c (commits, finger) ->
         let (c,finger) = set_commit_contrib finger c in
         (S.Smap.add c.sha c commits, finger))
        commits (S.Smap.empty,finger)

    let set_commit_list_contrib finger commits =
      List.fold_left (fun (commits, finger) c ->
         let (c,finger) = set_commit_contrib finger c in
         (c :: commits, finger))
        ([],finger) commits

    let set_pull_request_contrib finger (pr:GH.Types.pull_request) =
      let (review_comments, finger) = set_review_comments_contrib finger pr.review_comments in
      let (commits, finger) = set_commit_list_contrib finger pr.commits in
      { pr with review_comments ; commits }, finger

    let set_issue_contrib finger (issue:GH.Types.issue) =
      let (u, finger) = set_user_contrib finger issue.user in
      let (issue, finger) =
        match issue.pull_request with
        | None -> issue, finger
        | Some pr ->
            let (pr, finger) = set_pull_request_contrib finger pr in
            { issue with pull_request = Some pr }, finger
      in
      let (comments, finger) = set_comments_contrib finger issue.comments in
      let (events, finger) = set_event_list_contrib finger issue.events in
      let (timeline, finger) = set_event_list_contrib finger issue.timeline in
      { issue with user = u ; comments ; events ; timeline }, finger

    let set_issues_contrib finger issues =
      S.Imap.fold (fun id i (map,finger) ->
         let (i,finger) = set_issue_contrib finger i in
         S.Imap.add id i map, finger)
        issues (S.Imap.empty, finger)

    let set_changelog_name_contrib finger (name,_) =
      let (c, finger) = get_profile finger (`Changelog_name name) in
      (name, c.id), finger

    let set_changelog_names_contrib finger names =
      List.fold_left (fun (conts, finger) c ->
         let (c,finger) = set_changelog_name_contrib finger c in
         (c::conts), finger)
        ([], finger) names

    let set_entry_contrib finger (e:CH.entry) =
      let (authors, finger) = set_changelog_names_contrib finger e.authors in
      let (review, finger) = set_changelog_names_contrib finger e.review in
      let (analysis, finger) = set_changelog_names_contrib finger e.analysis in
      let (suggestion, finger) = set_changelog_names_contrib finger e.suggestion in
      let (report, finger) = set_changelog_names_contrib finger e.report in
      let (other, finger) = set_changelog_names_contrib finger e.other in
      { e with authors ; review ; analysis ; suggestion ; report ; other }, finger

    let set_changelog_contrib finger releases =
      let f_cat name entries (cats,finger) =
         let (entries, finger) =
          List.fold_left (fun (entries, finger) e ->
             let (e,finger) = set_entry_contrib finger e in
             (e::entries), finger)
            ([],finger) entries
        in
        S.Smap.add name entries cats, finger
      in
      let f_rel name rel (releases,finger) =
        let (categories, finger) = S.Smap.fold f_cat rel.CH.categories (S.Smap.empty,finger) in
        S.Smap.add name { rel with CH.categories } releases, finger
      in
      S.Smap.fold f_rel releases (S.Smap.empty, finger)

    let set_contrib finger issues commits changelog =
      let (issues, finger) = set_issues_contrib finger issues in
      let (commits, finger) = set_commits_contrib finger commits in
      let (changelog, finger) = match changelog with
        | None -> (None, finger)
        | Some cl ->
            let (cl, finger) = set_changelog_contrib finger cl in
            (Some cl, finger)
      in
      (issues, commits, changelog, finger)

    let add_issue_d (dated:dated) (i:GH.Types.issue) = dated.issues <- S.Iset.add i.number dated.issues
    let add_issue (user:profile) (i:GH.Types.issue) =
      let f d = add_issue_d d i in
      on_all user f;
      on_year_and_dintervals user i.created_at f

    let add_issue_created_d dated (i:GH.Types.issue) =
      dated.issues_created <- S.Iset.add i.number dated.issues_created

    let add_issue_created (user:profile) i =
      let f d = add_issue_d d i; add_issue_created_d d i in
      on_all user f;
      on_year_and_dintervals user i.created_at f

    let add_issue_comment_d dated id = dated.issue_comments <- S.Iset.add id dated.issue_comments
    let add_issue_comment (user:profile) (i:GH.Types.issue) (c:GH.Types.comment) =
      let f d = add_issue_d d i; add_issue_comment_d d c.id in
      on_all user f ;
      on_year_and_dintervals user c.created_at f

    let add_issue_reviewed (u:profile) (i:GH.Types.issue) =
      let f d = d.issues_reviewed <- S.Iset.add i.number d.issues_reviewed in
      on_all u f ;
      on_year_and_dintervals u i.created_at f

    let add_pr_d (dated:dated) (pr:pr) = dated.prs <- S.Iset.add pr.issue.number dated.prs
    let add_pr user (pr:pr) =
      let f d = add_pr_d d pr in
      on_all user f;
      on_year_and_dintervals user pr.issue.created_at f

    let add_pr_created_d finger get_commit user dated (pr:pr) =
      dated.prs_created <- S.Iset.add pr.issue.number dated.prs_created;
      (match pr.issue.pull_request, pr.merger with
       | None, _ ->
           Log.err (fun m -> m "pr %d from issue with no PR ??" pr.issue.number)
       | Some { merged_at = None}, None ->
           ()
       | Some { merged_at = Some _}, None ->
           Log.warn (fun m -> m "PR %d: merged but no merger" pr.issue.number)
       | Some { merged_at = Some _}, Some _ ->
           dated.prs_created_merged <- S.Iset.add pr.issue.number dated.prs_created_merged
       | Some { merged_at = None }, Some _ ->
           Log.warn (fun m -> m "PR %d: not merged but has a merger" pr.issue.number)
      );
      match S.Sset.is_empty pr.author_commits with
      | true ->
          (
           (* no warning if PR is still open or was closed by the creator *)
           match pr.issue.closed_by with
           | None -> ()
           | Some cu ->
               if pr.issue.user.GH.Types.id <> cu.GH.Types.id then
                 Log.warn (fun m -> m "PR %d has no author commits (commits_url=%a)"
                    pr.issue.number Iri.pp pr.pr.commits_url)
          )
      | _ ->
          let (commits,added,deleted) =
            match user.gh_user with
            | None ->
                (match user.kind with
                 | Group _ -> Log.err (fun m -> m "Group %S has no github account" user.name)
                 | _ -> ());
                (S.Sset.empty, 0, 0)
            | Some gh_user ->
                commit_info_of_author finger user gh_user get_commit pr.issue
                  pr.author_commits
          in
          dated.pr_author_commits <- S.Sset.union dated.pr_author_commits commits ;
          dated.lines_added_in_prs_as_author <- added :: dated.lines_added_in_prs_as_author ;
          dated.lines_deleted_in_prs_as_author <- deleted :: dated.lines_deleted_in_prs_as_author

    let add_pr_created finger get_commit (user:profile) (pr:pr) =
      add_pr user pr ;
      let f d = add_pr_created_d finger get_commit user d pr in
      on_all user f ;
      on_year_and_dintervals user pr.issue.created_at f

    let add_pr_comment_d dated id = dated.pr_comments <- S.Iset.add id dated.pr_comments
    let add_pr_comment (user:profile) (pr:pr) (c:GH.Types.comment) =
      let f d= add_pr_d d pr; add_pr_comment_d d c.id in
      on_all user f;
      on_year_and_dintervals user c.created_at f

    let add_pr_review_comment_d dated id =
      dated.pr_review_comments <- S.Iset.add id dated.pr_review_comments

    let add_pr_review_comment (user:profile) (pr:pr) (c:GH.Types.review_comment) =
      let f d = add_pr_d d pr; add_pr_review_comment_d d c.id in
      on_all user f;
      on_year_and_dintervals user c.created_at f

    let add_pr_reviewed_from_changelog_d dated pr =
      dated.prs_reviewed_from_changelog <- S.Iset.add pr.issue.number dated.prs_reviewed_from_changelog

    let add_pr_reviewed_from_changelog (user:profile) (pr:pr) =
      add_pr user pr ;
      let f d = add_pr_reviewed_from_changelog_d d pr in
      on_all user f;
      on_year_and_dintervals user pr.issue.created_at f

    let add_pr_reviewed_d finger get_commit dated user pr =
      dated.prs_reviewed <- S.Iset.add pr.issue.number dated.prs_reviewed;
      let (commits,added,deleted) =
        match user.gh_user with
        | None -> (S.Sset.empty, 0, 0)
        | Some gh_user ->
            commit_info_of_author finger user gh_user get_commit pr.issue
              pr.review_commits
      in
(*      if user.id = 1346 || user.id = 151 then
        Log.warn (fun m -> m "add_pr_reviewed: profile %d, PR %d, added:%d, deleted:%d\n%d commits: %s"
           user.id pr.issue.number added deleted
                 (S.Sset.cardinal pr.review_commits)
             (String.concat ", " (S.Sset.elements pr.review_commits))
        ) ;*)
      if S.Sset.is_empty commits then
        ()
      else
        (
         dated.pr_review_commits <- S.Sset.union dated.pr_review_commits commits ;
         dated.lines_added_in_prs_as_reviewer <- added :: dated.lines_added_in_prs_as_reviewer ;
         dated.lines_deleted_in_prs_as_reviewer <- deleted :: dated.lines_deleted_in_prs_as_reviewer
        )

    let add_pr_reviewed finger get_commit (user:profile) (pr:pr) =
      add_pr user pr ;
      let f d = add_pr_reviewed_d finger get_commit d user pr in
      on_all user f ;
      on_year_and_dintervals user pr.issue.created_at f

    let add_git_commit_file_d dated (file:GH.Types.commit_file) =
      dated.lines_added <- dated.lines_added + file.additions;
      dated.lines_deleted <- dated.lines_deleted + file.deletions

    let add_git_commit_files_d dated files =
      List.iter (add_git_commit_file_d dated) files

    let add_commit_d (dated:dated) sha = dated.commits <- S.Sset.add sha dated.commits
    let add_commit (user:profile) (c:GH.Types.commit) =
      let files = List.filter keep_commit_file c.files in
      let f d = add_commit_d d c.sha; add_git_commit_files_d d files in
      on_all user f;
      on_year_and_dintervals user (commit_ptime c) f

    let add_as_author per u id =
      let d = get_dated u per in
      d.as_author <- S.Iset.add id d.as_author
    let add_as_analyst per u id =
      let d = get_dated u per in
      d.as_analyst <- S.Iset.add id d.as_analyst
    let add_as_reviewer per u id =
      let d = get_dated u per in
      d.as_reviewer <- S.Iset.add id d.as_reviewer
    let add_as_reporter per u id =
      let d = get_dated u per in
      d.as_reporter <- S.Iset.add id d.as_reporter
    let add_as_suggester per u id =
      let d = get_dated u per in
      d.as_suggester <- S.Iset.add id d.as_suggester
    let add_as_other per u id =
      let d = get_dated u per in
      d.as_other <- S.Iset.add id d.as_other

(*
    let link_review ~author:(idauthor,dauthor) ~reviewer:(idreviewer,dreviewer) =
      dauthor.reviewed_by <-
        (let n = match S.Imap.find_opt idreviewer dauthor.reviewed_by  with
         | None -> 1.
         | Some n -> n +. 1.
         in
         S.Imap.add idreviewer n dauthor.reviewed_by);
      dreviewer.reviewer_of <-
        (let n = match S.Imap.find_opt idauthor dreviewer.reviewer_of  with
         | None -> 1.
         | Some n -> n +. 1.
         in
         S.Imap.add idauthor n dreviewer.reviewer_of)

    let link_review_shared ~author:(idauthor,dauthor) ~reviewer:(idreviewer,dreviewer) v =
      dauthor.reviewed_by_shared <-
        (let n = match S.Imap.find_opt idreviewer dauthor.reviewed_by_shared  with
         | None -> v
         | Some n -> n +. v
         in
         S.Imap.add idreviewer n dauthor.reviewed_by_shared);
      dreviewer.reviewer_of_shared <-
        (let n = match S.Imap.find_opt idauthor dreviewer.reviewer_of_shared  with
         | None -> v
         | Some n -> n +. v
         in
         S.Imap.add idauthor n dreviewer.reviewer_of_shared)
*)
    let add_review_links ~author ~reviewer v_review_shared kinds =
(*      link_review ~author:(author.id, get_dated author Period.All)
        ~reviewer:(reviewer.id, get_dated reviewer Period.All);
      link_review_shared ~author:(author.id, get_dated author Period.All)
        ~reviewer:(reviewer.id, get_dated reviewer Period.All)
        v_review_shared;
*)
      let f_author d =
        let n = match S.Imap.find_opt reviewer.id d.reviewed_by_shared with
          | None -> v_review_shared
          | Some n -> n +. v_review_shared
        in
        d.reviewed_by_shared <- S.Imap.add reviewer.id n d.reviewed_by_shared;
        let n = match S.Imap.find_opt reviewer.id d.reviewed_by with
          | None -> 1.
          | Some n -> n +. 1.
        in
        d.reviewed_by <- S.Imap.add reviewer.id n d.reviewed_by
      in
      let f_reviewer d =
        let n = match S.Imap.find_opt author.id d.reviewer_of_shared with
          | None -> v_review_shared
          | Some n -> n +. v_review_shared
        in
        d.reviewer_of_shared <- S.Imap.add author.id n d.reviewer_of_shared;
        let n = match S.Imap.find_opt author.id d.reviewer_of with
          | None -> 1.
          | Some n -> n +. 1.
        in
        d.reviewer_of <- S.Imap.add author.id n d.reviewer_of
      in
      f_author (get_dated author Period.All);
      f_reviewer (get_dated reviewer Period.All);
      List.iter (fun k ->
         let date = contribution_date reviewer k in
         on_year_and_dintervals author date f_author;
         on_year_and_dintervals reviewer date f_reviewer;
      )
        kinds

    let ref_kind get_issue get_pr iref =
      match get_issue iref with
      | Some i -> Some (`Issue i)
      | None ->
          match get_pr iref with
          | Some pr -> Some (`Pr pr)
          | None -> None

    let add_changelog_entry_info finger get_issue get_pr (e:CH.entry) =
      let to_set l = List.fold_right (fun (_,id) set -> S.Iset.add id set) l S.Iset.empty in
      let analysts = to_set e.analysis in
      let authors = to_set e.authors in
      let reviewers = to_set e.review in
      let suggesters = to_set e.suggestion in
      let reporters = to_set e.report in
      let other_users = to_set e.other in
      let users = List.fold_right S.Iset.union
        [reviewers;analysts;suggesters;reporters;other_users] authors
      in
      let kinds =
        List.fold_right (fun iref acc ->
           let kind = ref_kind get_issue get_pr iref in
           match kind with
           | None -> acc
           | Some kind ->
               (* Add issue referenced by entry to all users of the entry *)
               let add = match kind with
                 | `Issue i -> (fun user -> add_issue user i)
                 | `Pr pr -> (fun user -> add_pr user pr)
               in
               S.Iset.iter (fun user_id ->
                  let user = S.Imap.find user_id finger.profiles in
                  add user)
                 users;
               let add_as add default u =
                 let dates =
                   let issue = match kind with `Issue i -> i | `Pr pr -> pr.issue in
                   match issue_event_dates_of_user finger u issue with
                   | (_::_) as events ->
                       List.map (fun (e:GH.Types.event) -> e.created_at) events
                   | [] ->
                       match default with
                       | `Create -> [issue.GH.Types.created_at]
                       | `Close ->
                           match issue.GH.Types.closed_at with
                           | None -> [issue.created_at]
                           | Some d -> [d]
                 in
                 add (Period.All) u iref;
                 List.iter (fun d ->
                    let (y,_,_) = Ptime.to_date d in
                    add (Period.Year y) u iref)
                   dates
               in
               (* Add issue referenced by entry to [as_X] field of Xs. *)
               let f add set =
                 S.Iset.iter (fun user_id ->
                    let user = S.Imap.find user_id finger.profiles in
                    add user) set
               in
               f (add_as add_as_author `Create) authors;
               f (add_as add_as_analyst `Close) analysts ;
               f (add_as add_as_reviewer `Close) reviewers ;
               f (add_as add_as_reporter `Create) reporters ;
               f (add_as add_as_suggester `Create) suggesters ;
               f (add_as add_as_other `Close) other_users ;
               (* Add issue referenced by entry to [issues_reviewed] field of reviewers *)
               let add_reviewed =
                 match kind with
                 | `Pr pr -> (fun user -> add_pr_reviewed_from_changelog user pr)
                 | `Issue i -> (fun user -> add_issue_reviewed user i)
               in
               S.Iset.iter
                 (fun user_id ->
                    let user = S.Imap.find user_id finger.profiles in
                    add_reviewed user)
                 reviewers;
               kind :: acc
        ) e.references []
      in
      (* add reviewers as reviewers of authors *)
      let v_review_shared = match S.Iset.cardinal reviewers with
        | 0 -> 0. | 1 -> 1. | n -> 1. /. float n
      in
      S.Iset.iter
        (fun author_id ->
           let author = S.Imap.find author_id finger.profiles in
           S.Iset.iter (fun reviewer_id ->
              let reviewer = S.Imap.find reviewer_id finger.profiles in
              add_review_links ~author ~reviewer v_review_shared kinds;
           )
             reviewers
        ) authors

    let add_changelog_category_info finger get_issue get_pr _name entries =
      List.iter (add_changelog_entry_info finger get_issue get_pr) entries

    let add_changelog_release_info finger get_issue get_pr _name { CH.categories } =
      (*let date = Option.value ~default:Ptime.epoch date in*)
      S.Smap.iter (add_changelog_category_info finger get_issue get_pr) categories

    let add_changelog_info finger issues prs changelog =
      let get_issue i = S.Imap.find_opt i issues in
      let get_pr i = S.Imap.find_opt i prs in
      S.Smap.iter (add_changelog_release_info finger get_issue get_pr) changelog

    let add_profile_subsys_d subsys_by_commit subsys_by_issue (dated:dated) =
      let subs_issues = ref Subs.Map.empty in
      let subs_commits = ref Subs.Map.empty in
      let subs_files = ref Subs.Map.empty in
      let subs_lines = ref Subs.Map.empty in
      let add_sub rmap sub v =
        rmap := match Subs.Map.find_opt sub !rmap with
          | None -> Subs.Map.add sub v !rmap
          | Some n -> Subs.Map.add sub (n+v) !rmap
      in
      let f sha =
        match subsys_by_commit sha with
        | None -> Log.warn (fun m -> m "Commit %s not found ??" sha)
        | Some (subs, files, lines) ->
            Subs.Set.iter (fun ss -> add_sub subs_commits ss 1) subs ;
            Subs.Map.iter (add_sub subs_files) files ;
            Subs.Map.iter (add_sub subs_lines) lines
      in
      S.Sset.iter f dated.commits ;
      let f issue_nb =
        match subsys_by_issue issue_nb with
        | None ->
            (* an issue not found may be an issue not existing when issues were downloaded
               but references by a commit downloaded later; it may also be an issue transfered to
               another repository and referenced in changelog, like 7745.*)
            Log.warn (fun m -> m "Issue %d not found (older than last download or transfered)" issue_nb)
        | Some subs ->
            Subs.Set.iter (fun ss -> add_sub subs_issues ss 1) subs
      in
      S.Iset.iter f dated.prs ;
      dated.subsys_issues <- Subs.Map.map float !subs_issues ;
      dated.subsys_commits <- Subs.Map.map float !subs_commits ;
      dated.subsys_committed_files <- Subs.Map.map float !subs_files ;
      dated.subsys_committed_lines <- Subs.Map.map float !subs_lines

    let add_profile_subsys subsys_by_commit subsys_by_issue _id (user:profile) =
      let f = add_profile_subsys_d subsys_by_commit subsys_by_issue in
      Period.Map.iter (fun _period -> f) user.dateds;
      (
       match Period.(Map.find_opt All user.dateds) with
       | None -> Log.err (fun m -> m "%s [%d] has no All period ?!?" user.name user.id)
       | Some _d ->
           (*Log.info (fun m -> m "%s [%d] has %d entries in subsys_issues" user.name user.id
              (Subs.Map.cardinal d.subsys_issues))*)
           ()
      );
      ()

    let commits_of_issue (i:GH.Types.issue) =
      match i.pull_request with
      | None -> []
      | Some pr -> pr.commits

    let compute_subsys subsys_by_commit issues profiles =
      let subsys_by_issue =
        let map = S.Imap.fold
          (fun id (i:GH.Types.issue) acc ->
             let subs = List.fold_left
               (fun acc c ->
                  let subs =
                    match subsys_by_commit c.GH.Types.sha with
                    | None ->
                        let (subs,_,_) = Subs.of_commit c in
                        subs
                    | Some (subs,_,_) -> subs
                  in
                  Subs.Set.union acc subs)
                 (Subs.of_issue i) (commits_of_issue i)
             in
             (*Log.info (fun m -> m "subsys of issue %d: %s" id
                (String.concat ", "
                 (List.map Subs.to_string (Subs.Set.elements subs))));*)
             S.Imap.add id subs acc
          )
            issues S.Imap.empty
        in
        fun id -> S.Imap.find_opt id map
      in
      S.Imap.iter (add_profile_subsys subsys_by_commit subsys_by_issue) profiles

    let add_profile_commits finger commits =
      S.Smap.iter (fun _sha c ->
         match contrib_of_commit finger c with
         | None -> ()
         | Some contrib -> add_commit contrib c)
        commits

    let add_profile_issue has_changelog finger (i:GH.Types.issue) =
      (match contrib_of_issue finger i with
       | None -> ()
       | Some c -> add_issue_created c i);
      List.iter (fun comment ->
         match contrib_of_comment finger comment with
         | None -> ()
         | Some c ->
             add_issue_comment c i comment;
             if not has_changelog then add_issue_reviewed c i
      ) i.comments

    let add_profile_issues has_changelog finger issues =
      S.Imap.iter (fun _id i -> add_profile_issue has_changelog finger i) issues

    let add_profile_info changelog issues prs commits finger =
      Option.iter (add_changelog_info finger issues prs) changelog;
      add_profile_commits finger commits;
      add_profile_issues (changelog<>None) finger issues

    let subsys_by_commit commits =
      let map = S.Smap.fold
        (fun _ (c:GH.Types.commit) acc ->
           S.Smap.add c.sha (Subs.of_commit c) acc)
          commits S.Smap.empty
      in
      fun sha -> S.Smap.find_opt sha map

    let compute_pr_avg_lines_as_author =
      let on_d d =
        match d.lines_added_in_prs_as_author with
        | [] -> ()
        | l ->
            let add = float (List.fold_left (+) 0 l) /. float (List.length l) in
            d.avg_lines_added_by_pr_as_author <- Some add;
            let del = float (List.fold_left (+) 0 d.lines_deleted_in_prs_as_author)
              /. float (List.length d.lines_deleted_in_prs_as_author)
            in
            d.avg_lines_deleted_by_pr_as_author <- Some del;
      in
      fun _ (p:profile) ->
        Period.Map.iter (fun _ d -> on_d d) p.dateds

    let compute_pr_avg_lines_as_reviewer =
      let on_d d =
        match d.lines_added_in_prs_as_reviewer with
        | [] -> ()
        | l ->
            let add = float (List.fold_left (+) 0 l) /. float (List.length l) in
            d.avg_lines_added_by_pr_as_reviewer <- Some add;
            let del = float (List.fold_left (+) 0 d.lines_deleted_in_prs_as_reviewer)
              /. float (List.length d.lines_deleted_in_prs_as_reviewer)
            in
            d.avg_lines_deleted_by_pr_as_reviewer <- Some del;
      in
      fun _ (p:profile) ->
        Period.Map.iter (fun _ d -> on_d d) p.dateds

    let create_predefined_profiles ?default_periods get_gh_user predef_profiles =
      let f finger predef =
        match get_gh_user predef.gh_login with
        | None ->
            Log.err (fun m -> m "While creating predefined profiles: no github user with login %S (should be added to users to fetch in conf file ?)"
               predef.gh_login);
            finger
        | Some gh_user ->
            match predef.names with
            | [] -> failwith (Printf.sprintf "No name for %s" predef.gh_login);
            | name :: name_aliases ->
                let p = new_profile ~gh_user name in
                let finger = finger_add finger p in
                let finger = List.fold_right (fun name f -> finger_add f ~name p) name_aliases finger in
                let finger = List.fold_right (fun email f -> finger_add f ~email p) predef.emails finger in
                finger
      in
      List.fold_left f (new_finger ?default_periods get_gh_user) predef_profiles

    let compute_gstats_pr_commits gs =
      let acc = S.Imap.fold (fun _ (pr:pr) acc ->
        List.fold_left (fun acc c -> S.Smap.add c.GH.Types.sha c acc) acc pr.pr.commits)
        gs.g_prs S.Smap.empty
      in
      gs.g_pr_commits <- acc

    let sort_profile_value_list comp =
      List.sort (fun (_,n1) (_,n2) -> comp n2 n1)

    let committers_of_commits finger commits =
      let map = S.Smap.fold (fun _sha (c:GH.Types.commit) acc ->
           match contrib_of_commit finger c with
           | None -> acc
           | Some p ->
               match S.Imap.find_opt p.id acc with
               | None -> S.Imap.add p.id (p.id, 1) acc
               | Some (_,n) -> S.Imap.add p.id (p.id,n+1) acc)
        commits S.Imap.empty
      in
      let l = List.map snd (S.Imap.bindings map) in
      sort_profile_value_list Int.compare l

    let compute_gstats_committers finger gs =
      let l = committers_of_commits finger gs.g_commits in
      gs.g_committers <- l

    let compute_gstats_pr_committers finger gs =
      let l = committers_of_commits finger gs.g_pr_commits in
      gs.g_pr_committers <- l

    let compute_gstats_issue_ profiles period gs =
      let n = S.Imap.fold
        (fun _ i n -> List.length i.GH.Types.comments + n)
          gs.g_issues 0
      in
      gs.g_issue_comments <- n;
      let f f_field =
        let l = S.Imap.fold
          (fun _ p acc ->
             match opt_dated p period with
             | None -> acc
             | Some dated ->
                 let n = S.Iset.cardinal (f_field dated) in
                 if n <= 0 then acc else (p.id, n) :: acc
          )
            profiles []
        in
        sort_profile_value_list Int.compare l
      in
      gs.g_issue_commenters <- f (fun d -> d.issue_comments) ;
      gs.g_issue_participants <- f (fun d -> d.issues) ;
      gs.g_issue_creators <- f (fun d -> d.issues_created) ;
      gs.g_issue_reviewers <- f (fun d -> d.issues_reviewed) ;
      ()

    let compute_gstats_pr_ profiles period gs =
      let n = S.Imap.fold
        (fun _ pr n ->
           (List.length pr.issue.GH.Types.comments) +
             (List.length pr.pr.GH.Types.review_comments) + n)
          gs.g_prs 0
      in
      gs.g_pr_comments <- n;
      let f f_field =
        let l = S.Imap.fold
          (fun _ p acc ->
             match opt_dated p period with
             | None -> acc
             | Some dated ->
                 let n = S.Iset.cardinal (f_field dated) in
                 if n <= 0 then acc else (p.id, n) :: acc
          )
            profiles []
        in
        sort_profile_value_list Int.compare l
      in
      gs.g_pr_commenters <- f (fun d -> S.Iset.union d.pr_comments d.pr_review_comments) ;
      gs.g_pr_participants <- f (fun d -> d.prs) ;
      gs.g_pr_creators <- f (fun d -> d.prs_created) ;
      gs.g_pr_reviewers <- f (fun d -> d.prs_reviewed) ;
      gs.g_pr_reviewers_from_changelog <- f (fun d -> d.prs_reviewed_from_changelog) ;
      ()

    let compute_gstats_subsys_commits subsys_by_commit gs =
      let add_sub sub v map =
        match Subs.Map.find_opt sub map with
        | None -> Subs.Map.add sub v map
        | Some n -> Subs.Map.add sub (n+v) map
      in
      let f sha _ map =
        match subsys_by_commit sha with
        | None -> Log.warn (fun m -> m "Commit %s not found ??" sha); map
        | Some (subs, _files, _lines) ->
            Subs.Set.fold (fun ss map -> add_sub ss 1 map) subs map
      in
      let map = S.Smap.fold f gs.g_commits Subs.Map.empty in
      gs.g_subsys_commits <- Subs.Map.map float map ;
      let add_to_sub pr_id sub map =
        let set = match Subs.Map.find_opt sub map with
          | None -> S.Iset.singleton pr_id
          | Some set -> S.Iset.add pr_id set
        in
        Subs.Map.add sub set map
      in
      let add_from_commit pr_id sha map =
        match subsys_by_commit sha with
        | None -> map
        | Some (subs,_,_) -> Subs.Set.fold (add_to_sub pr_id) subs map
      in
      let ss_map = S.Imap.fold
        (fun pr_id pr map ->
           let map = S.Sset.fold (add_from_commit pr_id) pr.author_commits map in
           let map = S.Sset.fold (add_from_commit pr_id) pr.review_commits map in
           map
        ) gs.g_prs
          Subs.Map.empty
      in
      gs.g_prs_of_subsys <- ss_map

    let compute_gstats (finger:finger) period subsys_by_commit gs =
      compute_gstats_committers finger gs ;
      compute_gstats_pr_committers finger gs;
      compute_gstats_issue_ finger.profiles period gs ;
      compute_gstats_pr_ finger.profiles period gs ;
      compute_gstats_subsys_commits subsys_by_commit gs

    let fill_gstats_by_year_and_dintervals t =
      let add_on_year_and_dintervals fptime fset key v acc =
        let ptime = fptime v in
        let (y,_,_) = Ptime.to_date ptime in
        let (acc, gs) =
          match Period.(Map.find_opt (Year y) acc) with
          | None ->
              let gs = gstats () in
              (Period.Map.add (Period.Year y) gs acc, gs)
          | Some gs -> (acc, gs)
        in
        fset gs key v;
        Period.Map.iter (fun period gs ->
           match period with
           | Period.DInterval _ when Period.ptime_in_period period ptime ->
               fset gs key v
           | _ -> ()
        ) acc ;
        acc
      in
      let all_stats = Period.Map.find Period.All t.stats in
      t.stats <- S.Imap.fold
        (add_on_year_and_dintervals (fun (i:GH.Types.issue) -> i.created_at)
         (fun gs id v -> gs.g_issues <- S.Imap.add id v gs.g_issues))
          all_stats.g_issues
          t.stats;
      t.stats <- S.Imap.fold
        (add_on_year_and_dintervals (fun pr -> pr.issue.created_at)
         (fun gs id v -> gs.g_prs <- S.Imap.add id v gs.g_prs))
          all_stats.g_prs
          t.stats;
      Period.Map.iter (fun _period gs -> compute_gstats_pr_commits gs) t.stats;
      t.stats <- S.Smap.fold
        (add_on_year_and_dintervals commit_ptime
         (fun gs id v -> gs.g_commits <- S.Smap.add id v gs.g_commits))
          all_stats.g_commits
          t.stats

    let complete_profiles_with_pr (finger:finger) get_commit pr =
      if S.Iset.is_empty pr.authors then
        Log.warn (fun m -> m "No authors in PR %d" pr.issue.number);
      (*else
        Log.info (fun m -> m "%d authors in PR %d" (S.Iset.cardinal pr.authors) pr.issue.number);*)
      if S.Iset.is_empty pr.reviewers then
        (
         (* no warning if PR is still open or was closed by the creator *)
         match pr.issue.closed_by with
         | None -> ()
         | Some cu ->
             if pr.issue.user.GH.Types.id <> cu.GH.Types.id then
               Log.warn (fun m -> m "No reviewers in PR %d" pr.issue.number)
        );
      S.Iset.iter (fun id_author ->
         let author = S.Imap.find id_author finger.profiles in
         add_pr_created finger get_commit author pr)
        pr.authors ;
      S.Iset.iter (fun id_reviewer ->
         let reviewer = S.Imap.find id_reviewer finger.profiles in
         add_pr_reviewed finger get_commit reviewer pr)
        pr.reviewers;
      S.Imap.iter (fun _id (c:GH.Types.comment) ->
         match contrib_of_comment finger c with
         | Some p -> add_pr_comment p pr c (* by now add comment event for authors *)
         | _ -> ()
              )
        pr.comments;
      S.Imap.iter (fun _id (c:GH.Types.review_comment) ->
         match contrib_of_review_comment finger c with
         | Some p -> add_pr_review_comment p pr c
         | _ -> ()
      )
        pr.review_comments

    let complete_profiles_with_prs t =
      let all_stats = Period.(Map.find All t.stats) in
      let get_pr_commit sha = S.Smap.find_opt sha all_stats.g_pr_commits in
      S.Imap.iter (fun _ pr -> complete_profiles_with_pr t.finger get_pr_commit pr) all_stats.g_prs

    let complete_profiles_with_pr_avgs t =
      S.Imap.iter compute_pr_avg_lines_as_author t.finger.profiles ;
      S.Imap.iter compute_pr_avg_lines_as_reviewer t.finger.profiles

    let commit_tree_svg (commits:GH.Types.commit S.Smap.t) tree =
      let open S.Dot in
      let dot = create () in
      S.Smap.iter (fun sha children ->
         let url, color = match S.Smap.find_opt sha commits with
           | None ->
               (Printf.sprintf "https://api.github.com/repos/ocaml/ocaml/commits/%s" sha,
                "red")
           | Some c -> Iri.to_string c.url, "black"
         in
         p dot "n%s [ label=%S shape=box href=%S color=%S ];\n" sha sha url color;
         List.iter (fun childsha -> p dot "n%s -> n%s ;\n" sha childsha) children
      ) tree;
      let outfile = "/tmp/commit-tree.svg" in
      let%lwt () = run ~type_:"svg" ~outfile dot in
      Log.info (fun m -> m "Commit tree generated to %s" outfile);
      Lwt.return_unit

    let expand_commits issues (commits:GH.Types.commit S.Smap.t) =
      Log.info (fun m -> m "Expanding %d commits" (S.Smap.cardinal commits));
      let commit_date (c:GH.Types.commit) =
        let dauthor = c.git_commit.author.cu_date in
        let dcommitter = c.git_commit.committer.cu_date in
        if Ptime.is_earlier ~than:dauthor dcommitter then dauthor else dcommitter
      in
      let pr_commits = S.Imap.fold
        (fun _ (issue:GH.Types.issue) acc ->
           match issue.pull_request with
           | None -> acc
           | Some pr ->
               List.fold_right
                 (fun (c:GH.Types.commit) acc -> S.Smap.add c.sha c acc)
                 pr.commits acc
        )
          issues S.Smap.empty
      in
      let last_commit = S.Smap.fold
        (fun _sha (c:GH.Types.commit) (acc:GH.Types.commit) ->
           if Ptime.is_later ~than:(commit_date acc)
             (commit_date c)
           then c
           else acc)
          commits (snd (S.Smap.min_binding commits))
      in
      Log.info (fun m -> m "Last commit is %s (%a)" last_commit.sha (Ptime.pp_human())
         last_commit.git_commit.author.cu_date);
      let rec iter (acc,tree) (c:GH.Types.commit) =
        match S.Smap.find_opt c.sha acc with
        | Some _ -> (acc,tree)
        | None ->
            let tree =
              match S.Smap.find_opt c.sha tree with
              | None -> S.Smap.add c.sha [] tree
              | Some _ -> tree
            in
            let acc = if is_merge_commit c then acc else S.Smap.add c.sha c acc in
            let tree = List.fold_right
              (fun (parent:GH.Types.parent_commit) tree ->
                 match S.Smap.find_opt parent.sha tree with
                 | None -> S.Smap.add parent.sha [c.sha] tree
                 | Some l -> S.Smap.add parent.sha (c.sha::l) tree)
                c.parents tree
            in
            List.fold_right iter_parent c.parents (acc,tree)

      and iter_parent { sha } (acc,tree) =
        match S.Smap.find_opt sha commits with
        | Some c -> iter (acc,tree) c
        | None ->
            match S.Smap.find_opt sha pr_commits with
            | None ->
                Log.warn (fun m -> m "Commit not found: %s" sha);
                (acc,tree)
            | Some c -> iter (acc,tree) c
      in
      let (expanded,tree) = iter (S.Smap.empty, S.Smap.empty) last_commit in
      let added = S.Smap.filter (fun sha _ -> not (S.Smap.mem sha commits)) expanded in
      let removed = S.Smap.filter (fun sha _ -> not (S.Smap.mem sha expanded)) commits in
      Log.info (fun m -> m "%d commits after expansion (%d added, %d removed)"
         (S.Smap.cardinal expanded) (S.Smap.cardinal added) (S.Smap.cardinal removed));
      let output_svg = ref false in
      S.Smap.iter (fun sha c ->
         if not(is_merge_commit c) then
           ( output_svg := true;
            Log.warn (fun m -> m "Commit %s removed but is not a merge commit !" sha)
           )
      ) removed;
      let%lwt () =
        if !output_svg then
          commit_tree_svg (S.Smap.union (fun _ x _ -> Some x) commits pr_commits) tree
        else
          Lwt.return_unit
      in
      Lwt.return expanded

    let fill_max ?(ignored_users=S.Iset.empty) t =
      let get_max f map start =
        S.Imap.fold (fun id d ((acc_v,_acc_id) as acc) ->
           match d with
           | None -> acc
           | Some d ->
               let v = f d in
               if v >= acc_v then (v, id) else acc
        )
          map start
      in
      let max_committer = get_max (fun d -> S.Sset.cardinal d.commits) in
      let max_issue_commenter = get_max (fun d -> S.Iset.cardinal d.issue_comments) in
      let max_issue_reviewer = get_max (fun d -> S.Iset.cardinal d.issues_reviewed) in
      let max_issue_creator = get_max (fun d -> S.Iset.cardinal d.issues_created) in
      let max_pr_commenter = get_max (fun d -> S.Iset.cardinal d.pr_comments) in
      let max_pr_creator = get_max (fun d -> S.Iset.cardinal d.prs_created) in
      let max_pr_reviewer = get_max (fun d -> S.Iset.cardinal d.prs_reviewed) in
      let max_pr_reviewer_from_changelog = get_max (fun d -> S.Iset.cardinal d.prs_reviewed_from_changelog) in
      let max_subsys_commits ss =
        get_max (fun d ->
           match Subs.Map.find_opt ss d.subsys_commits with
           | None -> 0 | Some v -> truncate v)
      in
      let max_of_profiles proj profiles =
        let m = new_max () in
        let dateds = S.Imap.map proj profiles in
        m.max_committer <- max_committer dateds m.max_committer;
        m.max_issue_commenter <- max_issue_commenter dateds m.max_issue_commenter;
        m.max_issue_reviewer <- max_issue_reviewer dateds m.max_issue_reviewer;
        m.max_issue_creator <- max_issue_creator dateds m.max_issue_creator;
        m.max_pr_commenter <- max_pr_commenter dateds m.max_pr_commenter;
        m.max_pr_creator <- max_pr_creator dateds m.max_pr_creator;
        m.max_pr_reviewer <- max_pr_reviewer dateds m.max_pr_reviewer;
        m.max_pr_reviewer_from_changelog <- max_pr_reviewer_from_changelog dateds m.max_pr_reviewer_from_changelog;
        m.max_subsys_commits <- List.fold_left
          (fun acc ss -> Subs.Map.add ss
             (max_subsys_commits ss dateds (0,-1)) acc)
          Subs.Map.empty Subs.list;
        m
      in
      let profiles =
        if S.Iset.is_empty ignored_users then
          t.finger.profiles
        else
          S.Imap.filter (fun id _ -> not (S.Iset.mem id ignored_users)) t.finger.profiles
      in
      t.max <- Period.Map.mapi
        (fun period _gs -> max_of_profiles (fun p -> opt_dated p period) profiles)
        t.stats

    let set_activity_scores (data:t) =
      let scard x = float (S.Sset.cardinal x) in
      let smcard x = float (S.Smap.cardinal x) in
      let icard x = float (S.Iset.cardinal x) in
      let imcard x = float (S.Imap.cardinal x) in
      let snd_sum l = float (List.fold_right (fun (_,n) acc -> acc + n) l 0) in
      let f stats period _id p acc =
        match opt_dated p period with
        | None -> acc
        | Some dated ->
            let part_commits = scard dated.commits /. smcard stats.g_commits in
            let part_issues_created = icard dated.issues_created /. imcard stats.g_issues in
            let part_issue_comments = icard dated.issue_comments /. float stats.g_issue_comments in
            let part_prs_created = icard dated.prs_created /. imcard stats.g_prs in
            let part_prs_reviewed = icard dated.prs_reviewed /. snd_sum stats.g_pr_reviewers in
            let part_prs_reviewed_from_changelog =
              if data.has_changelog then
                icard dated.prs_reviewed_from_changelog /. snd_sum stats.g_pr_reviewers_from_changelog
              else
                0.
            in
            let part_pr_comments = icard dated.pr_comments /. float stats.g_pr_comments in
            let score = geometric_average [
                part_commits, 2. ;
                part_issues_created, 1. ;
                part_issue_comments, 1. ;
                part_prs_created, 1. ;
                part_prs_reviewed, 1. ;
                part_prs_reviewed_from_changelog, 5. ;
                part_pr_comments, 1. ;
              ]
            in
            dated.activity_score <- score;
            if score > 1.0 then (p.id, score) :: acc else acc
      in
      let on_profiles period stats =
        let active = S.Imap.fold (f stats period) data.finger.profiles [] in
        let sorted_active = List.sort (fun (_,score1) (_,score2) -> Float.compare score2 score1) active in
        stats.g_active_contributors <- sorted_active
      in
      Period.Map.iter on_profiles data.stats

    let merge_dated ~src ~dst =
      let add_r map2 =
        S.Imap.fold (fun id v acc ->
           match S.Imap.find_opt id acc with
           | None -> S.Imap.add id v acc
           | Some v1 -> S.Imap.add id (v1+.v) acc)
          map2
      in
      let sub_add_r map2 =
        Subs.Map.fold (fun id v acc ->
           match Subs.Map.find_opt id acc with
           | None -> Subs.Map.add id v acc
           | Some v1 -> Subs.Map.add id (v1+.v) acc)
          map2
      in
      dst.commits <- S.Sset.union dst.commits src.commits ;
      dst.lines_added <- src.lines_added + dst.lines_added ;
      dst.lines_deleted <- src.lines_deleted + dst.lines_deleted ;
      dst.issues <- S.Iset.union dst.issues src.issues ;
      dst.issues_created <- S.Iset.union dst.issues_created src.issues_created ;
      dst.issue_comments <- S.Iset.union dst.issue_comments src.issue_comments ;
      dst.issues_reviewed <- S.Iset.union dst.issues_reviewed src.issues_reviewed ;
      dst.prs <- S.Iset.union dst.prs src.prs ;
      dst.prs_created <- S.Iset.union dst.prs_created src.prs_created ;
      dst.prs_created_merged <- S.Iset.union dst.prs_created_merged src.prs_created_merged ;
      dst.pr_author_commits <- S.Sset.union dst.pr_author_commits src.pr_author_commits ;
      dst.lines_added_in_prs_as_author <- src.lines_added_in_prs_as_author @ dst.lines_added_in_prs_as_author ;
      dst.lines_deleted_in_prs_as_author <- src.lines_deleted_in_prs_as_author @ dst.lines_deleted_in_prs_as_author ;
      dst.pr_comments <- S.Iset.union dst.pr_comments src.pr_comments ;
      dst.pr_review_comments <- S.Iset.union dst.pr_review_comments src.pr_review_comments ;
      dst.pr_review_commits <- S.Sset.union dst.pr_review_commits src.pr_review_commits ;
      dst.lines_added_in_prs_as_reviewer <- src.lines_added_in_prs_as_reviewer @ dst.lines_added_in_prs_as_reviewer ;
      dst.lines_deleted_in_prs_as_reviewer <- src.lines_deleted_in_prs_as_reviewer @ dst.lines_deleted_in_prs_as_reviewer ;
      dst.prs_reviewed <- S.Iset.union dst.prs_reviewed src.prs_reviewed ;
      dst.prs_reviewed_from_changelog <- S.Iset.union dst.prs_reviewed_from_changelog src.prs_reviewed_from_changelog ;
      dst.subsys_issues <- sub_add_r src.subsys_issues dst.subsys_issues ;
      dst.subsys_commits <- sub_add_r src.subsys_commits dst.subsys_commits ;
      dst.subsys_committed_files <- sub_add_r src.subsys_committed_files dst.subsys_committed_files ;
      dst.subsys_committed_lines <- sub_add_r src.subsys_committed_lines dst.subsys_committed_lines ;
      dst.reviewed_by <- add_r src.reviewed_by dst.reviewed_by ;
      dst.reviewer_of <- add_r src.reviewer_of dst.reviewer_of ;
      dst.reviewed_by_shared <- add_r src.reviewed_by_shared dst.reviewed_by_shared ;
      dst.reviewer_of_shared <- add_r src.reviewer_of_shared dst.reviewer_of_shared ;
      dst.as_author <- S.Iset.union src.as_author dst.as_author ;
      dst.as_analyst <- S.Iset.union src.as_analyst dst.as_analyst ;
      dst.as_reviewer <- S.Iset.union src.as_reviewer dst.as_reviewer ;
      dst.as_reporter <- S.Iset.union src.as_reporter dst.as_reporter ;
      dst.as_suggester <- S.Iset.union src.as_suggester dst.as_suggester ;
      dst.as_other <- S.Iset.union src.as_other dst.as_other

    let add_profile_intervals intervals _ p =
      let f (y1, y2) =
        let years = S.Misc.mk_int_list ~start:y1 ~stop:y2 in
        let dst = new_dated () in
        let at_least_one = ref false in
        List.iter (fun y ->
           match opt_dated p (Year y) with
           | None -> ()
           | Some src ->
               at_least_one := true ;
               merge_dated ~src ~dst)
          years;
        if !at_least_one then
          p.dateds <- Period.Map.add (Period.YInterval (y1,y2)) dst p.dateds
      in
      List.iter f intervals

    let add_gstats_intervals =
      let u _ x _y = Some x in
      let merge_gstats ~src ~dst =
        dst.g_issues <- S.Imap.union u src.g_issues dst.g_issues ;
        dst.g_commits <- S.Smap.union u src.g_commits dst.g_commits ;
        dst.g_prs <- S.Imap.union u src.g_prs dst.g_prs ;
      in
      let rec on_years t gs stop year =
        if year > stop then
          gs
        else
          let () =
            match Period.Map.find_opt (Period.Year year) t.stats with
            | None -> ()
            | Some src -> merge_gstats ~src ~dst:gs
          in
          on_years t gs stop (year+1)
      in
      fun t intervals ->
        let f (start, stop) =
          let period = Period.YInterval (start, stop) in
          let gs = gstats () in
          on_years t gs stop start ;
          compute_gstats_pr_commits gs ;
          t.stats <- Period.Map.add period gs t.stats
      in
      List.iter f intervals

    let map_users_user finger date (u:GH.Types.user) =
      if u.contrib_id < 0 then
        u
      else
        let c = S.Imap.find u.contrib_id finger.profiles in
        let c = finger_map_by_date finger date c in
        { u with contrib_id = c.id }

    let map_users_comment finger (comment:GH.Types.comment) =
      let user = map_users_user finger comment.created_at comment.user in
      { comment with user }

    let map_users_comments finger comments =
      List.map (map_users_comment finger) comments

    let map_users_review_comment finger (comment:GH.Types.review_comment) =
        match comment.user with
        | None -> comment
        | Some user ->
            let u = map_users_user finger comment.created_at user in
            { comment with user = Some u}

    let map_users_review_comments finger comments =
      List.map (map_users_review_comment finger) comments

    let map_users_event finger (ev:GH.Types.event) =
      let f = map_users_user finger ev.created_at in
      let actor = Option.map f ev.actor in
      let author = Option.map f ev.author in
      let user = Option.map f ev.user in
      { ev with actor ; author ; user }

    let map_users_event_list finger events =
      List.map (map_users_event finger) events

    let map_users_commit finger (c:GH.Types.commit) =
      match c.author with
      | None -> c
      | Some u ->
          let u = map_users_user finger c.git_commit.author.cu_date u in
          { c with author = Some u }

    let map_users_commits finger commits =
      S.Smap.map (map_users_commit finger) commits

    let map_users_commit_list finger commits =
      List.map (map_users_commit finger) commits

    let map_users_pull_request finger (pr:GH.Types.pull_request) =
      let review_comments = map_users_review_comments finger pr.review_comments in
      let commits = map_users_commit_list finger pr.commits in
      { pr with review_comments ; commits }

    let map_users_issue finger (issue:GH.Types.issue) =
      let user = map_users_user finger issue.created_at issue.user in
      let issue =
        match issue.pull_request with
        | None -> issue
        | Some pr ->
            let pr = map_users_pull_request finger pr in
            { issue with pull_request = Some pr }
      in
      let comments = map_users_comments finger issue.comments in
      let events = map_users_event_list finger issue.events in
      let timeline = map_users_event_list finger issue.timeline in
      { issue with user ; comments ; events ; timeline }

    let map_users_issues finger issues = S.Imap.map (map_users_issue finger) issues

    let map_users_changelog_name finger date (name,id) =
      if id < 0 then
        (name, id)
      else
        let c = S.Imap.find id finger.profiles in
        let c = finger_map_by_date finger date c in
        (name, c.id)

    let map_users_changelog_names finger date names =
      List.map (map_users_changelog_name finger date) names

    let map_users_changelog_entry finger get_issue (e:CH.entry) =
      (* use closing date of first issue referenced by entry to map
         names; if no closing date, get date of most recent event of issue *)
      match e.references with
      | [] ->
          (*Log.warn (fun m -> m "No references in entry, not mapping changelog entry names");*)
          e
      | id :: _ ->
          match get_issue id with
          | None ->
              Log.warn (fun m -> m "No issue/PR %d, not mapping changelog entry names" id);
              e
          | Some issue ->
              let date =
                match issue.GH.Types.closed_at with
                | None -> most_recent_issue_event_date issue
                | Some d -> d
              in
              let f = map_users_changelog_names finger date in
              let authors = f e.authors in
              let review = f e.review in
              let analysis = f e.analysis in
              let suggestion = f e.suggestion in
              let report = f e.report in
              let other = f e.other in
              { e with authors ; review ; analysis ; suggestion ; report ; other }

    let map_users_changelog_entries finger get_issue list =
      List.map (map_users_changelog_entry finger get_issue) list

    let map_users_changelog_categories finger get_issue cats =
      S.Smap.map (map_users_changelog_entries finger get_issue) cats

    let map_users_changelog_release finger get_issue (rel:CH.release) =
      let categories = map_users_changelog_categories finger get_issue rel.CH.categories in
      { rel with categories }

    let map_users_changelog finger get_issue releases =
      S.Smap.map (map_users_changelog_release finger get_issue) releases

    let add_review_links t =
      if t.has_changelog then
        Log.err (fun m -> m "Profile/T.add_review_links should not be called when a changelog is provided.")
      else
        begin
          let cross authors reviewers kind =
            let v_review_shared = match S.Iset.cardinal reviewers with
              | 0 -> 0. | 1 -> 1. | n -> 1. /. float n
            in
            S.Iset.iter
              (fun author_id ->
                 let author = S.Imap.find author_id t.finger.profiles in
                 S.Iset.iter (fun reviewer_id ->
                    let reviewer = S.Imap.find reviewer_id t.finger.profiles in
                    add_review_links ~author ~reviewer v_review_shared [kind]
                 )
                   reviewers
              ) authors
          in
          let mk_map proj =
            let add pid issue_id acc =
              match S.Imap.find_opt issue_id acc with
              | None -> S.Imap.add issue_id (S.Iset.singleton pid) acc
              | Some set -> S.Imap.add issue_id (S.Iset.add pid set) acc
            in
            let map =
              S.Imap.fold (fun pid p acc ->
                 match Period.(Map.find_opt All p.dateds) with
                 | None ->
                     Log.info (fun m -> m "Contributor %S (%d) has no All period"
                        p.name pid);
                     acc
                 | Some d ->
                     let set = proj d in
                     S.Iset.fold (add pid) set acc
              )
                t.finger.profiles S.Imap.empty
            in
            fun id ->
              match S.Imap.find_opt id map with
              | None -> S.Iset.empty
              | Some set -> set
          in
          let issue_authors = mk_map (fun d -> d.issues_created) in
          let issue_reviewers = mk_map (fun d -> d.issues_reviewed) in
          let f_issue id i =
            cross (issue_authors id) (issue_reviewers id) ( `Issue i)
          in
          let f_pr _ pr = cross pr.authors pr.reviewers (`Pr pr) in
          let stats = Period.(Map.find All t.stats) in
          S.Imap.iter f_issue stats.g_issues ;
          S.Imap.iter f_pr stats.g_prs ;
        end

    let release_periods (events:S.Types.event list) =
      let open S.Types in
      let rels = List.filter (fun e ->
           (*Log.info (fun m -> m "%s: ev_release = %b" e.ev_label e.ev_release);*)
           e.ev_release) events
      in
      let rels = List.(rev (sort S.Types.compare_event rels)) in
      let rec f acc next rels =
        match rels, next with
        | [], _ -> List.rev acc
        | r :: q, None -> f acc (Some r) q
        | r1 :: q, Some r2 ->
            let label = Printf.sprintf "%s←%s" r2.ev_label r1.ev_label in
            let period = Period.DInterval (r1.ev_date, r2.ev_date, Some label) in
            f (period :: acc) (Some r1) q
      in
      let periods = f [] None rels in
      (*let () =
        let l = List.map
          (function
           | Period.DInterval (d1,d2,Some label) ->
               let to_s = S.Types.string_of_date in
               Printf.sprintf "%s-%s [%s]" (to_s d1) (to_s d2) label
           | _ -> assert false)
            periods
        in
        Log.warn (fun m -> m "Release periods: %s" (String.concat ", " l))
      in*)
      periods

    let create ~repo_name
      ?finger ?(predef=[]) ?(events=[]) ?changelog get_gh_user orig_issues orig_commits =
      let rel_periods = release_periods events in

      let keep_ids = Option.map snd finger in
      let finger = match finger with
        | None -> create_predefined_profiles ~default_periods:rel_periods get_gh_user predef
        | Some (finger,_) -> finger
      in
      let has_changelog = changelog <> None in
      let orig_changelog = changelog in
      let (issues,commits,changelog,finger) =
        set_contrib finger orig_issues orig_commits orig_changelog
      in
      let (issues,commits,changelog) =
        match finger.map_by_date with
        | None -> (issues,commits,changelog)
        | Some _ ->
            let issues = map_users_issues finger issues in
            let commits = map_users_commits finger commits in
            let changelog = Option.map
              (map_users_changelog finger
               (fun id -> S.Imap.find_opt id issues))
                changelog
            in
            (issues, commits, changelog)
      in
      let%lwt commits = expand_commits issues commits in
    (* let exp_commits = commits in *)
      let subsys_by_commit =
        subsys_by_commit commits (*(S.Smap.union (fun _ x _ -> Some x) commits pr_commits)*)
      in
      let issues_and_prs = issues in
      let prs = prs_of_issues commits finger issues in
      let issues = S.Imap.filter (fun _ i -> i.GH.Types.pull_request = None) issues in
      add_profile_info changelog issues prs commits finger ;
      Log.info (fun m -> m "%d issues, %d PRs" (S.Imap.cardinal issues) (S.Imap.cardinal prs));
      let t = {
          repo_name ;
          finger ;
          stats = Period.Map.empty ;
          max = Period.Map.empty ;
          orig_issues ;
          orig_commits ;
          get_gh_user ;
          orig_changelog ;
          orig_events = events ;
          has_changelog ;
        }
      in
      let all_stats = gstats () in
      all_stats.g_issues <- issues ;
      all_stats.g_prs <- prs ;
      all_stats.g_commits <- commits;
      t.stats <- Period.(Map.singleton All all_stats);

      t.stats <- List.fold_left (fun acc period ->
         Period.Map.add period (gstats()) acc) t.stats rel_periods ;

      compute_gstats_pr_commits all_stats ;
      fill_gstats_by_year_and_dintervals t;
      let intervals =
        let max_y =
          Period.Map.fold (fun p _ acc ->
             match p with
             | Year y when y > acc -> y
             | _ -> acc)
            t.stats 0
        in
        [(max_y-2, max_y) ; (max_y-4, max_y)]
      in
      complete_profiles_with_prs t;
      if not t.has_changelog then add_review_links t;
      S.Imap.iter (add_profile_intervals intervals) t.finger.profiles;
      complete_profiles_with_pr_avgs t ;
      add_gstats_intervals t intervals;
      compute_subsys subsys_by_commit issues_and_prs finger.profiles;
      Period.Map.iter (fun period gs -> compute_gstats finger period subsys_by_commit gs) t.stats;

      let t =
        match keep_ids with
        | None -> t
        | Some ids ->
            Log.info (fun m -> m "T.create: finger was provided, filtering %d => %d profiles"
               (S.Imap.cardinal t.finger.profiles) (S.Iset.cardinal ids));
            let profiles = S.Imap.filter
              (fun id _ -> S.Iset.mem id ids)
                t.finger.profiles
            in
            { t with finger = { t.finger with profiles } }
      in
      let ignored_users =
        match keep_ids with
        | Some ids ->
            S.Imap.fold
              (fun id _ acc -> if S.Iset.mem id ids then acc else S.Iset.add id acc)
              t.finger.profiles S.Iset.empty
        | None ->
            match finger_find ~login:"vicuna" t.finger with
            | None -> S.Iset.empty
            | Some p -> S.Iset.singleton p.id
      in
      fill_max ~ignored_users t;
      set_activity_scores t;
      Lwt.return t

    let profiles t = t.finger.profiles
    let profile_opt t id = S.Imap.find_opt id t.finger.profiles
    let with_profiles t profiles = { t with finger = { t.finger with profiles } }
    let profile t id =
      match profile_opt t id with
      | None -> failwith (Printf.sprintf "Profile %d not found" id)
      | Some p -> p

    let user_above_thresholds dated t =
      S.Imap.cardinal dated.reviewer_of >= t.th_reviewer &&
        S.Imap.cardinal dated.reviewed_by >= t.th_reviewed &&
        S.Iset.cardinal dated.issues >= t.th_issues &&
        S.Sset.cardinal dated.commits >= t.th_commits

    let group_profiles_in_period period group pred profiles =
      let dated = get_dated group period in
      let (gids,profiles) =
        S.Imap.fold (fun id p (acc,profiles) ->
           if pred p then
             (
              Option.iter (fun src -> merge_dated ~dst:dated ~src) (opt_dated p period);
              (S.Iset.add id acc, S.Imap.remove id profiles)
             )
           else
             (acc,profiles)
        ) profiles (S.Iset.empty,profiles)
      in
      let filter id _ = not (S.Iset.mem id gids) in
      dated.reviewed_by <- S.Imap.filter filter dated.reviewed_by;
      dated.reviewer_of <- S.Imap.filter filter dated.reviewer_of;
      dated.reviewed_by_shared <- S.Imap.filter filter dated.reviewed_by_shared;
      dated.reviewer_of_shared <- S.Imap.filter filter dated.reviewer_of_shared;
      let map_id id = if S.Iset.mem id gids then group.id else id in
      let map = S.Imap.fold
        (fun id v acc ->
           let mid = map_id id in
           match S.Imap.find_opt mid acc with
           | None -> S.Imap.add mid v acc
           | Some v2 -> S.Imap.add mid (v+.v2) acc)
      in
      S.Imap.iter (fun _id user ->
         match opt_dated user period with
         | None -> ()
           | Some d ->
             d.reviewed_by <- map d.reviewed_by S.Imap.empty ;
             d.reviewer_of <- map d.reviewer_of S.Imap.empty ;
             d.reviewed_by_shared <- map d.reviewed_by_shared S.Imap.empty ;
             d.reviewer_of_shared <- map d.reviewer_of_shared S.Imap.empty ;
      ) profiles;
      profiles

    let compare_group_membership_period p1 p2 =
      match p1.start, p1.stop, p2.start, p2.stop with
      | None, None, None, None -> 0
      | None, None, None, _ -> 1
      | None, _, None, None -> -1
      | None, Some s1, None, Some s2 -> Ptime.compare s1 s2
      | Some _, _, None, _ -> 1
      | None, _, Some _, _ -> -1
      | Some s1, _, Some s2, _ ->
          match Ptime.compare s1 s2 with
          | 0 ->
              (match p1.stop, p2.stop with
               | None, None -> 0
               | Some _, None -> -1
               | None, Some _ -> 1
               | Some s1, Some s2 -> Ptime.compare s1 s2
              )
          | n -> n

    let date_in_period date p =
      match p.start, p.stop with
      | None, None -> true
      | Some d, None -> Ptime.compare d date <= 0
      | None, Some d -> Ptime.compare date d <= 0
      | Some d1, Some d2 ->
          Ptime.compare d1 date <= 0 &&
            Ptime.compare date d2 <= 0

    let mk_dummy_gh_full_user =
      let cpt = ref 0 in
      fun name -> incr cpt;
        let login = Printf.sprintf "__dummy_%d" !cpt in
        { GH.Types.default_full_user with login ; name = Some name }

    let mk_group t acc_map_date name g =
      Log.info (fun m -> m "Creating group %S with %s"
         name (String.concat ", " ((List.map fst (S.Smap.bindings g.members)))));
      let g_profiles = S.Smap.fold
        (fun login periods acc ->
           let periods = List.sort compare_group_membership_period periods in
           match finger_find ~login t.finger with
           | None -> (*FIXME: exception is lost ?? *)
               failwith (Printf.sprintf "Group %S: no user %S" name login)
           | Some p ->
               let periods = match periods with [] -> [{start=None;stop=None}] | l -> l in
               S.Imap.add p.id (p, periods) acc
        )
          g.members (S.Imap.empty)
      in
      let gh_user =
        match g.gh_account with
        | None -> mk_dummy_gh_full_user name
        | Some u -> u
      in
      let group = new_profile ~kind:(Group g_profiles) ~gh_user name in
      let map_date = S.Imap.fold
        (fun _id (p,periods) acc ->
           let by_period = List.map (fun p -> (p, group.id)) periods in
           let by_period =
             match S.Imap.find_opt p.id acc_map_date with
             | None -> by_period
             | Some l -> l @ by_period
           in
           let by_period = List.sort
             (fun (p1,_) (p2,_) -> compare_group_membership_period p1 p2)
               by_period
           in
           S.Imap.add p.id by_period acc
        )
          g_profiles acc_map_date
      in
      let finger = finger_add t.finger group in
      (group, { t with finger }, map_date)

    let make_groups ?events t groups =
      let t = dup t in
      let f name group (gids,t,map_date) =
        let (g, t, map_date) = mk_group t map_date name group in
        Log.info (fun m -> m "Group %S created (id=%d)" name g.id);
        (S.Iset.add g.id gids, t, map_date)
      in
      let (gids,t,map_date) = S.Smap.fold f groups (S.Iset.empty, t, S.Imap.empty) in
      let group_other =
        let name = "Other" in
        new_profile
        ~kind:(Group S.Imap.empty)
          ~gh_user:(mk_dummy_gh_full_user name)
          name
      in
      let gids = S.Iset.add group_other.id gids in
      let t =
        let finger = finger_add t.finger group_other in
        { t with finger }
      in
      let group_of_period =
        let f date (period, _gid) = date_in_period date period in
        fun date -> List.find_opt (f date)
      in
      let map_by_date date profile =
        match S.Imap.find_opt profile.id map_date with
        | None -> group_other
        | Some periods ->
            match group_of_period date periods with
            | None -> group_other
            | Some (_,gid) -> S.Imap.find gid t.finger.profiles
      in
      let finger = { t.finger with map_by_date = Some map_by_date } in
      let%lwt t = create ?events ~repo_name:t.repo_name
        ~finger:(finger,gids) ?changelog:t.orig_changelog
          t.get_gh_user t.orig_issues t.orig_commits
      in
      Log.info (fun m -> m "Data with %d profiles (groups) created" (S.Imap.cardinal t.finger.profiles));
      Lwt.return t
(*
fill_max t;
      set_activity_scores t;
      t*)

    let group_profiles thresholds data =
      let data = dup data in
      let by_id = data.finger.profiles in
      let g = new_profile "Community" in
      let f period _ =
        let dated = get_dated g period in
        let (gids,by_id) =
          S.Imap.fold (fun id user (acc,by_id) ->
             match opt_dated user period with
             | None ->
                 (S.Iset.add id acc, S.Imap.remove id by_id)
             | Some src ->
                 if not (user_above_thresholds src thresholds) then
                   (
                    merge_dated ~dst:dated ~src;
                    (S.Iset.add id acc, S.Imap.remove id by_id)
                   )
                 else
                   (
                    (*Log.info (fun m -> m "group_profiles period=%a user %s (%d) is above thresolds"
                     S.Period.pp period user.name id);*)
                    (acc,by_id)
                    )
          ) by_id (S.Iset.empty,by_id)
        in
        let filter id _ = not (S.Iset.mem id gids) in
        dated.reviewed_by <- S.Imap.filter filter dated.reviewed_by;
        dated.reviewer_of <- S.Imap.filter filter dated.reviewer_of;
        dated.reviewed_by_shared <- S.Imap.filter filter dated.reviewed_by_shared;
        dated.reviewer_of_shared <- S.Imap.filter filter dated.reviewer_of_shared;
        let map_id id = if S.Iset.mem id gids then g.id else id in
        let map = S.Imap.fold
          (fun id v acc ->
             let mid = map_id id in
             match S.Imap.find_opt mid acc with
             | None -> S.Imap.add mid v acc
             | Some v2 -> S.Imap.add mid (v+.v2) acc)
        in
        S.Imap.iter (fun _id user ->
           match opt_dated user period with
           | None -> ()
           | Some d ->
               d.reviewed_by <- map d.reviewed_by S.Imap.empty ;
               d.reviewer_of <- map d.reviewer_of S.Imap.empty ;
               d.reviewed_by_shared <- map d.reviewed_by_shared S.Imap.empty ;
               d.reviewer_of_shared <- map d.reviewer_of_shared S.Imap.empty ;
        ) by_id;
        let by_id = S.Imap.add g.id g by_id in
        by_id
      in
      let by_period = Period.Map.mapi f data.stats in
(* fIXME: add group to finger *)
      by_period

    let dot_review ~title ?profile_link ~file ?output_type ~directed by_id =
      let unquote = String.map (function '"' -> ' ' | c -> c) in
      let dot = S.Dot.create ~directed ~rankdir:`TB() in
      let p fmt = S.Dot.p dot fmt in
      (* compute average review before grouping, or community will distort it *)
      let avg_review =
        let sum = S.Imap.fold (fun _ user acc ->
             S.Imap.cardinal (get_dated user Period.All).reviewer_of + acc) by_id 0
        in
        float sum /. float (S.Imap.cardinal by_id)
      in
      p "overlap=prism;\nlabel=\"%s\";\n" title;
      let by_id = S.Imap.filter (fun _ user ->
           let d = get_dated user Period.All in
           not (S.Imap.is_empty d.reviewer_of
            && S.Imap.is_empty d.reviewed_by)) by_id
      in
      S.Imap.iter (fun id (user:profile) ->
         let nid = Printf.sprintf "u%d" id in
         let dated = get_dated user Period.All in
         let more = Printf.sprintf "label=\"%s\" penwidth=%.2f"
           (unquote user.name)
           (float (S.Imap.cardinal dated.reviewer_of) /. avg_review)
         in
         let more = match profile_link with
           | None -> more
           | Some f -> Printf.sprintf "%s href=\"%s\"" more (f user)
         in
         p "%s" (dot_node_decl dated ~more nid) ;
         S.Imap.iter (fun rev_id v ->
            let edge =
              match directed with
              | true -> Some (v, "->")
              | false when id < rev_id ->
                  let rev = S.Imap.find rev_id by_id in
                  let v2 = Option.value ~default:0.
                    (S.Imap.find_opt id (get_dated rev Period.All).reviewer_of) in
                  let v = v +. v2 in
                  Some (v, "--")
              | false -> None
            in
            match edge with
            | Some (v, arrow) ->
                p "%s %s %s [color=\"%s\" penwidth=%.2f weight=%d];\n"
                  nid arrow (Printf.sprintf "u%d" rev_id)
                  (S.Dot.random_color())
                  (min 10. v) (truncate v)
            | None -> ()
         ) dated.reviewer_of
      ) by_id;
      (* add some kind of legend for subsystems's colors *)
      p "subgraph cluster_legend {label=\"Subsystems\";\n";
      let leg_id = ref 0 in
      List.iter (fun s ->
         incr leg_id;
         p "legend%d [label=%S shape=\"box\" style=\"filled\" fillcolor=%S];\n"
           !leg_id (Subs.to_string s) (Subs.to_dot_color s);
      ) Subs.list;
      p "}\n";
      S.Dot.run ?type_:output_type ~outfile:file dot
  end