atom.ml

type meta

type 'a t = {
  state: 'a ref;
  meta: meta option;
  validator: 'a validator option;
  watches: (int, 'a fn) Hashtbl.t;
}
and 'a validator = 'a -> bool
and 'a fn =
  int -> 'a t -> 'a -> 'a -> unit

let equal t1 t2 =
  !(t1.state) = !(t2.state)

let deref t =
  !(t.state)

let meta t =
  t.meta

let notifyWatches t oldV newV =
  Hashtbl.iter (fun key fn -> fn key t oldV newV) t.watches

let atom ?meta ?validator state =
  { state = ref(state);
    meta = meta;
    validator = validator;
    watches = Hashtbl.create(10)
  }

let addWatch t key fn =
  Hashtbl.add t.watches key fn

let removeWatch t key =
  Hashtbl.remove t.watches key

let reset t newV =
  match t.validator with
  | None ->
    begin
      let oldV = !(t.state) in
      t.state := newV;
      notifyWatches t oldV newV;
      (Result.Ok t.state)
    end
  | Some f ->
    if (f newV) then begin
      let oldV = !(t.state) in
      t.state := newV;
      notifyWatches t oldV newV;
      (Result.Ok t.state)
    end else
      (Result.Error "Validate failed.")

let swap t fn =
  reset t (fn !(t.state))

counter.re

open Atom;
let counter = atom(0);

let inc = () => {
  let _ = swap(counter, succ);
  Js.log("Counter: ");
  Js.log(deref(counter));
};


let make = (_children) =>
  Rum.make("ReactiveExample", () => <div>
           (Util.s2e(string_of_int(Rum.react(counter))))
           <br />
           <a onClick=((_e) => { inc() })>
           (Util.s2e("Increment"))
           </a>
</div>);

rum.ml

(* type 'a state = { *)
(*   id: int; *)
(*   atoms: 'a Atom.t list ref *)
(* } *)

type state = {
  id: int;
  atoms: int Atom.t list ref
}

let id = ref 0

let state = { id = (!id);
              atoms = (ref []) }

(* TODO: support old browsers *)
external requestAnimationFrame : (unit -> unit) -> unit = "" [@@bs.val]

let renderQueue = ref []

(* TODO: filter unmounted components *)
let renderAll queue =
  List.iter (fun comp ->
      (Obj.magic comp)##prototype##forceUpdate ()) queue

let render () =
  let queue = !renderQueue in
  renderQueue := [];
  renderAll queue

let requestRender component =
  if List.length !renderQueue = 0 then
    requestAnimationFrame render;
  renderQueue := component :: !renderQueue

let make componentName renderFn =
  let component = ReasonReact.reducerComponent componentName in
  {component with
   initialState = (fun ()  -> state);

   reducer = (fun () _ -> ReasonReact.NoUpdate);

   willUnmount = (fun { state } ->
       List.iter (fun atom  -> Atom.removeWatch atom state.id)
         (!(state.atoms)));

   render = (fun { state } ->
       let dom = renderFn () in
       List.iter (fun atom  -> Atom.addWatch atom state.id
                     (fun _ _ _ _ ->
                        Js.log component;
                        requestRender component.reactClassInternal;
                     )) !(state.atoms);
       dom
     )}

let react atom =
  state.atoms := atom :: !(state.atoms);
  Atom.deref atom