Better AJAX UIs
with
Functional Reactive Programming

jake@donham.org

Better?

Not (necessarily)

  • faster
  • prettier

But

  • less code
  • easier to reason about
  • fewer bugs
  • (more time to make it faster / prettier)

GUIs are hard!

Typical GUI impl consists of

  • state
  • events
  • callbacks (a.k.a. observers)

Problems:

  • state + concurrency = pain
  • unmodular: callback soup, control inversion

Adobe: 1/3 code and 1/2 bugs due to event handling

GUIs should not be hard!

Model: var e = new Elephant();

View:

View is a function of model, model is a function of events.

Functional reactive programming: write them that way!

Slogan: Dependencies, not callbacks.

OCaml

  • OCaml: a nice programming language
    Javascript OCaml
    f(x, y) f x y
    foo.bar(x) foo#bar x
    Foo.bar(x) Foo.bar x
    function (x) { ... } fun x -> ...
    var x = ...; let x = ... in
    x ? y : z if x then y else z
    val foo : int -> string
    type 'a t = ...
  • ocamljs: compiles OCaml to Javascript
  • Froc, Dom, Froc_dom: FRP library, access to DOM

Behaviors

A disembodied spreadsheet cell:

  type 'a behavior

Example: + 1 =

  let input = Dom.document#getElementById "input" in
  let value = Froc_dom.input_value_b input in ...

  val lift : ('a -> 'b) -> 'a behavior -> 'b behavior

  let int_value = Froc.lift int_of_string value in
  let incr = Froc.lift (fun x -> x + 1) int_value in

Dependents updated on changes.

Glitch-free update

Example: let x = in x + 2 * x =

  let value = ... in
  let x = Froc.lift int_of_string value in
  let double = Froc.lift (fun x -> 2 * x) x in
  let triple = Froc.lift2 (fun s d -> s + d) x double in

Must update in consistent order:

Update all behavior's deps before the behavior.

Dynamic dependencies

Example: let x = in if x = 0 then 0 else 100 / x =

  val return : 'a -> 'a behavior
  val bind : 'a behavior -> ('a -> 'b behavior) -> 'b behavior

  let x = ... in
  let b = Froc.lift (fun x -> x = 0) x in
  let result =
    Froc.bind b (fun b ->
                   if b
                   then Froc.return 0
                   else Froc.lift (fun x -> 100 / x) x) in

Dependencies in scope of bind are removed on updates.

Compare:

  let div_x = Froc.lift (fun x -> 100 / x) x in
  let result = Froc.bind (fun b -> if b then Froc.return 0 else div_x) in

Notifications

