<commit_before>(* Copyright (C) 2015, <NAME>
 * See the README file for details. *)

open Lwt

open Ck_sigs
open Ck_utils

module Make(Clock : Ck_clock.S)(I : Irmin.BASIC with type key = string list and type value = string) = struct
  module R = Ck_rev.Make(I)
  module Node = R.Node
  module Up = Ck_update.Make(I)(R)

  module TreeNode = struct
    module Id_map = Ck_id.M
    module Sort_key = struct
      type t =
        | Item of Sort_key.t
        | Group of string
      module Id = struct
        type t =
          | Item of Ck_id.t
          | Group of string
        let compare = compare
      end
      let compare a b =
        match a, b with
        | Item _, Group _ -> 1
        | Group _, Item _ -> -1
        | Item a, Item b -> Sort_key.compare a b
        | Group a, Group b -> String.compare a b
      let show = function
        | Item a -> Sort_key.show a
        | Group s -> s
      let id = function
        | Item a -> Id.Item (Sort_key.id a)
        | Group s -> Id.Group s
    end
    module Child_map = Map.Make(Sort_key)

    module Item = struct
      include Node    (* We reuse Node.t, but ignore its children *)

      let equal  = Node.equal_excl_children
      let show = name
      let id = Node.uuid
    end

    type t = {
      item : [`Item of Node.generic | `Group of string];
      children : t Child_map.t;
    }

    let sort_key t =
      match t.item with
      | `Item i -> Sort_key.Item (R.Node.key i)
      | `Group g -> Sort_key.Group g

    let item t =
      match t.item with
      | `Item node -> `Item (Item.id node, node)
      | `Group _ as g -> g

    let children t = t.children

    let leaf_of_node n = {
      item = `Item n;
      children = Child_map.empty;
    }

    type move_data = int
  end
  module WidgetTree = Reactive_tree.Make(Clock)(TreeNode)

  module Item = TreeNode.Item
  module Widget = WidgetTree.Widget

  type tree_view =
    [ `Process of Widget.t ReactiveData.RList.t
    | `Work of Widget.t ReactiveData.RList.t
    | `Sync of (float * string) list React.S.t
    | `Contact of unit
    | `Review of unit
    | `Schedule of unit ]

  type details = {
    details_item : Item.generic option React.S.t;
    details_children : Widget.t ReactiveData.RList.t;
    details_stop : stop;
  }

  type t = {
    master : Up.t;
    mutable r : R.t;
    tree : tree_view React.S.t;
    set_tree : tree_view -> unit;
    mutable details : (details * (R.t -> unit)) Ck_id.M.t;
    mutable update_tree : R.t -> unit;
    mutable keep_me : unit React.S.t list;
  }

  type 'a full_node = 'a Node.t

  let assume_changed _ _ = false

  let add details t ?parent ~name ~description =
    let parent =
      match parent with
      | None -> `Toplevel t.r
      | Some p -> `Node p in
    Up.add t.master details ~parent ~name ~description >|= fun id ->
    R.get t.r id

  let add_action = add (`Action {Ck_sigs.astate = `Next; astarred = false})
  let add_project = add (`Project {Ck_sigs.pstate = `Active; pstarred = false})
  let add_area = add `Area

  let delete t node =
    Up.delete t.master node

  let set_name t item name =
    Up.set_name t.master item name

  let set_action_state t item state =
    Up.set_action_state t.master item state

  let set_project_state t item state =
    Up.set_project_state t.master item state

  let set_starred t item s =
    Up.set_starred t.master item s

  let make_full_tree r =
    let rec aux items =
      M.fold (fun key item acc ->
        let value =
          { TreeNode.item = `Item item;
            children = aux (Node.child_nodes item) } in
        acc |> TreeNode.Child_map.add (TreeNode.Sort_key.Item key) value
      ) items TreeNode.Child_map.empty in
    aux (R.roots r)

  let make_process_tree = make_full_tree

  let collect_next_actions r =
    let results = ref TreeNode.Child_map.empty in
    let rec scan nodes =
      let child_actions = ref TreeNode.Child_map.empty in
      nodes |> M.iter (fun _k node ->
        match Node.ty node with
        | `Area parent | `Project parent ->
            let actions = Node.child_nodes parent |> scan in
            if not (TreeNode.Child_map.is_empty actions) then (
              let tree_node = { TreeNode.
                item = `Item parent;
                children = actions;
              } in
              results := !results |> TreeNode.Child_map.add (TreeNode.sort_key tree_node) tree_node;
            )
        | `Action action ->
            if Node.action_state action = `Next then (
              let item = TreeNode.leaf_of_node action in
              child_actions := !child_actions |> TreeNode.Child_map.add (TreeNode.sort_key item) item
            )
      );
      !child_actions
    in
    let root_actions = scan (R.roots r) in
    if not (TreeNode.Child_map.is_empty root_actions) then (
      let no_project = { TreeNode.item = `Group "(no project)"; children = root_actions } in
      results := !results |> TreeNode.Child_map.add (TreeNode.sort_key no_project) no_project;
    );
    !results

  let opt_node_equal a b =
    match a, b with
    | None, None -> true
    | Some a, Some b -> R.Node.equal a b
    | _ -> false

  (* todo *)
  let group_by_type child_nodes =
    let tree_nodes = ref TreeNode.Child_map.empty in
    child_nodes |> M.iter (fun k v ->
      tree_nodes := !tree_nodes |> TreeNode.Child_map.add (TreeNode.Sort_key.Item k) (TreeNode.leaf_of_node v)
    );
    !tree_nodes

  let details t initial_node =
    let initial_node = (initial_node :> Node.generic) in
    let uuid = Node.uuid initial_node in
    try fst (Ck_id.M.find uuid t.details)
    with Not_found ->
      (* Note: initial_node may already be out-of-date *)
      match R.get t.r (Node.uuid initial_node) with
      | None -> { details_item = React.S.const None; details_children = ReactiveData.RList.empty; details_stop = ignore }
      | Some initial_node ->
      let child_nodes node = Node.child_nodes node |> group_by_type in
      let children = WidgetTree.make (child_nodes initial_node) in<commit_msg>TreeNode.add helper<commit_after>(* Copyright (C) 2015, <NAME>
 * See the README file for details. *)

open Lwt

open Ck_sigs
open Ck_utils

module Make(Clock : Ck_clock.S)(I : Irmin.BASIC with type key = string list and type value = string) = struct
  module R = Ck_rev.Make(I)
  module Node = R.Node
  module Up = Ck_update.Make(I)(R)

  module TreeNode = struct
    module Id_map = Ck_id.M
    module Sort_key = struct
      type t =
        | Item of Sort_key.t
        | Group of string
      module Id = struct
        type t =
          | Item of Ck_id.t
          | Group of string
        let compare = compare
      end
      let compare a b =
        match a, b with
        | Item _, Group _ -> 1
        | Group _, Item _ -> -1
        | Item a, Item b -> Sort_key.compare a b
        | Group a, Group b -> String.compare a b
      let show = function
        | Item a -> Sort_key.show a
        | Group s -> s
      let id = function
        | Item a -> Id.Item (Sort_key.id a)
        | Group s -> Id.Group s
    end
    module Child_map = Map.Make(Sort_key)

    module Item = struct
      include Node    (* We reuse Node.t, but ignore its children *)

      let equal  = Node.equal_excl_children
      let show = name
      let id = Node.uuid
    end

    type t = {
      item : [`Item of Node.generic | `Group of string];
      children : t Child_map.t;
    }

    let sort_key t =
      match t.item with
      | `Item i -> Sort_key.Item (R.Node.key i)
      | `Group g -> Sort_key.Group g

    let add item map =
      map |> Child_map.add (sort_key item) item

    let item t =
      match t.item with
      | `Item node -> `Item (Item.id node, node)
      | `Group _ as g -> g

    let children t = t.children

    let leaf_of_node n = {
      item = `Item n;
      children = Child_map.empty;
    }

    type move_data = int
  end
  module WidgetTree = Reactive_tree.Make(Clock)(TreeNode)

  module Item = TreeNode.Item
  module Widget = WidgetTree.Widget

  type tree_view =
    [ `Process of Widget.t ReactiveData.RList.t
    | `Work of Widget.t ReactiveData.RList.t
    | `Sync of (float * string) list React.S.t
    | `Contact of unit
    | `Review of unit
    | `Schedule of unit ]

  type details = {
    details_item : Item.generic option React.S.t;
    details_children : Widget.t ReactiveData.RList.t;
    details_stop : stop;
  }

  type t = {
    master : Up.t;
    mutable r : R.t;
    tree : tree_view React.S.t;
    set_tree : tree_view -> unit;
    mutable details : (details * (R.t -> unit)) Ck_id.M.t;
    mutable update_tree : R.t -> unit;
    mutable keep_me : unit React.S.t list;
  }

  type 'a full_node = 'a Node.t

  let assume_changed _ _ = false

  let add details t ?parent ~name ~description =
    let parent =
      match parent with
      | None -> `Toplevel t.r
      | Some p -> `Node p in
    Up.add t.master details ~parent ~name ~description >|= fun id ->
    R.get t.r id

  let add_action = add (`Action {Ck_sigs.astate = `Next; astarred = false})
  let add_project = add (`Project {Ck_sigs.pstate = `Active; pstarred = false})
  let add_area = add `Area

  let delete t node =
    Up.delete t.master node

  let set_name t item name =
    Up.set_name t.master item name

  let set_action_state t item state =
    Up.set_action_state t.master item state

  let set_project_state t item state =
    Up.set_project_state t.master item state

  let set_starred t item s =
    Up.set_starred t.master item s

  let make_full_tree r =
    let rec aux items =
      M.fold (fun key item acc ->
        let value =
          { TreeNode.item = `Item item;
            children = aux (Node.child_nodes item) } in
        acc |> TreeNode.Child_map.add (TreeNode.Sort_key.Item key) value
      ) items TreeNode.Child_map.empty in
    aux (R.roots r)

  let make_process_tree = make_full_tree

  let collect_next_actions r =
    let results = ref TreeNode.Child_map.empty in
    let rec scan nodes =
      let child_actions = ref TreeNode.Child_map.empty in
      nodes |> M.iter (fun _k node ->
        match Node.ty node with
        | `Area parent | `Project parent ->
            let actions = Node.child_nodes parent |> scan in
            if not (TreeNode.Child_map.is_empty actions) then (
              let tree_node = { TreeNode.
                item = `Item parent;
                children = actions;
              } in
              results := !results |> TreeNode.add tree_node;
            )
        | `Action action ->
            if Node.action_state action = `Next then (
              let item = TreeNode.leaf_of_node action in
              child_actions := !child_actions |> TreeNode.add item
            )
      );
      !child_actions
    in
    let root_actions = scan (R.roots r) in
    if not (TreeNode.Child_map.is_empty root_actions) then (
      let no_project = { TreeNode.item = `Group "(no project)"; children = root_actions } in
      results := !results |> TreeNode.add no_project;
    );
    !results

  let opt_node_equal a b =
    match a, b with
    | None, None -> true
    | Some a, Some b -> R.Node.equal a b
    | _ -> false

  (* todo *)
  let group_by_type child_nodes =
    let tree_nodes = ref TreeNode.Child_map.empty in
    child_nodes |> M.iter (fun _k v ->
      let item = TreeNode.leaf_of_node v in
      tree_nodes := !tree_nodes |> TreeNode.add item
    );
    !tree_nodes

  let details t initial_node =
    let initial_node = (initial_node :> Node.generic) in
    let uuid = Node.uuid initial_node in
    try fst (Ck_id.M.find uuid t.details)
    with Not_found ->
      (* Note: initial_node may already be out-of-date *)
      match R.get t.r (Node.uuid initial_node) with
      | None -> { details_item = React.S.const None; details_children = ReactiveData.RList.empty; details_stop = ignore }
      | Some initial_node ->
      let child_nodes node = Node.child_nodes node |> group_by_type in
      let children = WidgetTree.make (child_nodes initial_node) in
{'fraction_non_alphanumeric': 0.09318428297322098, 'fraction_numerical': 0.0010010845082172354, 'mean_word_length': 2.121875, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 86, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5161529', 'n_tokens_mistral': 3950, 'n_tokens_neox': 3884, 'n_words': 1241}