Source file types.ml

open Ezjs_min

type site_metadata = {
  name: string;
  icon: string option;
  url: string;
} [@@deriving jsoo]

type request_source = [
  | `api of site_metadata
  | `client
] [@@deriving jsoo]

type 'input request_aux = {
  req_id: int;
  req_src: request_source;
  req_input: 'input;
} [@@deriving jsoo]

type 'output response_aux = {
  res_id: int;
  res_src: ([ `background ] [@enum]);
  res_output: 'output;
  res_ok: bool;
} [@@deriving jsoo]

module type S = sig
  type request
  type request_jsoo
  val request_jsoo_conv :
    (request -> request_jsoo t) * (request_jsoo t -> request)

  type response_ok
  type response_ok_jsoo
  val response_ok_jsoo_conv :
    (response_ok -> response_ok_jsoo t) * (response_ok_jsoo t -> response_ok)

  type response_error
  type response_error_jsoo
  val response_error_jsoo_conv :
    (response_error -> response_error_jsoo t) * (response_error_jsoo t -> response_error)
end

module Make(S : S) = struct

  type response_error_aux = [
    | `generic of (string * string)
    | `custom of S.response_error
  ]

  type response = (S.response_ok, response_error_aux) result
  type response_jsoo = Unsafe.any

  let response_of_jsoo (js: response_jsoo) : response =
      try Ok ((snd S.response_ok_jsoo_conv) (Unsafe.coerce js))
      with _ ->
      try Error (`custom ((snd S.response_error_jsoo_conv) (Unsafe.coerce js)))
      with _ ->
        Error (`generic (to_string (Unsafe.coerce js)##.name,
                         to_string (Unsafe.coerce js)##.msg))

  let response_to_jsoo : response -> response_jsoo = function
    | Ok r -> Unsafe.coerce @@ (fst S.response_ok_jsoo_conv) r
    | Error (`custom e) -> Unsafe.coerce @@ (fst S.response_error_jsoo_conv) e
    | Error (`generic (name, msg)) ->
      Unsafe.coerce (object%js
        val name = string name
        val message = string msg
        method toString = string ("Error " ^ name ^ ": " ^ msg)
      end)

  let response_jsoo_conv = response_to_jsoo, response_of_jsoo
end

type 'a account_aux = [
  | `not_enabled
  | `not_approved
  | `locked
  | `connected of 'a
] [@@deriving jsoo]

module type SAccount = sig
  module S : S
  type account
  type account_jsoo
  val account_of_jsoo : account_jsoo t -> account
  val account_to_jsoo : account -> account_jsoo t
end