pax_global_header00006660000000000000000000000064142332317430014514gustar00rootroot0000000000000052 comment=c72638b21d2a088ba3f1603f3eae32256d65f46f reactiveData-0.3/000077500000000000000000000000001423323174300137525ustar00rootroot00000000000000reactiveData-0.3/.gitignore000066400000000000000000000000741423323174300157430ustar00rootroot00000000000000_build *~ \#*# .#* reactiveData.install api.docdir doc/html reactiveData-0.3/.merlin000066400000000000000000000000701423323174300152360ustar00rootroot00000000000000S src/* B _build/* PKG react FLG -warn A-4-40-42-44-48 reactiveData-0.3/CHANGES.md000066400000000000000000000010721423323174300153440ustar00rootroot00000000000000## 0.2.3 * port to dune from ocamlbuild * Add support for ocaml 5.0 ## 0.2.2 * additional functions in RList and RMap * do not use a generic hashtable as it does not work with functional values ## 0.2.1 * Add ?eq parameter to S.signal ## 0.2 * Add `from_signal`, which converts React signals to ReactiveData containers. `from_signal` uses a diffing algorithm to detect what changes, thus minimizing the updates needed downstream. * Optimize common cases of `merge`. * Provide documentation and make the naming more consistent. ## 0.1 * First public release reactiveData-0.3/LICENSE000066400000000000000000000206551423323174300147670ustar00rootroot00000000000000This program is released under the LGPL version 3 (see the text below) with the additional exemption that compiling, linking, and/or using OpenSSL is allowed. As a special exception to the GNU Library General Public License, you may also link, statically or dynamically, a "work that uses the Library" with a publicly distributed version of the Library to produce an executable file containing portions of the Library, and distribute that executable file under terms of your choice, without any of the additional requirements listed in clause 6 of the GNU Library General Public License. By "a publicly distributed version of the Library", we mean either the unmodified Library, or a modified version of the Library that is distributed under the conditions defined in clause 3 of the GNU Library General Public License. This exception does not however invalidate any other reasons why the executable file might be covered by the GNU Library General Public License. GNU LESSER GENERAL PUBLIC LICENSE Version 3, 29 June 2007 Copyright (C) 2007 Free Software Foundation, Inc. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. This version of the GNU Lesser General Public License incorporates the terms and conditions of version 3 of the GNU General Public License, supplemented by the additional permissions listed below. 0. Additional Definitions. As used herein, "this License" refers to version 3 of the GNU Lesser General Public License, and the "GNU GPL" refers to version 3 of the GNU General Public License. "The Library" refers to a covered work governed by this License, other than an Application or a Combined Work as defined below. An "Application" is any work that makes use of an interface provided by the Library, but which is not otherwise based on the Library. Defining a subclass of a class defined by the Library is deemed a mode of using an interface provided by the Library. A "Combined Work" is a work produced by combining or linking an Application with the Library. The particular version of the Library with which the Combined Work was made is also called the "Linked Version". The "Minimal Corresponding Source" for a Combined Work means the Corresponding Source for the Combined Work, excluding any source code for portions of the Combined Work that, considered in isolation, are based on the Application, and not on the Linked Version. The "Corresponding Application Code" for a Combined Work means the object code and/or source code for the Application, including any data and utility programs needed for reproducing the Combined Work from the Application, but excluding the System Libraries of the Combined Work. 1. Exception to Section 3 of the GNU GPL. You may convey a covered work under sections 3 and 4 of this License without being bound by section 3 of the GNU GPL. 2. Conveying Modified Versions. If you modify a copy of the Library, and, in your modifications, a facility refers to a function or data to be supplied by an Application that uses the facility (other than as an argument passed when the facility is invoked), then you may convey a copy of the modified version: a) under this License, provided that you make a good faith effort to ensure that, in the event an Application does not supply the function or data, the facility still operates, and performs whatever part of its purpose remains meaningful, or b) under the GNU GPL, with none of the additional permissions of this License applicable to that copy. 3. Object Code Incorporating Material from Library Header Files. The object code form of an Application may incorporate material from a header file that is part of the Library. You may convey such object code under terms of your choice, provided that, if the incorporated material is not limited to numerical parameters, data structure layouts and accessors, or small macros, inline functions and templates (ten or fewer lines in length), you do both of the following: a) Give prominent notice with each copy of the object code that the Library is used in it and that the Library and its use are covered by this License. b) Accompany the object code with a copy of the GNU GPL and this license document. 4. Combined Works. You may convey a Combined Work under terms of your choice that, taken together, effectively do not restrict modification of the portions of the Library contained in the Combined Work and reverse engineering for debugging such modifications, if you also do each of the following: a) Give prominent notice with each copy of the Combined Work that the Library is used in it and that the Library and its use are covered by this License. b) Accompany the Combined Work with a copy of the GNU GPL and this license document. c) For a Combined Work that displays copyright notices during execution, include the copyright notice for the Library among these notices, as well as a reference directing the user to the copies of the GNU GPL and this license document. d) Do one of the following: 0) Convey the Minimal Corresponding Source under the terms of this License, and the Corresponding Application Code in a form suitable for, and under terms that permit, the user to recombine or relink the Application with a modified version of the Linked Version to produce a modified Combined Work, in the manner specified by section 6 of the GNU GPL for conveying Corresponding Source. 1) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (a) uses at run time a copy of the Library already present on the user's computer system, and (b) will operate properly with a modified version of the Library that is interface-compatible with the Linked Version. e) Provide Installation Information, but only if you would otherwise be required to provide such information under section 6 of the GNU GPL, and only to the extent that such information is necessary to install and execute a modified version of the Combined Work produced by recombining or relinking the Application with a modified version of the Linked Version. (If you use option 4d0, the Installation Information must accompany the Minimal Corresponding Source and Corresponding Application Code. If you use option 4d1, you must provide the Installation Information in the manner specified by section 6 of the GNU GPL for conveying Corresponding Source.) 5. Combined Libraries. You may place library facilities that are a work based on the Library side by side in a single library together with other library facilities that are not Applications and are not covered by this License, and convey such a combined library under terms of your choice, if you do both of the following: a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities, conveyed under the terms of this License. b) Give prominent notice with the combined library that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 6. Revised Versions of the GNU Lesser General Public License. The Free Software Foundation may publish revised and/or new versions of the GNU Lesser General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Library as you received it specifies that a certain numbered version of the GNU Lesser General Public License "or any later version" applies to it, you have the option of following the terms and conditions either of that published version or of any later version published by the Free Software Foundation. If the Library as you received it does not specify a version number of the GNU Lesser General Public License, you may choose any version of the GNU Lesser General Public License ever published by the Free Software Foundation. If the Library as you received it specifies that a proxy can decide whether future versions of the GNU Lesser General Public License shall apply, that proxy's public statement of acceptance of any version is permanent authorization for you to choose that version for the Library.reactiveData-0.3/Makefile000066400000000000000000000001611423323174300154100ustar00rootroot00000000000000.PHONY: build clean doc test build: dune build test: dune runtest clean: dune clean doc: dune build @doc reactiveData-0.3/README.md000066400000000000000000000004521423323174300152320ustar00rootroot00000000000000**Reactive Data** *Functional reactive programming with incremental changes in data structures* ReactiveData is an OCaml module for functional reactive programming (FRP) based on React. It adds support to incremental changes in data structures by reasoning on patches instead of absolute values. reactiveData-0.3/RELEASE.md000066400000000000000000000002431423323174300153530ustar00rootroot00000000000000* To release: ``` opam install -y dune-release dune-release distrib # to test dune-release tag # git tag dune-release # upload and submit to opam ``` reactiveData-0.3/dune-project000066400000000000000000000000441423323174300162720ustar00rootroot00000000000000(lang dune 1.0) (name reactiveData) reactiveData-0.3/reactiveData.opam000066400000000000000000000020051423323174300172210ustar00rootroot00000000000000opam-version: "2.0" version: "0.2.2" 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: "Hugo Heuzard " authors: ["Hugo Heuzard "] 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: [ "ocaml" {>= "4.08"} "dune" {>= "1.0"} "react" {>= "1.2.1" < "1.3"} ] build: [ ["dune" "subst"] {dev} ["dune" "build" "-p" name "-j" jobs] ["dune" "runtest" "-p" name "-j" jobs] {with-test} ] reactiveData-0.3/src/000077500000000000000000000000001423323174300145415ustar00rootroot00000000000000reactiveData-0.3/src/dune000066400000000000000000000001221423323174300154120ustar00rootroot00000000000000(library (name reactiveData) (public_name reactiveData) (libraries react) ) reactiveData-0.3/src/reactiveData.ml000066400000000000000000000552461423323174300175030ustar00rootroot00000000000000(* ReactiveData * https://github.com/hhugo/reactiveData * Copyright (C) 2014 Hugo Heuzard * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, with linking exception; * either version 2.1 of the License, or (at your option) any later version. * * 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 Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser 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. *) 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 val empty : 'a data 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 map_msg : ('a -> 'b) -> 'a msg -> 'b msg val map : ('a -> 'b) -> 'a t -> 'b t val value : 'a t -> 'a data val fold : ('a -> 'b msg -> 'a) -> 'b t -> 'a -> 'a React.signal val signal : ?eq:('a -> 'a -> bool) -> 'a t -> 'a data React.S.t 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 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 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 let empty = Const D.empty let create l = 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 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 const x = Const x let map_msg (f : 'a -> 'b) : 'a msg -> 'b msg = function | Set l -> Set (map_data f l) | Patch p -> Patch (map_patch f p) let map f s = 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 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 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 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 patch = 'a p list let empty = [] let map_data = List.map let map_patch f = function | I (i,x) -> I (i, f x) | R i -> R i | 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 | 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 (* accumulates into acc i unmodified elements from l *) let rec linear_merge_fwd ~acc i l = assert (i >= 0); 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 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 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" 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 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 let rec equal f l1 l2 = 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 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 rec f ~acc ~left lx ly n = match lx, ly with (* trailing elements to be removed *) | _ :: lx, [] -> 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) (* done! *) | [], [] -> acc (* same *) | 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 (* 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) (* 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 | _ :: _, y :: ly -> 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 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 index ?(eq = (=)) l x = let rec f n = function | hd :: _ when eq hd x -> n | _ :: tl -> f (n + 1) tl | [] -> raise Not_found in f 0 l let update_eq ?eq (data, handle) x y = 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_eq ?eq (data, handle) x = let i = index ?eq (value data) x in remove i handle let singleton x = const [x] let singleton_s s = let first = ref true 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 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 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 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 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 | _ -> 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 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 rev 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 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 | [] -> 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 in size := List.length l; index := IntMap.empty; List.rev (aux l [] 0 (-1)) in let normalise i = if i < 0 then !size + 1 + i else i in 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 | None -> updatables | Some displaced_in_filtered -> 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 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 in 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 update_j j_full_list j_filtered_list = 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 let last_i, _ = IntMap.max_binding !index in index := IntMap.remove last_i !index else (); decr size; IntMap.iter update_j updatables in let update_index_update_delete update_pos_full_list = let _, _, updatables = IntMap.split update_pos_full_list !index in let update_j j_full_list j_filtered_list = index := IntMap.add j_full_list (j_filtered_list - 1) !index in index := IntMap.remove update_pos_full_list !index; IntMap.iter update_j updatables in let update_index_update_insert update_pos_full_list = 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 previous_pos_filtered + 1 in index := IntMap.add update_pos_full_list new_pos_filtered_list !index; IntMap.iter update_j updatables; new_pos_filtered_list 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 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 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 -> () done else for i_full = from_full_list - 1 downto to_full_list do try let delta = if was_visible then 1 else 0 in 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 -> () 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 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 | 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 small_ones, _, _ = IntMap.split origin_full !index in 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 -> (* 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)) in let e = React.E.map filter_e (event l) in from_event (filter_list (value l)) e module IntSet = Set.Make (Int) let for_all fn data = let maybe_update acc i v = if fn v then acc else IntSet.add i acc in let init = let rec fold i acc = function | v :: tl -> fold (i + 1) (maybe_update acc i v) tl | [] -> acc in fold 0 IntSet.empty in 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 in React.S.fold f (init (value data)) (event data) |> React.S.map IntSet.is_empty end 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 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 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_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 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 and acc = [] in List.rev (M.fold g m acc) end 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] in let filter_e = function | Set m -> Set (M.filter pred m) | Patch p -> Patch (List.concat (List.map convert_p p)) in let e = React.E.map filter_e (event m) in from_event (M.filter pred (value m)) e end reactiveData-0.3/src/reactiveData.mli000066400000000000000000000220211423323174300176350ustar00rootroot00000000000000(* ReactiveData * https://github.com/ocsigen/reactiveData * Copyright (C) 2014 Hugo Heuzard * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, with linking exception; * either version 2.1 of the License, or (at your option) any later version. * * 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 Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser 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. *) (** 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]. *) (** Signature describing a reactive data structure (['a t]). 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 (** Raw (non-reactive) version of the data container *) type 'a data (** Patch format *) type 'a patch (** 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 *) (** Handle that permits applying incremental updates *) type 'a handle (** Empty data structure *) val empty : 'a t (** Build a container from initial contents. The handle can be used for performing reactive updates. *) val create : 'a data -> 'a t * 'a handle (** [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 (** 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 (** Produce a constant container *) val const : 'a data -> 'a t (** [patch h p] applies [p] on the container corresponding to [h] *) val patch : 'a handle -> 'a patch -> unit (** [set h d] sets the contents of the container corresponding to [h], disregarding previous contents *) val set : 'a handle -> 'a data -> unit (** Transform a message *) val map_msg : ('a -> 'b) -> 'a msg -> 'b msg (** [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 (** Return current contents *) val value : 'a t -> 'a data (** [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 (** 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 end (** Reactive list data structure *) 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 *) | 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 *) (** 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. 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 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 end *) val snoc : 'a -> '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. *) val insert : 'a -> 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 : int -> 'a handle -> unit (** [remove_last a] removes the last element of [a] *) val remove_last : ('a t * 'a handle) -> 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 (** [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 (** [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 (** Produce container list containing a single, constant element *) val singleton : 'a -> 'a t (** Produce reactive list containing a single element that gets updated based on a signal *) val singleton_s : 'a React.S.t -> 'a t (** [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 (** [rev a] is the reversal of [a]; [rev a] gets updated along with [a] *) val rev : '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 *) 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 end (** Reactive map data structure *) 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 (** [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 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]). *) module type DATA = sig (** Data container *) type 'a data (** Patch format for modifying the container *) type 'a patch (** 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 (** Transform a patch *) val map_patch : ('a -> 'b) -> 'a patch -> 'b 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 (** Empty container *) val empty : 'a data (** 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 (** [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 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