Refactor: Bring over additional types from Onivim 2

src/Client.re

@@ -35,8 +35,7 @@ let start =
         Log.info("Ready");
 
         incr(lastRequestId);
-        let requestId = lastRequestId^;
-        send(Outgoing.Initialize({requestId, initData}));
+        send(Outgoing.Initialize({requestId: lastRequestId^, initData}));
         handler(Ready) |> ignore;
 
       | Incoming.Initialized =>
@@ -46,10 +45,9 @@ let start =
           "ExtHostConfiguration" |> Handlers.stringToId |> Option.get;
 
         incr(lastRequestId);
-        let requestId = lastRequestId^;
         send(
           Outgoing.RequestJSONArgs({
-            requestId,
+            requestId: lastRequestId^,
             rpcId,
             method: "$initializeConfiguration",
             args:
@@ -62,11 +60,10 @@ let start =
         handler(Initialized) |> ignore;
 
         incr(lastRequestId);
-        let requestId = lastRequestId^;
         let rpcId = "ExtHostWorkspace" |> Handlers.stringToId |> Option.get;
         send(
           Outgoing.RequestJSONArgs({
-            requestId,
+            requestId: lastRequestId^,
             rpcId,
             method: "$initializeWorkspace",
             args: `List([]),

src/Core/KeyedStringMap.re

@@ -0,0 +1,24 @@
+module Key: {
+  type t =
+    pri {
+      hash: int,
+      name: string,
+    };
+  let compare: (t, t) => int;
+  let create: string => t;
+} = {
+  type t = {
+    hash: int,
+    name: string,
+  };
+
+  let compare = (a, b) =>
+    a.hash == b.hash ? compare(a.name, b.name) : compare(a.hash, b.hash);
+
+  let create = name => {hash: Hashtbl.hash(name), name};
+};
+
+include Map.Make(Key);
+
+let key = Key.create;
+let keyName = (key: key) => key.name;

src/Core/KeyedStringMap.rei

@@ -0,0 +1,39 @@
+type key;
+let key: string => key;
+let keyName: key => string;
+
+type t(+'a);
+
+let empty: t('a);
+let is_empty: t('a) => bool;
+
+let mem: (key, t('a)) => bool;
+let add: (key, 'a, t('a)) => t('a);
+let update: (key, option('a) => option('a), t('a)) => t('a);
+let remove: (key, t('a)) => t('a);
+let merge:
+  ((key, option('a), option('b)) => option('c), t('a), t('b)) => t('c);
+let union: ((key, 'a, 'a) => option('a), t('a), t('a)) => t('a);
+
+let compare: (('a, 'a) => int, t('a), t('a)) => int;
+let equal: (('a, 'a) => bool, t('a), t('a)) => bool;
+
+let iter: ((key, 'a) => unit, t('a)) => unit;
+let fold: ((key, 'a, 'b) => 'b, t('a), 'b) => 'b;
+
+let for_all: ((key, 'a) => bool, t('a)) => bool;
+let exists: ((key, 'a) => bool, t('a)) => bool;
+
+let filter: ((key, 'a) => bool, t('a)) => t('a);
+let partition: ((key, 'a) => bool, t('a)) => (t('a), t('a));
+
+let find_opt: (key, t('a)) => option('a);
+let find_first_opt: (key => bool, t('a)) => option((key, 'a));
+let find_last_opt: (key => bool, t('a)) => option((key, 'a));
+
+let map: ('a => 'b, t('a)) => t('b);
+let mapi: ((key, 'a) => 'b, t('a)) => t('b);
+
+let to_seq: t('a) => Seq.t((key, 'a));
+let add_seq: (Seq.t((key, 'a)), t('a)) => t('a);
+let of_seq: Seq.t((key, 'a)) => t('a);

src/Core/KeyedStringTree.re

@@ -0,0 +1,4 @@
+include KeyedTree.Make(String);
+
+let path = String.split_on_char('.');
+let key = String.concat(".");

src/Core/KeyedStringTree.rei

@@ -0,0 +1,4 @@
+include KeyedTree.S with type key = string;
+
+let path: string => path;
+let key: path => string;

src/Core/KeyedTree.re

@@ -0,0 +1,179 @@
+module type OrderedType = Map.OrderedType;
+
+module type S = {
+  type key;
+  type path = list(key);
+  module KeyedMap: Map.S with type key := key;
+  type t('a) =
+    | Node(KeyedMap.t(t('a)))
+    | Leaf('a);
+
+  let empty: t(_);
+
+  let fromList: list((path, 'a)) => t('a);
+
+  let add: (path, 'a, t('a)) => t('a);
+  let get: (path, t('a)) => option('a);
+
+  let merge:
+    ((path, option('a), option('b)) => option('c), t('a), t('b)) => t('c);
+  let union: ((path, 'a, 'a) => option('a), t('a), t('a)) => t('a);
+  let map: ('a => 'b, t('a)) => t('b);
+  let fold: ((path, 'a, 'b) => 'b, t('a), 'b) => 'b;
+};
+
+module Make = (Ord: OrderedType) => {
+  type key = Ord.t;
+  type path = list(key);
+  module KeyedMap = Map.Make(Ord);
+  type t('a) =
+    | Node(KeyedMap.t(t('a)))
+    | Leaf('a);
+
+  let empty = Node(KeyedMap.empty);
+
+  let rec update = (path, value: option('a), node: t('a)) => {
+    switch (path) {
+    | [] => node
+
+    | [key] =>
+      switch (node) {
+      | Node(children) =>
+        Node(
+          KeyedMap.update(
+            key,
+            fun
+            | None => Option.map(value => Leaf(value), value)
+            | Some(Leaf(_)) => Option.map(value => Leaf(value), value) // duplicate, override existing value
+            | Some(Node(_)) as node => node, // ignore if internal node, NOTE: lossy
+            children,
+          ),
+        )
+      | Leaf(_) =>
+        switch (value) {
+        | Some(value) => Node(KeyedMap.singleton(key, Leaf(value)))
+        | None => Node(KeyedMap.empty)
+        }
+      }
+
+    | [key, ...rest] =>
+      switch (node) {
+      | Node(children) =>
+        let newChildren =
+          KeyedMap.update(
+            key,
+            fun
+            | Some(Node(_) as child) => Some(update(rest, value, child))
+            | None
+            | Some(Leaf(_)) => Some(update(rest, value, empty)), // override leaf, NOTE: lossy
+            children,
+          );
+
+        Node(newChildren);
+
+      | Leaf(_) =>
+        // override leaf, NOTE: lossy
+        let child = update(rest, value, empty);
+        Node(KeyedMap.singleton(key, child));
+      }
+    };
+  };
+
+  let add = (keys, value) => update(keys, Some(value));
+
+  let fromList = entries =>
+    List.fold_left(
+      (acc, (key, value)) => add(key, value, acc),
+      empty,
+      entries,
+    );
+
+  let rec get = (path, node) =>
+    switch (path, node) {
+    | ([], Leaf(value)) => Some(value)
+    | ([key, ...rest], Node(children)) =>
+      switch (KeyedMap.find_opt(key, children)) {
+      | Some(child) => get(rest, child)
+      | None => None
+      }
+    | _ => None
+    };
+
+  let merge = (f, a, b) => {
+    let f = (path, a, b) =>
+      Option.map(value => Leaf(value), f(path, a, b));
+
+    let rec aux = (path, a, b) =>
+      switch (a, b) {
+      | (Leaf(a), Leaf(b)) => f(path, Some(a), Some(b))
+      | (Node(_), Leaf(b)) => f(path, None, Some(b))
+      | (Leaf(a), Node(_)) => f(path, Some(a), None)
+      | (Node(aChildren), Node(bChildren)) =>
+        let merged =
+          KeyedMap.merge(
+            (key, a, b) => {
+              let path = [key, ...path];
+              switch (a, b) {
+              | (Some(a), Some(b)) => aux(path, a, b)
+              | (None, Some(b)) => aux(path, empty, b)
+              | (Some(a), None) => aux(path, a, empty)
+              | (None, None) => failwith("unreachable")
+              };
+            },
+            aChildren,
+            bChildren,
+          );
+
+        if (merged == KeyedMap.empty) {
+          None;
+        } else {
+          Some(Node(merged));
+        };
+      };
+
+    aux([], a, b) |> Option.value(~default=empty);
+  };
+
+  let union = f => {
+    let rec aux = (f, path, a, b) =>
+      switch (a, b) {
+      | (Leaf(_), Leaf(b)) => Leaf(b) // duplicate, override a with b
+      | (Node(_), Leaf(_)) => a // Node always wins, NOTE: lossy
+      | (Leaf(_), Node(_)) => b // Node always wins, NOTE: lossy
+      | (Node(aChildren), Node(bChildren)) =>
+        // merge children
+        let merged =
+          KeyedMap.union(
+            (key, a, b) => {
+              let path = [key, ...path];
+              Some(aux(f, path, a, b));
+            },
+            aChildren,
+            bChildren,
+          );
+        Node(merged);
+      };
+
+    aux(f, []);
+  };
+
+  let rec map = f =>
+    fun
+    | Leaf(value) => Leaf(f(value))
+    | Node(children) => Node(KeyedMap.map(map(f), children));
+
+  let fold = (f, node, initial) => {
+    let rec traverse = (node, revPath, acc) =>
+      switch (node) {
+      | Leaf(value) => f(List.rev(revPath), value, acc)
+      | Node(children) =>
+        KeyedMap.fold(
+          (key, node, acc) => traverse(node, [key, ...revPath], acc),
+          children,
+          acc,
+        )
+      };
+
+    traverse(node, [], initial);
+  };
+};

src/Core/dune

@@ -0,0 +1,6 @@
+(library
+    (name Core)
+    (public_name vscode-exthost.core)
+    (library_flags (-linkall))
+    (libraries luv yojson decoders-yojson)
+    (preprocess (pps ppx_deriving.show ppx_deriving_yojson)))

src/Core/keyedTree.rei

@@ -0,0 +1,25 @@
+module type OrderedType = Map.OrderedType;
+
+module type S = {
+  type key;
+  type path = list(key);
+  module KeyedMap: Map.S with type key := key;
+  type t('a) =
+    | Node(KeyedMap.t(t('a)))
+    | Leaf('a);
+
+  let empty: t(_);
+
+  let fromList: list((path, 'a)) => t('a);
+
+  let add: (path, 'a, t('a)) => t('a);
+  let get: (path, t('a)) => option('a);
+
+  let merge:
+    ((path, option('a), option('b)) => option('c), t('a), t('b)) => t('c);
+  let union: ((path, 'a, 'a) => option('a), t('a), t('a)) => t('a);
+  let map: ('a => 'b, t('a)) => t('b);
+  let fold: ((path, 'a, 'b) => 'b, t('a), 'b) => 'b;
+};
+
+module Make: (Ord: OrderedType) => S with type key = Ord.t;