From 7e79416343f974125949dd19edcb6f8b67d3d956 Mon Sep 17 00:00:00 2001 From: Sora Morimoto Date: Thu, 19 Dec 2024 02:10:39 +0900 Subject: [PATCH] Chores Signed-off-by: Sora Morimoto --- .github/workflows/workflow.yml | 27 +- .gitignore | 8 +- .merlin | 5 - .ocamlformat | 3 + dune-project | 18 +- reactiveData.opam | 34 +- src/dune | 7 +- src/reactiveData.ml | 799 ++++++++++++++++----------------- src/reactiveData.mli | 229 +++++----- 9 files changed, 541 insertions(+), 589 deletions(-) delete mode 100644 .merlin create mode 100644 .ocamlformat diff --git a/.github/workflows/workflow.yml b/.github/workflows/workflow.yml index ec31cb7..7ee1659 100644 --- a/.github/workflows/workflow.yml +++ b/.github/workflows/workflow.yml @@ -1,4 +1,4 @@ -name: Main workflow +name: Builds, tests & co on: pull_request: @@ -13,12 +13,12 @@ jobs: fail-fast: false matrix: os: - - macos-latest - ubuntu-latest + - macos-latest - windows-latest ocaml-compiler: - - "4.14" - - "5.2" + - 5 + - 4 include: - os: ubuntu-latest ocaml-compiler: "4.08" @@ -45,23 +45,30 @@ jobs: steps: - name: Checkout tree uses: actions/checkout@v4 - - name: Set-up OCaml uses: ocaml/setup-ocaml@v3 with: - ocaml-compiler: "4.14" - + ocaml-compiler: 5 - uses: ocaml/setup-ocaml/lint-doc@v3 - lint-opam: + lint-fmt: runs-on: ubuntu-latest steps: - name: Checkout tree uses: actions/checkout@v4 - - name: Set-up OCaml uses: ocaml/setup-ocaml@v3 with: - ocaml-compiler: "4.14" + ocaml-compiler: 5 + - uses: ocaml/setup-ocaml/lint-fmt@v3 + lint-opam: + runs-on: ubuntu-latest + steps: + - name: Checkout tree + uses: actions/checkout@v4 + - name: Set-up OCaml + uses: ocaml/setup-ocaml@v3 + with: + ocaml-compiler: 5 - uses: ocaml/setup-ocaml/lint-opam@v3 diff --git a/.gitignore b/.gitignore index 6ca76e1..ba65b13 100644 --- a/.gitignore +++ b/.gitignore @@ -1,7 +1 @@ -_build -*~ -\#*# -.#* -reactiveData.install -api.docdir -doc/html +/_build/ diff --git a/.merlin b/.merlin deleted file mode 100644 index 468fe6b..0000000 --- a/.merlin +++ /dev/null @@ -1,5 +0,0 @@ -S src/* -B _build/* - -PKG react -FLG -warn A-4-40-42-44-48 diff --git a/.ocamlformat b/.ocamlformat new file mode 100644 index 0000000..d20e3da --- /dev/null +++ b/.ocamlformat @@ -0,0 +1,3 @@ +version=0.27.0 +profile=conventional +parse-docstrings=true diff --git a/dune-project b/dune-project index 6dc7f83..60a6477 100644 --- a/dune-project +++ b/dune-project @@ -1,2 +1,18 @@ -(lang dune 1.0) +(lang dune 3.17) (name reactiveData) + +(generate_opam_files true) + +(maintainers "Ocsigen team ") +(authors "Hugo Heuzard ") +(license "LGPL-3.0-or-later WITH OCaml-LGPL-linking-exception") +(source (github ocsigen/reactiveData)) + +(package + (name reactiveData) + (synopsis "Declarative events and signals for OCaml") + (description "React is an OCaml module for functional reactive programming (FRP). It provides support to program with time varying values : declarative events and signals. React doesn't define any primitive event or signal, it lets the client chooses the concrete timeline.") + (tags ("reactive" "declarative" "signal" "event" "frp")) + (depends + (ocaml (>= 4.08)) + (react (and (>= 1.2.1) (< 1.3))))) diff --git a/reactiveData.opam b/reactiveData.opam index ce1c785..c916a64 100644 --- a/reactiveData.opam +++ b/reactiveData.opam @@ -1,24 +1,32 @@ +# This file is generated by dune, edit dune-project instead opam-version: "2.0" synopsis: "Declarative events and signals for OCaml" -description: "React is an OCaml module for functional reactive programming (FRP). It provides support to program with time varying values : declarative events and signals. React doesn't define any primitive event or signal, it lets the client chooses the concrete timeline." -maintainer: "dev@ocsigen.org" +description: + "React is an OCaml module for functional reactive programming (FRP). It provides support to program with time varying values : declarative events and signals. React doesn't define any primitive event or signal, it lets the client chooses the concrete timeline." +maintainer: ["Ocsigen team "] authors: ["Hugo Heuzard "] +license: "LGPL-3.0-or-later WITH OCaml-LGPL-linking-exception" +tags: ["reactive" "declarative" "signal" "event" "frp"] homepage: "https://github.com/ocsigen/reactiveData" -dev-repo: "git+https://github.com/ocsigen/reactiveData.git" bug-reports: "https://github.com/ocsigen/reactiveData/issues" - -doc:"http://ocsigen.github.io/reactiveData/dev/" - -tags: [ "reactive" "declarative" "signal" "event" "frp" ] -license: "LGPL-3.0-or-later WITH OCaml-LGPL-linking-exception" - depends: [ + "dune" {>= "3.17"} "ocaml" {>= "4.08"} - "dune" {>= "1.0"} - "react" {>= "1.2.1" < "1.3"} + "react" {>= "1.2.1" & < "1.3"} + "odoc" {with-doc} ] build: [ ["dune" "subst"] {dev} - ["dune" "build" "-p" name "-j" jobs] - ["dune" "runtest" "-p" name "-j" jobs] {with-test} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] ] +dev-repo: "git+https://github.com/ocsigen/reactiveData.git" diff --git a/src/dune b/src/dune index e704088..cd2d74b 100644 --- a/src/dune +++ b/src/dune @@ -1,5 +1,4 @@ (library - (name reactiveData) - (public_name reactiveData) - (libraries react) -) + (name reactiveData) + (public_name reactiveData) + (libraries react)) diff --git a/src/reactiveData.ml b/src/reactiveData.ml index 037b8fc..e8bf7d8 100644 --- a/src/reactiveData.ml +++ b/src/reactiveData.ml @@ -20,6 +20,7 @@ module type DATA = sig type 'a data type 'a patch + val merge : 'a patch -> 'a data -> 'a data val map_patch : ('a -> 'b) -> 'a patch -> 'b patch val map_data : ('a -> 'b) -> 'a data -> 'b data @@ -27,19 +28,21 @@ module type DATA = sig val equal : ('a -> 'a -> bool) -> 'a data -> 'a data -> bool val diff : eq:('a -> 'a -> bool) -> 'a data -> 'a data -> 'a patch end + module type S = sig type 'a t type 'a data type 'a patch type 'a msg = Patch of 'a patch | Set of 'a data type 'a handle + val empty : 'a t val create : 'a data -> 'a t * 'a handle val from_event : 'a data -> 'a msg React.E.t -> 'a t val from_signal : ?eq:('a -> 'a -> bool) -> 'a data React.S.t -> 'a t val const : 'a data -> 'a t val patch : 'a handle -> 'a patch -> unit - val set : 'a handle -> 'a data -> unit + val set : 'a handle -> 'a data -> unit val map_msg : ('a -> 'b) -> 'a msg -> 'b msg val map : ('a -> 'b) -> 'a t -> 'b t val value : 'a t -> 'a data @@ -48,53 +51,48 @@ module type S = sig val event : 'a t -> 'a msg React.E.t end -module Make(D : DATA) : - S with type 'a data = 'a D.data - and type 'a patch = 'a D.patch = struct - +module Make (D : DATA) : + S with type 'a data = 'a D.data and type 'a patch = 'a D.patch = struct type 'a data = 'a D.data type 'a patch = 'a D.patch + let merge = D.merge let map_patch = D.map_patch let map_data = D.map_data - type 'a msg = - | Patch of 'a patch - | Set of 'a data - + type 'a msg = Patch of 'a patch | Set of 'a data type 'a handle = ?step:React.step -> 'a msg -> unit - - type 'a mut = { - current : 'a data ref; - event : 'a msg React.E.t; - } - - type 'a t = - | Const of 'a data - | Mut of 'a mut + type 'a mut = { current : 'a data ref; event : 'a msg React.E.t } + type 'a t = Const of 'a data | Mut of 'a mut let empty = Const D.empty let create l = - let initial_event,send = React.E.create () in + let initial_event, send = React.E.create () in let current = ref l in - let event = React.E.map (fun msg -> - begin match msg with - | Set l -> current := l; - | Patch p -> current := merge p !current - end; - msg) initial_event in - Mut {current;event},send + let event = + React.E.map + (fun msg -> + (match msg with + | Set l -> current := l + | Patch p -> current := merge p !current); + msg) + initial_event + in + (Mut { current; event }, send) let from_event l initial_event = let current = ref l in - let event = React.E.map (fun msg -> - begin match msg with - | Set l -> current := l; - | Patch p -> current := merge p !current - end; - msg) initial_event in - Mut {current;event} + let event = + React.E.map + (fun msg -> + (match msg with + | Set l -> current := l + | Patch p -> current := merge p !current); + msg) + initial_event + in + Mut { current; event } let const x = Const x @@ -106,109 +104,103 @@ module Make(D : DATA) : match s with | Const x -> Const (map_data f x) | Mut s -> - let current = ref (map_data f !(s.current)) in - let event = React.E.map (fun msg -> - let msg = map_msg f msg in - begin match msg with - | Set l -> current := l; - | Patch p -> current := merge p !current - end; - msg) s.event in - Mut {current ;event} - - let value s = match s with - | Const c -> c - | Mut s -> !(s.current) - - let event s = match s with - | Const _ -> React.E.never - | Mut s -> s.event + let current = ref (map_data f !(s.current)) in + let event = + React.E.map + (fun msg -> + let msg = map_msg f msg in + (match msg with + | Set l -> current := l + | Patch p -> current := merge p !current); + msg) + s.event + in + Mut { current; event } + let value s = match s with Const c -> c | Mut s -> !(s.current) + let event s = match s with Const _ -> React.E.never | Mut s -> s.event let patch (s : 'a handle) p = s (Patch p) - let set (s : 'a handle) p = s (Set p) let fold f s acc = match s with | Const c -> React.S.const (f acc (Set c)) | Mut s -> - let acc = f acc (Set (!(s.current))) in - React.S.fold f acc s.event + let acc = f acc (Set !(s.current)) in + React.S.fold f acc s.event - let signal ?(eq = (=)) (s : 'a t) : 'a data React.S.t = + let signal ?(eq = ( = )) (s : 'a t) : 'a data React.S.t = match s with | Const c -> React.S.const c | Mut s -> - React.S.fold ~eq:(D.equal eq) (fun l msg -> - match msg with - | Set l -> l - | Patch p -> merge p l) (!(s.current)) s.event + React.S.fold ~eq:(D.equal eq) + (fun l msg -> match msg with Set l -> l | Patch p -> merge p l) + !(s.current) s.event - let from_signal ?(eq = (=)) s = + let from_signal ?(eq = ( = )) s = let f d' d = Patch (D.diff ~eq d d') in from_event (React.S.value s) (React.S.diff f s) - end module DataList = struct type 'a data = 'a list - type 'a p = - | I of int * 'a - | R of int - | U of int * 'a - | X of int * int + type 'a p = I of int * 'a | R of int | U of int * 'a | X of int * int type 'a patch = 'a p list + let empty = [] let map_data = List.map + let map_patch f = function - | I (i,x) -> I (i, f x) + | I (i, x) -> I (i, f x) | R i -> R i - | X (i,j) -> X (i,j) - | U (i,x) -> U (i,f x) + | X (i, j) -> X (i, j) + | U (i, x) -> U (i, f x) + let map_patch f = List.map (map_patch f) let merge_p op l = match op with - | I (i',x) -> - let i = if i' < 0 then List.length l + 1 + i' else i' in - let rec aux acc n l = match n,l with - | 0,l -> List.rev_append acc (x::l) - | _,[] -> failwith "ReactiveData.Rlist.merge" - | n,x::xs -> aux (x::acc) (pred n) xs - in aux [] i l + | I (i', x) -> + let i = if i' < 0 then List.length l + 1 + i' else i' in + let rec aux acc n l = + match (n, l) with + | 0, l -> List.rev_append acc (x :: l) + | _, [] -> failwith "ReactiveData.Rlist.merge" + | n, x :: xs -> aux (x :: acc) (pred n) xs + in + aux [] i l | R i' -> - let i = if i' < 0 then List.length l + i' else i' in - let rec aux acc n l = match n,l with - | 0,_::l -> List.rev_append acc l - | _,[] -> failwith "ReactiveData.Rlist.merge" - | n,x::xs -> aux (x::acc) (pred n) xs - in aux [] i l - | U (i',x) -> - let i = if i' < 0 then List.length l + i' else i' in - let a = Array.of_list l in - a.(i) <- x; - Array.to_list a - | X (i',offset) -> - let a = Array.of_list l in - let len = Array.length a in - let i = if i' < 0 then len + i' else i' in - let v = a.(i) in - if offset > 0 - then begin - if (i + offset >= len) then failwith "ReactiveData.Rlist.merge"; - for j = i to i + offset - 1 do - a.(j) <- a.(j + 1) - done; - a.(i+offset) <- v - end - else begin - if (i + offset < 0) then failwith "ReactiveData.Rlist.merge"; - for j = i downto i + offset + 1 do - a.(j) <- a.(j - 1) - done; - a.(i+offset) <- v - end; - Array.to_list a + let i = if i' < 0 then List.length l + i' else i' in + let rec aux acc n l = + match (n, l) with + | 0, _ :: l -> List.rev_append acc l + | _, [] -> failwith "ReactiveData.Rlist.merge" + | n, x :: xs -> aux (x :: acc) (pred n) xs + in + aux [] i l + | U (i', x) -> + let i = if i' < 0 then List.length l + i' else i' in + let a = Array.of_list l in + a.(i) <- x; + Array.to_list a + | X (i', offset) -> + let a = Array.of_list l in + let len = Array.length a in + let i = if i' < 0 then len + i' else i' in + let v = a.(i) in + if offset > 0 then ( + if i + offset >= len then failwith "ReactiveData.Rlist.merge"; + for j = i to i + offset - 1 do + a.(j) <- a.(j + 1) + done; + a.(i + offset) <- v) + else ( + if i + offset < 0 then failwith "ReactiveData.Rlist.merge"; + for j = i downto i + offset + 1 do + a.(j) <- a.(j - 1) + done; + a.(i + offset) <- v); + Array.to_list a (* accumulates into acc i unmodified elements from l *) let rec linear_merge_fwd ~acc i l = @@ -216,142 +208,122 @@ module DataList = struct if i > 0 then match l with | h :: l -> - let acc = h :: acc in - linear_merge_fwd ~acc (i - 1) l - | [] -> - invalid_arg "invalid index" - else - l, acc + let acc = h :: acc in + linear_merge_fwd ~acc (i - 1) l + | [] -> invalid_arg "invalid index" + else (l, acc) let rec linear_merge ~acc i0 p l = let l, acc = match p with | (I (i, _) | R i | U (i, _)) :: _ when i > i0 -> - linear_merge_fwd ~acc (i - i0) l - | _ -> - l, acc + linear_merge_fwd ~acc (i - i0) l + | _ -> (l, acc) in - match p, l with - | I (i, x) :: p, _ -> - linear_merge ~acc i p (x :: l) - | R i :: p, _ :: l -> - linear_merge ~acc i p l - | R _ :: _, [] -> - invalid_arg "merge: invalid index" - | U (i, x) :: p, _ :: l -> - linear_merge ~acc i p (x :: l) - | U (_, _) :: _, [] -> - invalid_arg "merge: invalid index" - | [], l -> - List.rev_append acc l - | X (_, _) :: _, _ -> - failwith "linear_merge: X not supported" + match (p, l) with + | I (i, x) :: p, _ -> linear_merge ~acc i p (x :: l) + | R i :: p, _ :: l -> linear_merge ~acc i p l + | R _ :: _, [] -> invalid_arg "merge: invalid index" + | U (i, x) :: p, _ :: l -> linear_merge ~acc i p (x :: l) + | U (_, _) :: _, [] -> invalid_arg "merge: invalid index" + | [], l -> List.rev_append acc l + | X (_, _) :: _, _ -> failwith "linear_merge: X not supported" let rec linear_mergeable ~n p = assert (n >= 0); match p with | (I (i, _) | R i | U (i, _)) :: p when i >= n -> - (* negative i's ruled out (among others) *) - linear_mergeable ~n:i p - | _ :: _ -> - false - | [] -> - true + (* negative i's ruled out (among others) *) + linear_mergeable ~n:i p + | _ :: _ -> false + | [] -> true let merge p l = - if linear_mergeable ~n:0 p then - linear_merge ~acc:[] 0 p l - else - List.fold_left (fun l x -> merge_p x l) l p + if linear_mergeable ~n:0 p then linear_merge ~acc:[] 0 p l + else List.fold_left (fun l x -> merge_p x l) l p let rec equal f l1 l2 = - match l1, l2 with - | x1 :: l1, x2 :: l2 when f x1 x2 -> - equal f l1 l2 - | [], [] -> - true - | _ :: _ , _ :: _ - | _ :: _ , [] - | [] , _ :: _ -> - false + match (l1, l2) with + | x1 :: l1, x2 :: l2 when f x1 x2 -> equal f l1 l2 + | [], [] -> true + | _ :: _, _ :: _ | _ :: _, [] | [], _ :: _ -> false let mem (type u) l = - let module H = - Hashtbl.Make - (struct type t = u let hash = Hashtbl.hash let equal = (==) end) in + let module H = Hashtbl.Make (struct + type t = u + + let hash = Hashtbl.hash + let equal = ( == ) + end) in let h = H.create 16 in List.iter (fun x -> H.add h x ()) l; H.mem h - let fold_diff ?(eq = (=)) ~acc ~remove ~add lx ly = - let memx = mem lx - and memy = mem ly in + let fold_diff ?(eq = ( = )) ~acc ~remove ~add lx ly = + let memx = mem lx and memy = mem ly in let rec f ~acc ~left lx ly n = - match lx, ly with + match (lx, ly) with (* trailing elements to be removed *) | _ :: lx, [] -> - let acc = remove acc n in - f ~acc ~left lx [] n + let acc = remove acc n in + f ~acc ~left lx [] n (* trailing elements to be added *) | [], y :: ly -> - let acc = add acc n y in - f ~acc ~left [] ly (n + 1) + let acc = add acc n y in + f ~acc ~left [] ly (n + 1) (* done! *) - | [], [] -> - acc + | [], [] -> acc (* same *) - | x :: lx, y :: ly when eq x y -> - f ~acc ~left lx ly (n + 1) + | x :: lx, y :: ly when eq x y -> f ~acc ~left lx ly (n + 1) (* x needs to be removed for sure *) | x :: lx, _ :: _ when not (memy x) -> - let acc = remove acc n in - f ~acc ~left lx ly n + let acc = remove acc n in + f ~acc ~left lx ly n (* y needs to be added for sure *) | _ :: _, y :: ly when not (memx y) -> - let acc = add acc n y in - f ~acc ~left lx ly (n + 1) + let acc = add acc n y in + f ~acc ~left lx ly (n + 1) (* no more certainty, ~left decides what to recur on *) | _ :: lx, _ :: _ when left -> - let acc = remove acc n in - f ~acc ~left:false lx ly n + let acc = remove acc n in + f ~acc ~left:false lx ly n | _ :: _, y :: ly -> - let acc = add acc n y in - f ~acc ~left:true lx ly (n + 1) + let acc = add acc n y in + f ~acc ~left:true lx ly (n + 1) in f ~acc ~left:true lx ly 0 let rec list_rev ?(acc = []) = function | h :: t -> - let acc = h :: acc in - list_rev ~acc t - | [] -> - acc + let acc = h :: acc in + list_rev ~acc t + | [] -> acc let diff ~eq x y = let add acc i v = I (i, v) :: acc and remove acc i = R i :: acc and acc = [] in list_rev (fold_diff ~eq ~acc ~add ~remove x y) - end module RList = struct include Make (DataList) module D = DataList + type 'a p = 'a D.p = | I of int * 'a | R of int | U of int * 'a | X of int * int - let cons x s = patch s [D.I (0,x)] - let snoc x s = patch s [D.I (-1,x)] - let insert x i s = patch s [D.I (i,x)] - let update x i s = patch s [D.U (i,x)] - let move i j s = patch s [D.X (i,j)] - let remove i s = patch s [D.R i] + let cons x s = patch s [ D.I (0, x) ] + let snoc x s = patch s [ D.I (-1, x) ] + let insert x i s = patch s [ D.I (i, x) ] + let update x i s = patch s [ D.U (i, x) ] + let move i j s = patch s [ D.X (i, j) ] + let remove i s = patch s [ D.R i ] - let index ?(eq = (=)) l x = + let index ?(eq = ( = )) l x = let rec f n = function | hd :: _ when eq hd x -> n | _ :: tl -> f (n + 1) tl @@ -363,136 +335,146 @@ module RList = struct let i = index ?eq (value data) x in update y i handle - let remove_last (data, handle) = - remove (List.length (value data) - 1) handle + let remove_last (data, handle) = remove (List.length (value data) - 1) handle let remove_eq ?eq (data, handle) x = let i = index ?eq (value data) x in remove i handle - let singleton x = const [x] + let singleton x = const [ x ] let singleton_s s = let first = ref true in - let e,send = React.E.create () in + let e, send = React.E.create () in let result = from_event [] e in - let _ = React.S.map (fun x -> - if !first - then begin - first:=false; - send (Patch [I(0,x)]) - end - else send (Patch [U(0,x)])) s in + let _ = + React.S.map + (fun x -> + if !first then ( + first := false; + send (Patch [ I (0, x) ])) + else send (Patch [ U (0, x) ])) + s + in result - let concat : 'a t -> 'a t -> 'a t = fun x y -> - let v1 = value x - and v2 = value y in - let size1 = ref 0 - and size2 = ref 0 in + let concat : 'a t -> 'a t -> 'a t = + fun x y -> + let v1 = value x and v2 = value y in + let size1 = ref 0 and size2 = ref 0 in let size_with_patch sizex : 'a D.p -> unit = function - | (D.I _) -> incr sizex - | (D.R _) -> decr sizex - | (D.X _ | D.U _) -> () in - let size_with_set sizex l = sizex:=List.length l in + | D.I _ -> incr sizex + | D.R _ -> decr sizex + | D.X _ | D.U _ -> () + in + let size_with_set sizex l = sizex := List.length l in size_with_set size1 v1; size_with_set size2 v2; - let update_patch1 = List.map (fun p -> - let m = match p with - | D.I (pos,x) -> - let i = if pos < 0 then pos - !size2 else pos in - D.I (i, x) - | D.R pos -> D.R (if pos < 0 then pos - !size2 else pos) - | D.U (pos,x) -> D.U ((if pos < 0 then pos - !size2 else pos), x) - | D.X (i,j) -> D.X ((if i < 0 then i - !size2 else i),j) - in - size_with_patch size1 m; - m) in - let update_patch2 = List.map (fun p -> - let m = match p with - | D.I (pos,x) -> D.I ((if pos < 0 then pos else !size1 + pos), x) - | D.R pos -> D.R (if pos < 0 then pos else !size1 + pos) - | D.U (pos,x) -> D.U ((if pos < 0 then pos else !size1 + pos), x) - | D.X (i,j) -> D.X ((if i < 0 then i else !size1 + i),j) - in - size_with_patch size2 m; - m) in + let update_patch1 = + List.map (fun p -> + let m = + match p with + | D.I (pos, x) -> + let i = if pos < 0 then pos - !size2 else pos in + D.I (i, x) + | D.R pos -> D.R (if pos < 0 then pos - !size2 else pos) + | D.U (pos, x) -> D.U ((if pos < 0 then pos - !size2 else pos), x) + | D.X (i, j) -> D.X ((if i < 0 then i - !size2 else i), j) + in + size_with_patch size1 m; + m) + in + let update_patch2 = + List.map (fun p -> + let m = + match p with + | D.I (pos, x) -> D.I ((if pos < 0 then pos else !size1 + pos), x) + | D.R pos -> D.R (if pos < 0 then pos else !size1 + pos) + | D.U (pos, x) -> D.U ((if pos < 0 then pos else !size1 + pos), x) + | D.X (i, j) -> D.X ((if i < 0 then i else !size1 + i), j) + in + size_with_patch size2 m; + m) + in let tuple_ev = - React.E.merge (fun acc x -> - match acc,x with - | (None,p2),`E1 x -> Some x,p2 - | (p1,None),`E2 x -> p1, Some x + React.E.merge + (fun acc x -> + match (acc, x) with + | (None, p2), `E1 x -> (Some x, p2) + | (p1, None), `E2 x -> (p1, Some x) | _ -> assert false) - (None,None) - [React.E.map (fun e -> `E1 e) (event x); - React.E.map (fun e -> `E2 e) (event y)] in - let merged_ev = React.E.map (fun p -> - match p with - | Some (Set p1), Some (Set p2) -> - size_with_set size1 p1; - size_with_set size2 p2; - Set (p1 @ p2) - | Some (Set p1), None -> - size_with_set size1 p1; - Set (p1 @ value y) - | None, Some (Set p2) -> - size_with_set size2 p2; - Set (value x @ p2 ) - | Some (Patch p1), Some (Patch p2) -> - let p1 = update_patch1 p1 in - let p2 = update_patch2 p2 in - Patch (p1 @ p2) - | Some (Patch p1), None -> Patch (update_patch1 p1) - | None, Some (Patch p2) -> Patch (update_patch2 p2) - | Some (Patch _), Some (Set s2) -> - let s1 = value x in - size_with_set size1 s1; - size_with_set size2 s2; - Set(s1 @ s2) - | Some (Set s1), Some (Patch _) -> - size_with_set size1 s1; - let s2 = value y in - size_with_set size2 s2; - Set(s1 @ s2) - | None,None -> assert false - ) tuple_ev in + (None, None) + [ + React.E.map (fun e -> `E1 e) (event x); + React.E.map (fun e -> `E2 e) (event y); + ] + in + let merged_ev = + React.E.map + (fun p -> + match p with + | Some (Set p1), Some (Set p2) -> + size_with_set size1 p1; + size_with_set size2 p2; + Set (p1 @ p2) + | Some (Set p1), None -> + size_with_set size1 p1; + Set (p1 @ value y) + | None, Some (Set p2) -> + size_with_set size2 p2; + Set (value x @ p2) + | Some (Patch p1), Some (Patch p2) -> + let p1 = update_patch1 p1 in + let p2 = update_patch2 p2 in + Patch (p1 @ p2) + | Some (Patch p1), None -> Patch (update_patch1 p1) + | None, Some (Patch p2) -> Patch (update_patch2 p2) + | Some (Patch _), Some (Set s2) -> + let s1 = value x in + size_with_set size1 s1; + size_with_set size2 s2; + Set (s1 @ s2) + | Some (Set s1), Some (Patch _) -> + size_with_set size1 s1; + let s2 = value y in + size_with_set size2 s2; + Set (s1 @ s2) + | None, None -> assert false) + tuple_ev + in from_event (v1 @ v2) merged_ev - let inverse : 'a . 'a p -> 'a p = function - | I (i,x) -> I(-i-1, x) - | U (i,x) -> U(-i-1, x) - | R i -> R (-i-1) - | X (i,j) -> X (-i-1,-j) + let inverse : 'a. 'a p -> 'a p = function + | I (i, x) -> I (-i - 1, x) + | U (i, x) -> U (-i - 1, x) + | R i -> R (-i - 1) + | X (i, j) -> X (-i - 1, -j) let rev t = - let e = React.E.map (function - | Set l -> Set (List.rev l) - | Patch p -> Patch (List.map inverse p)) (event t) + let e = + React.E.map + (function + | Set l -> Set (List.rev l) | Patch p -> Patch (List.map inverse p)) + (event t) in from_event (List.rev (value t)) e let filter pred l = - let module IntMap = Map.Make(Int) in - + let module IntMap = Map.Make (Int) in let index = ref IntMap.empty in let size = ref 0 in let filter_list l = - let rec aux (l: 'a list) res their_i my_i = match l with + let rec aux (l : 'a list) res their_i my_i = + match l with | [] -> res - | x::xs -> - if pred x - then - begin - index := IntMap.add their_i (my_i + 1) !index; - aux xs (x::res) (their_i + 1) (my_i + 1) - end - else - begin - aux xs res (their_i + 1) my_i - end + | x :: xs -> + if pred x then ( + index := IntMap.add their_i (my_i + 1) !index; + aux xs (x :: res) (their_i + 1) (my_i + 1)) + else aux xs res (their_i + 1) my_i in size := List.length l; index := IntMap.empty; @@ -503,35 +485,42 @@ module RList = struct let update_index_insert insert_pos_full_list visible = let insert_pos_full_list = normalise insert_pos_full_list in - let left_alone, displaced, updatables = IntMap.split insert_pos_full_list !index in - let updatables = match displaced with + let left_alone, displaced, updatables = + IntMap.split insert_pos_full_list !index + in + let updatables = + match displaced with | None -> updatables | Some displaced_in_filtered -> - IntMap.add insert_pos_full_list displaced_in_filtered updatables + IntMap.add insert_pos_full_list displaced_in_filtered updatables in let update_j j_full_list j_filtered_list = - let new_j_filtered = if visible then j_filtered_list + 1 else j_filtered_list in + let new_j_filtered = + if visible then j_filtered_list + 1 else j_filtered_list + in index := IntMap.add (j_full_list + 1) new_j_filtered !index in let () = IntMap.iter update_j updatables in - let insert_pos_filtered = if IntMap.is_empty left_alone - then 0 - else (snd (IntMap.max_binding left_alone)) + 1 + let insert_pos_filtered = + if IntMap.is_empty left_alone then 0 + else snd (IntMap.max_binding left_alone) + 1 in - if visible then index := IntMap.add insert_pos_full_list insert_pos_filtered !index; + if visible then + index := IntMap.add insert_pos_full_list insert_pos_filtered !index; incr size; insert_pos_filtered in let update_index_remove remove_pos_full_list = let was_visible = IntMap.mem remove_pos_full_list !index in - let _,_,updatables = IntMap.split remove_pos_full_list !index in + let _, _, updatables = IntMap.split remove_pos_full_list !index in let update_j j_full_list j_filtered_list = - let new_j = if was_visible then j_filtered_list else j_filtered_list - 1 in + let new_j = + if was_visible then j_filtered_list else j_filtered_list - 1 + in index := IntMap.add (j_full_list - 1) new_j !index in - if not (IntMap.is_empty !index) - then + if not (IntMap.is_empty !index) then let last_i, _ = IntMap.max_binding !index in index := IntMap.remove last_i !index else (); @@ -549,13 +538,17 @@ module RList = struct in let update_index_update_insert update_pos_full_list = - let left_alone, none, updatables = IntMap.split update_pos_full_list !index in + let left_alone, none, updatables = + IntMap.split update_pos_full_list !index + in assert (none = None); let update_j j_full_list j_filtered_list = index := IntMap.add j_full_list (j_filtered_list + 1) !index in let new_pos_filtered_list = - let previous_pos_filtered = try (snd (IntMap.max_binding left_alone)) with Not_found -> (-1) in + let previous_pos_filtered = + try snd (IntMap.max_binding left_alone) with Not_found -> -1 + in previous_pos_filtered + 1 in index := IntMap.add update_pos_full_list new_pos_filtered_list !index; @@ -564,17 +557,18 @@ module RList = struct in let update_index_move from_full_list to_full_list to_filtered = - let was_visible = match to_filtered with | Some _ -> true | None -> false in + let was_visible = + match to_filtered with Some _ -> true | None -> false + in let forward = from_full_list < to_full_list in if forward then for i_full = from_full_list + 1 to to_full_list do - let delta = if was_visible then (-1) else 0 in + let delta = if was_visible then -1 else 0 in try let i_filtered = IntMap.find i_full !index in let new_val = i_filtered + delta in index := IntMap.add (i_full - 1) new_val !index - with - | Not_found -> () + with Not_found -> () done else for i_full = from_full_list - 1 downto to_full_list do @@ -583,78 +577,69 @@ module RList = struct let i_filtered = IntMap.find i_full !index in let new_val = i_filtered + delta in index := IntMap.add (i_full + 1) new_val !index - with - | Not_found -> () + with Not_found -> () done; match to_filtered with - | Some to_filtered -> - index := IntMap.add to_full_list to_filtered !index - | None -> - index := IntMap.remove to_full_list !index + | Some to_filtered -> index := IntMap.add to_full_list to_filtered !index + | None -> index := IntMap.remove to_full_list !index in let convert_p = function | I (i, x) -> - if pred x - then - let my_i = update_index_insert i true in - [I (my_i, x)] - else - begin - ignore (update_index_insert i false); - [] - end + if pred x then + let my_i = update_index_insert i true in + [ I (my_i, x) ] + else ( + ignore (update_index_insert i false); + []) | R i -> - let i = normalise i in - let ret = try let j = IntMap.find i !index in [R j] with | Not_found -> [] in - let () = update_index_remove i in - ret - | U (i, x) -> - let i = normalise i in - begin - try - let old_j = IntMap.find i !index in - if pred x - then [U (old_j, x)] - else (update_index_update_delete i; [R old_j]) - with - | Not_found -> - if pred x - then - let new_j = update_index_update_insert i in - [I (new_j, x)] - else - [] - end - | X (origin_full, offset_full) -> - let origin_full = normalise origin_full in - let dest_full = origin_full + offset_full in - try - let origin_filtered = IntMap.find origin_full !index in - let dest_filtered = - try IntMap.find dest_full !index - with - | Not_found -> + let i = normalise i in + let ret = + try + let j = IntMap.find i !index in + [ R j ] + with Not_found -> [] + in + let () = update_index_remove i in + ret + | U (i, x) -> ( + let i = normalise i in + try + let old_j = IntMap.find i !index in + if pred x then [ U (old_j, x) ] + else ( + update_index_update_delete i; + [ R old_j ]) + with Not_found -> + if pred x then + let new_j = update_index_update_insert i in + [ I (new_j, x) ] + else []) + | X (origin_full, offset_full) -> ( + let origin_full = normalise origin_full in + let dest_full = origin_full + offset_full in + try + let origin_filtered = IntMap.find origin_full !index in + let dest_filtered = + try IntMap.find dest_full !index + with Not_found -> let small_ones, _, _ = IntMap.split origin_full !index in - if IntMap.is_empty small_ones - then 0 + if IntMap.is_empty small_ones then 0 else snd (IntMap.max_binding small_ones) + 1 - in - update_index_move origin_full dest_full (Some dest_filtered); - if dest_filtered != origin_filtered - then [X (origin_filtered, dest_filtered - origin_filtered)] - else [] - with - | Not_found -> + in + update_index_move origin_full dest_full (Some dest_filtered); + if dest_filtered != origin_filtered then + [ X (origin_filtered, dest_filtered - origin_filtered) ] + else [] + with Not_found -> (* moving an element that was filtered out *) update_index_move origin_full dest_full None; - [] + []) in let filter_e = function | Set l -> Set (filter_list l) - | Patch p -> - Patch (List.concat (List.map convert_p p)) + | Patch p -> Patch (List.concat (List.map convert_p p)) in let e = React.E.map filter_e (event l) in from_event (filter_list (value l)) e @@ -673,100 +658,70 @@ module RList = struct let update_idx_after i f acc = IntSet.map (fun i' -> if i' >= i then f i' 1 else i') acc in - let f = fun acc -> function - | Set x -> init x - | Patch updates -> - List.fold_left - (fun acc -> function - | X (i, i') -> - if IntSet.mem i acc = IntSet.mem i' acc - then acc - else if IntSet.mem i acc - then IntSet.add i' (IntSet.remove i acc) - else IntSet.add i (IntSet.remove i' acc) - | R i -> - update_idx_after i (-) (IntSet.remove i acc) - | I (i, v) -> - let acc = update_idx_after i (+) acc in - maybe_update acc i v - | U (i, v) -> - maybe_update (IntSet.remove i acc) i v) - acc - updates + let f = + fun acc -> function + | Set x -> init x + | Patch updates -> + List.fold_left + (fun acc -> function + | X (i, i') -> + if IntSet.mem i acc = IntSet.mem i' acc then acc + else if IntSet.mem i acc then + IntSet.add i' (IntSet.remove i acc) + else IntSet.add i (IntSet.remove i' acc) + | R i -> update_idx_after i ( - ) (IntSet.remove i acc) + | I (i, v) -> + let acc = update_idx_after i ( + ) acc in + maybe_update acc i v + | U (i, v) -> maybe_update (IntSet.remove i acc) i v) + acc updates in React.S.fold f (init (value data)) (event data) |> React.S.map IntSet.is_empty - end -module RMap(M : Map.S) = struct - +module RMap (M : Map.S) = struct module Data = struct - type 'a data = 'a M.t - - type 'a p = [`Add of (M.key * 'a) | `Del of M.key] - + type 'a p = [ `Add of M.key * 'a | `Del of M.key ] type 'a patch = 'a p list let merge_p p s = - match p with - | `Add (k,a) -> M.add k a s - | `Del k -> M.remove k s + match p with `Add (k, a) -> M.add k a s | `Del k -> M.remove k s let merge p acc = List.fold_left (fun acc p -> merge_p p acc) acc p - - let map_p f = function - | `Add (k,a) -> `Add (k,f a) - | `Del k -> `Del k - + let map_p f = function `Add (k, a) -> `Add (k, f a) | `Del k -> `Del k let map_patch f = List.map (map_p f) - let map_data f d = M.map f d - let empty = M.empty - let equal f = M.equal f let diff ~eq x y = let m = let g _key v w = - match v, w with - | Some v, Some w when eq v w -> - None - | Some _, Some w -> - Some (`U w) - | Some _, None -> - Some `D - | None, Some v -> - Some (`A v) - | None, None -> - None + match (v, w) with + | Some v, Some w when eq v w -> None + | Some _, Some w -> Some (`U w) + | Some _, None -> Some `D + | None, Some v -> Some (`A v) + | None, None -> None in M.merge g x y and g key x acc = match x with - | `U v -> - `Del key :: `Add (key, v) :: acc - | `D -> - `Del key :: acc - | `A v -> - `Add (key, v) :: acc + | `U v -> `Del key :: `Add (key, v) :: acc + | `D -> `Del key :: acc + | `A v -> `Add (key, v) :: acc and acc = [] in List.rev (M.fold g m acc) - end - include Make(Data) + include Make (Data) let filter pred m = - let convert_p = function - | `Add (k,v) -> - if pred k v - then [`Add (k,v)] - else [] - | `Del k -> [`Del k] + | `Add (k, v) -> if pred k v then [ `Add (k, v) ] else [] + | `Del k -> [ `Del k ] in let filter_e = function diff --git a/src/reactiveData.mli b/src/reactiveData.mli index adfbb9a..160d176 100644 --- a/src/reactiveData.mli +++ b/src/reactiveData.mli @@ -17,242 +17,217 @@ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -(** ReactiveData is a module for data-aware functional reactive - programming (FRP). It adds support to incremental changes in data - structures by reasoning on patches instead of absolute - values. ReactiveData is based on and inter-operates with React. +(** ReactiveData is a module for data-aware functional reactive programming + (FRP). It adds support to incremental changes in data structures by + reasoning on patches instead of absolute values. ReactiveData is based on + and inter-operates with React. - You are most likely interested in the sub-module [RList], which - implements a superset of the signature [S]. *) + You are most likely interested in the sub-module [RList], which implements a + superset of the signature [S]. *) (** Signature describing a reactive data structure (['a t]). - Most functions in [S] are not safe to call during a React update - step. *) + Most functions in [S] are not safe to call during a React update step. *) module type S = sig - - (** Reactive version of the data container *) type 'a t + (** Reactive version of the data container *) - (** Raw (non-reactive) version of the data container *) type 'a data + (** Raw (non-reactive) version of the data container *) - (** Patch format *) type 'a patch + (** Patch format *) (** Message format *) type 'a msg = - | Patch of 'a patch (** [Patch p] triggers the application of [p] - on the current contents *) - | Set of 'a data (** With [Set d], [d] becomes the new - content *) + | Patch of 'a patch + (** [Patch p] triggers the application of [p] on the current contents *) + | Set of 'a data (** With [Set d], [d] becomes the new content *) - (** Handle that permits applying incremental updates *) type 'a handle + (** Handle that permits applying incremental updates *) - (** Empty data structure *) val empty : 'a t + (** Empty data structure *) - (** Build a container from initial contents. The handle can be used - for performing reactive updates. *) val create : 'a data -> 'a t * 'a handle + (** Build a container from initial contents. The handle can be used for + performing reactive updates. *) - (** [from_event d e] is a container whose initial value is [d], and - which gets updated for every occurrence of [e] *) val from_event : 'a data -> 'a msg React.E.t -> 'a t + (** [from_event d e] is a container whose initial value is [d], and which gets + updated for every occurrence of [e] *) + val from_signal : ?eq:('a -> 'a -> bool) -> 'a data React.S.t -> 'a t (** Convert a React signal into a ReactiveData container. - Whenever the signal changes from value [v] to value [v'], we - detect the differences between [v] and [v'], and perform - downstream computation (e.g., for [map]) only on the new and - modified elements. *) - val from_signal : - ?eq:('a -> 'a -> bool) -> 'a data React.S.t -> 'a t + Whenever the signal changes from value [v] to value [v'], we detect the + differences between [v] and [v'], and perform downstream computation + (e.g., for [map]) only on the new and modified elements. *) - (** Produce a constant container *) val const : 'a data -> 'a t + (** Produce a constant container *) - (** [patch h p] applies [p] on the container corresponding to [h] *) val patch : 'a handle -> 'a patch -> unit + (** [patch h p] applies [p] on the container corresponding to [h] *) - (** [set h d] sets the contents of the container corresponding to - [h], disregarding previous contents *) val set : 'a handle -> 'a data -> unit + (** [set h d] sets the contents of the container corresponding to [h], + disregarding previous contents *) - (** Transform a message *) val map_msg : ('a -> 'b) -> 'a msg -> 'b msg + (** Transform a message *) - (** [map f c] applies [f] on all elements of [c], producing a new - reactive container [c']. Modifying the contents of [c] leads to - modifications of [c']. [f] is applied only on the new or - modified elements of [c]. *) val map : ('a -> 'b) -> 'a t -> 'b t + (** [map f c] applies [f] on all elements of [c], producing a new reactive + container [c']. Modifying the contents of [c] leads to modifications of + [c']. [f] is applied only on the new or modified elements of [c]. *) - (** Return current contents *) val value : 'a t -> 'a data + (** Return current contents *) - (** [fold f c v] accumulates the updates on [c] with [f] starting - from [v]. - - The result is a signal of value [f m_n (f ... (f m_1 v))], where - [m_1] ... [m_n] are the messages that have been applied since - the beginning of [fold]. [m_1] is a pseudo-message [Set l], - accounting for the contents [l] of [c] at the time when - accumulation starts. *) val fold : ('a -> 'b msg -> 'a) -> 'b t -> 'a -> 'a React.signal + (** [fold f c v] accumulates the updates on [c] with [f] starting from [v]. + The result is a signal of value [f m_n (f ... (f m_1 v))], where [m_1] ... + [m_n] are the messages that have been applied since the beginning of + [fold]. [m_1] is a pseudo-message [Set l], accounting for the contents [l] + of [c] at the time when accumulation starts. *) + + val signal : ?eq:('a -> 'a -> bool) -> 'a t -> 'a data React.S.t (** Signal corresponding to contents *) - val signal : - ?eq:('a -> 'a -> bool) -> 'a t -> 'a data React.S.t - (** Event whose occurrences correspond to container updates *) val event : 'a t -> 'a msg React.E.t - + (** Event whose occurrences correspond to container updates *) end (** Reactive list data structure *) -module RList : -sig - - (** Patch operation on lists. All operations are of linear - complexity. *) +module RList : sig + (** Patch operation on lists. All operations are of linear complexity. *) type 'a p = | I of int * 'a (** [I (i, v)] adds [v] at position [i] *) - | R of int (** [R i] removes [i]-th element *) + | R of int (** [R i] removes [i]-th element *) | U of int * 'a (** [U (i, v)] substitutes [i]-th element with [v] *) - | X of int * int (** [X (i, j)] swaps the [i]-th and [j]-th elements *) + | X of int * int (** [X (i, j)] swaps the [i]-th and [j]-th elements *) - (** A patch is a list of patch operations. The operations are - applied in the order they appear in the list. + type 'a patch = 'a p list + (** A patch is a list of patch operations. The operations are applied in the + order they appear in the list. - The indices correspond to list contents after the operations - that appear earlier in the list have been applied, not to the - contents before the whole patch operation. + The indices correspond to list contents after the operations that appear + earlier in the list have been applied, not to the contents before the + whole patch operation. - A patch comprised of [I], [R], and [U] steps with increasing - indices can be applied in time O(m + n), where m is the patch - length and n is the current size of the list. (Arbitrary patches - are slower, requiring O(m * n).) *) - type 'a patch = 'a p list + A patch comprised of [I], [R], and [U] steps with increasing indices can + be applied in time O(m + n), where m is the patch length and n is the + current size of the list. (Arbitrary patches are slower, requiring O(m * + n).) *) - include S with type 'a data = 'a list - and type 'a patch := 'a patch + include S with type 'a data = 'a list and type 'a patch := 'a patch - (** Add element to the beginning *) val cons : 'a -> 'a handle -> unit + (** Add element to the beginning *) - (** Add element to the end *) val snoc : 'a -> 'a handle -> unit + (** Add element to the end *) - (** [insert v i h] adds [v] as the [i]-th position in the container - corresponding to [h]. The indices of the subsequent elements - change. *) val insert : 'a -> int -> 'a handle -> unit + (** [insert v i h] adds [v] as the [i]-th position in the container + corresponding to [h]. The indices of the subsequent elements change. *) - (** [remove i h] removes the [i]-th position from the container - corresponding to [h]. The indices of the subsequent elements - change. *) val remove : int -> 'a handle -> unit + (** [remove i h] removes the [i]-th position from the container corresponding + to [h]. The indices of the subsequent elements change. *) + val remove_last : 'a t * 'a handle -> unit (** [remove_last a] removes the last element of [a] *) - val remove_last : ('a t * 'a handle) -> unit + val remove_eq : ?eq:('a -> 'a -> bool) -> 'a t * 'a handle -> 'a -> unit (** [remove_eq l x] removes the first occurence of [x] from [l] *) - val remove_eq : ?eq:('a -> 'a -> bool) -> ('a t * 'a handle) -> 'a -> unit + val update : 'a -> int -> 'a handle -> unit (** [update v i h] substitutes the [i]-th element of the container corresponding to [h] with [v] *) - val update : 'a -> int -> 'a handle -> unit - (** [update_eq l a b] substitutes the first occurence of [a] (according to [eq]) - in [l] with [b] *) - val update_eq : ?eq:('a -> 'a -> bool) -> ('a t * 'a handle) -> 'a -> 'a -> unit + val update_eq : ?eq:('a -> 'a -> bool) -> 'a t * 'a handle -> 'a -> 'a -> unit + (** [update_eq l a b] substitutes the first occurence of [a] (according to + [eq]) in [l] with [b] *) - (** [move i offset h] moves the [i]-th element of the container - corresponding by [offset] positions in [h], modifying the - indices of other elements *) val move : int -> int -> 'a handle -> unit + (** [move i offset h] moves the [i]-th element of the container corresponding + by [offset] positions in [h], modifying the indices of other elements *) - (** Produce container list containing a single, constant element *) val singleton : 'a -> 'a t + (** Produce container list containing a single, constant element *) - (** Produce reactive list containing a single element that gets - updated based on a signal *) val singleton_s : 'a React.S.t -> 'a t + (** Produce reactive list containing a single element that gets updated based + on a signal *) - (** [concat a b] is the concatenation of [a] and [b], and it gets - updated whenever [a] and [b] change *) val concat : 'a t -> 'a t -> 'a t + (** [concat a b] is the concatenation of [a] and [b], and it gets updated + whenever [a] and [b] change *) - (** [rev a] is the reversal of [a]; [rev a] gets updated along with - [a] *) val rev : 'a t -> 'a t + (** [rev a] is the reversal of [a]; [rev a] gets updated along with [a] *) - (** [filter pred l] keeps the elements of [l] matching [pred]; gets - updated when [l] is. [pred] should be a pure function *) val filter : ('a -> bool) -> 'a t -> 'a t - - (** [for_all fn l] is a [bool React.S.t] verifying that all elements [x] of [l] - satisfy [fn x] *) - val for_all : ('a -> bool) -> 'a t -> bool React.S.t + (** [filter pred l] keeps the elements of [l] matching [pred]; gets updated + when [l] is. [pred] should be a pure function *) + val for_all : ('a -> bool) -> 'a t -> bool React.S.t + (** [for_all fn l] is a [bool React.S.t] verifying that all elements [x] of + [l] satisfy [fn x] *) end (** Reactive map data structure *) -module RMap(M : Map.S) : -sig - +module RMap (M : Map.S) : sig type 'a patch = [ `Add of M.key * 'a | `Del of M.key ] list - include S with type 'a data = 'a M.t - and type 'a patch := 'a patch + include S with type 'a data = 'a M.t and type 'a patch := 'a patch - (** [filter pred l] keeps the elements of [l] matching [pred]; gets - updated when [l] is. [pred] should be a pure function *) val filter : (M.key -> 'a -> bool) -> 'a t -> 'a t - + (** [filter pred l] keeps the elements of [l] matching [pred]; gets updated + when [l] is. [pred] should be a pure function *) end (** Signature describing a raw data container (['a data]). - Given an implementation of [DATA], an incremental version of the - container can be produced (via [Make]). *) + Given an implementation of [DATA], an incremental version of the container + can be produced (via [Make]). *) module type DATA = sig - - (** Data container *) type 'a data + (** Data container *) - (** Patch format for modifying the container *) type 'a patch + (** Patch format for modifying the container *) - (** Applicative merge operation: [merge p d] is a new container - produced by applying [p] on [d]. [d] does not change. *) val merge : 'a patch -> 'a data -> 'a data + (** Applicative merge operation: [merge p d] is a new container produced by + applying [p] on [d]. [d] does not change. *) - (** Transform a patch *) val map_patch : ('a -> 'b) -> 'a patch -> 'b patch + (** Transform a patch *) - (** [map f d] applies [f] on all the elements of [d], producing a - new container in an applicative way *) val map_data : ('a -> 'b) -> 'a data -> 'b data + (** [map f d] applies [f] on all the elements of [d], producing a new + container in an applicative way *) - (** Empty container *) val empty : 'a data + (** Empty container *) - (** Lift an equality operator over atoms of type ['a] to an equality - operator over ['a data] *) val equal : ('a -> 'a -> bool) -> 'a data -> 'a data -> bool + (** Lift an equality operator over atoms of type ['a] to an equality operator + over ['a data] *) - (** [diff ?eq d1 d2] produces a patch describing the differences - between [d1] and [d2]. - - The optional [?eq] argument is used for comparing the atoms - inside [d1] and [d2]. (The default value for [eq] is [(=)].) *) val diff : eq:('a -> 'a -> bool) -> 'a data -> 'a data -> 'a patch + (** [diff ?eq d1 d2] produces a patch describing the differences between [d1] + and [d2]. + The optional [?eq] argument is used for comparing the atoms inside [d1] + and [d2]. (The default value for [eq] is [(=)].) *) end (** Functor for turning a plain container into an incremental one *) -module Make(D : DATA) : S with type 'a data = 'a D.data - and type 'a patch = 'a D.patch +module Make (D : DATA) : + S with type 'a data = 'a D.data and type 'a patch = 'a D.patch