Source file vue_nav.ml

open Mjs

(** navigation ML object *)
type push_obj =
  | PPath of {path : string; query : (string * string) list}
  | PName of {name : string; params : (string * any) list; query : (string * string) list}

(** get query params from ML object *)
let get_query = function
  | PPath {query; _} | PName {query; _} -> query

(** get params from ML object *)
let get_params = function
  | PName {params = (_ :: _) as params; _} -> Some params
  | _ -> None

(** navigation ML argument : string ot object *)
type push_arg = PStr of string | PObj of push_obj

(** navigation ML object constructor *)
let push_obj ?(params=[]) ?(query=[]) s =
  if s = "" then PStr "/"
  else if String.get s 0 = '/' then PObj (PPath {path = s; query})
  else PObj (PName {name = s; query; params})

(** navigation iterator argument for 'next' *)
type 'a next =
  | NUnit | NFalse | NRoute of push_obj | NError of error t
  | NFunction of ('a t -> unit)

(** navigation JS object signature *)
class type push_args = object
  method path : js_string t optdef readonly_prop
  method name : js_string t opt readonly_prop
  method params : any table optdef readonly_prop
  method query : js_string t table optdef readonly_prop
end

(** JS to ML *)
let to_push_obj (p : push_args t) =
  let query = match to_optdef (Table.itemsf to_string) p##.query with
    | None -> []
    | Some l -> l in
  match to_optdef to_string p##.path, to_opt to_string p##.name, to_optdef Table.items p##.params with
  | Some path, _, _ -> PPath {path; query}
  | None, Some name, None -> PName {name; query; params=[]}
  | None, Some name, Some params -> PName {name; query; params}
  | _ -> failwith "cannot read JS push object"

(** ML to JS *)
let of_push_obj p : push_args t =
  let path, name, params = match p with
    | PPath {path; _} -> def (string path), null, undefined
    | PName {name; params; _} ->
      undefined, some (string name), if params = [] then undefined else def (Table.make params) in
  let query = match p with PPath {query; _} | PName {query; _} ->
    if query = [] then undefined else def (Table.makef string query) in
  object%js
    val path = path
    val name = name
    val params = params
    val query = query
  end

(** wrapper for navigation guards that don't have access to this *)
let wrap_hook f =
  wrap_callback (fun to_ from next ->
      let next_arg = match f (to_push_obj to_) (to_push_obj from) with
        | NUnit -> to_any ()
        | NFalse -> to_any _false
        | NRoute r -> to_any (of_push_obj r)
        | NError e -> to_any e
        | NFunction f -> to_any @@ wrap_callback f in
      next next_arg)

(** wrapper for navigation guards that have access to this *)
let wrap_meth_hook f =
  wrap_meth_callback (fun this to_ from next ->
      let next_arg = match f this (to_push_obj to_) (to_push_obj from) with
        | NUnit -> to_any ()
        | NFalse -> to_any _false
        | NRoute r -> to_any (of_push_obj r)
        | NError e -> to_any e
        | NFunction _ ->
          Firebug.console##warn (string "cannot have a callback in this hook");
          assert false in
      next next_arg)