Bucklescript TEA debugger / inspector hooks

debug-not-working.ml

open Tea_app

type 'msg dmsg =
  | Client_msg of 'msg
[@@bs.deriving {accessors}]

let standardProgram : ('flags, 'model, 'msg) standardProgram -> Web.Node.t Js.null_undefined -> 'flags -> 'msg programInterface =
  fun {init; update; view; subscriptions} pnode args ->
    let dinit () =
      let model,cmd = init () in
      model, cmd |> Tea_cmd.map client_msg
    in

    let dupdate model = function
      | Client_msg msg ->
        let model',cmd = update model msg in
        model', cmd |> Tea_cmd.map client_msg
    in

    let dview model =
      model |> view |> Tea_app.map client_msg
    in

    let dsubscriptions model =
      model |> subscriptions |> Tea_sub.map client_msg
    in

    program {
      init = dinit;
      update = dupdate;
      view = dview;
      subscriptions = dsubscriptions;
      shutdown = fun _model -> Tea_cmd.none
    } pnode args

(* 
Results in compile error:

This has type:
    'msg dmsg Tea_app.programInterface (defined as
      < pushMsg : 'msg dmsg -> unit > Js.t)
  But somewhere wanted:
    'msg Tea_app.programInterface (defined as
      < pushMsg : 'msg -> unit > Js.t)
  The type variable 'msg occurs inside 'msg dmsg
*)

(* Intended usage *)
let () =
  Debug.standardProgram {
  (* standardProgram { *)
    init;
    update;
    view;
    subscriptions;
  } (Web.Document.getElementById "main") () |> ignore;;

debug-working.ml

module type StandardProgramType = sig
  type flags
  type model
  type msg
  val init : flags -> model * msg Tea.Cmd.t
  val update : model -> msg -> model * msg Tea.Cmd.t
  val view : model -> msg Vdom.t
  val subscriptions : model -> msg Tea.Sub.t
  val string_of_msg : msg -> string
end

module Make (Program : StandardProgramType) = struct
  type dmsg =
    | Client_msg of Program.msg
  [@@bs.deriving {accessors}]
  (* ... *)
end

(* Usage *)
let () =
  let module D = Debug.Make(struct
    type flags = unit
    type msg = my_msg
    type model = my_model
    let init = init
    let update = update
    let view = view
    let subscriptions = subscriptions
    let string_of_msg = function
      | Increment -> "Increment"
      | Decrement -> "Decrement"
      | Reset -> "Reset"
      | Set _ -> "Set"
  end) in
  D.standardProgram (Web.Document.getElementById "main") () |> ignore;;