To do something with a behavior:

  Froc.notify_b innerHTML (fun s -> e#_set_innerHTML s);

Or:

  Froc_dom.attach_innerHTML_b e innerHTML;

"Hey, wait, that's just a callback!"

Yes, but:

  • you only need them at the edge of the graph
  • glitch-free, dynamic dependencies handled

Alternative: build behavior of whole UI, call notify_b once

Example: Fritter

What's happening?

140



  let text = Dom.document#getElementById "text" in
  let count = Dom.document#getElementById "count" in
  let tweet = Dom.document#getElementById "tweet" in

  let length =
    Froc.lift String.length (Froc_dom.input_value_b ~event:"keyup" text) in

  let left = Froc.lift (fun x -> 140 - x) length in

  let color =
    Froc.lift
      (fun x -> if x < 10 then "#D40D12" else if x < 20 then "#5C0002" else "#CCC")
      left in

  let disabled = Froc.lift (fun x -> x < 0) left in

  Froc_dom.attach_innerHTML_b count (Froc.lift string_of_int left);
  Froc_dom.attach_color_b count color;
  Froc_dom.attach_disabled_b tweet disabled;
        

Example: Sudoku

Example: Sudoku source

  type square = {
    i : int;
    j : int;
    cell : int option Froc.behavior;
    input : Dom.input;
  }

  let squares = ...

  let adjacents { i = i; j = j } =
    let adj { i = i'; j = j' } =
      (not (i' = i && j' = j)) &&
        (i' = i || j' = j ||
            (i' / 3 = i / 3 && j' / 3 = j / 3)) in
    List.map (fun sq -> sq.cell) (List.filter adj squares) in

  List.iter
    (fun sq ->
       let bg =
         Froc.bindN (adjacents sq)
           (fun adjs ->
              Froc.lift
                (fun v ->
                   if v <> None && List.mem v adjs
                   then "#ff0000"
                   else "#ffffff")
                sq.cell) in
       Froc_dom.attach_backgroundColor_b sq.input bg)
    squares;

Events

A disembodied event stream:

  type 'a event

Example:

has been clicked times.
has been shift-clicked times.
Either button has been clicked times.

  let button = Dom.document#getElementById "button" in
  let button2 = Dom.document#getElementById "button2" in

  let clicks = Froc_dom.clicks button in ...
  let count = Froc.count clicks in

  val filter : ('a -> bool) -> 'a event -> 'a event
  val merge : 'a event list -> 'a event

  let shift_clicks =
    Froc.filter (fun e -> e#_get_shiftKey) (Froc_dom.clicks button2) in
  let either_clicks = Froc.merge [ clicks; shift_clicks ] in

Example: Signup

Username
Password
Repeat password
  let (~$) x = Dom.document#getElementById x in
  let (~<) x = Froc_dom.input_value_b ~$x in

  let password_ok =
    Froc.blift2 ~<"password" ~<"password2" begin fun p p2 ->
      match p, p2 with
        | "", _ | _, "" -> `Unset
        | p, p2 when p = p2 -> `Ok
        | _ -> `Mismatch
    end in

  let username_ok = ...

  Froc_dom.attach_innerHTML_b ~$"password_ok"
    (Froc.blift password_ok begin function
       | `Unset -> ""
       | `Ok -> "ok"
       | `Mismatch -> "mismatch"
     end);

  Froc_dom.attach_disabled_b ~$"signup"
    (Froc.bliftN [ password_ok; username_ok ] begin fun oks ->
       not (List.for_all (function `Ok -> true | _ -> false) oks)
     end);

Example: Signup source

  let check_username = function
    | "jaked" -> `Taken
    | _ -> `Ok in

  let check_username_rpc :
    string event -> (string * [`Taken|`Ok|`Checking]) event = ...

  let (|>) x f = f x

  val map : ('a -> 'b) -> 'a event -> 'b event

  let maybe_check_username reqs =
    Froc.merge [
      reqs |> Froc.filter (fun req -> req = "") |> Froc.map (fun _ -> "", `Unset);
      reqs |> Froc.filter (fun req -> req <> "") |> check_username_rpc;
    ] in

  val changes : 'a behavior -> 'a event
  val sample : 'a behavior -> 'a
  val hold : 'a -> 'a event -> 'a behavior

  let username_ok =
    let username = ~<"username" in
    Froc.changes username |>
      maybe_check_username |>
        Froc.filter (fun (req, _) -> Froc.sample username = req) |>
          Froc.map (fun (_, res) -> res) |>
            Froc.hold `Unset in

Example: Bounce

  • ball position defined by velocity
  • velocity defined by collisions (events)
  • collisions defined by ball position

Example: Bounce source

val when_true : bool behavior -> unit event
val collect_b : ('b -> 'a -> 'b) -> 'b -> 'a event -> 'b behavior
val fix_b : ('a behavior -> 'a behavior) -> 'a behavior

let ball_point =
  F.fix_b begin fun bp ->
    let x_out_of_bounds =
      bp |>
        F.lift (fun (x, _) -> x <= xmin || x >= xmax) |>
          F.when_true |>
            F.map (fun () -> `X_bounds) in

    let v =
      F.fix_b begin fun v ->
        F.merge [ xy_out_of_bounds; x_out_of_bounds; y_out_of_bounds; hit_paddle ] |>
          F.map begin fun e ->
            let (vx, vy) = F.sample v in
            let (x, y) = F.sample bp in
            match e with
              | `X_bounds -> (-.vx, vy)
              | `Y_bounds -> (vx, -.vy)
              | `Xy_bounds -> (-.vx, -.vy)
              | `Paddle -> ... (* bounce v off the tangent to the paddle *)
          end |>
            F.hold init_v
      end in

    Fd.ticks 20. |>
      F.collect_b
        (fun (x, y) () -> let vx, vy = F.sample v in (x +. vx, y +. vy))
        init_p
  end in

Why OCaml for FRP?

OCaml is a sweet-spot for FRP:

  • value-oriented
  • functions are data
  • static typing, types inferred
  • imperative implementation possible

Thanks!

Takeaways:

  • functional programming matters
  • types matter

Code:

  • http://github.com/jaked/froc
  • http://github.com/jaked/ocamljs
/