Source file ppx.ml

open Ppxlib
open Ast_builder.Default

type prop = {
  key: string;
  typ: core_type option;
  cons: expression option;
  dft: expression option;
  validator: expression option;
  req: bool;
  convert: bool;
}

type acc = {
  name: string option;
  globals: (string * core_type option * expression * bool) list;
  datas: (string * core_type option * expression * bool) list;
  methods: (string * core_type option * expression * bool) list;
  computeds: (string * core_type option * expression * bool) list;
  watchs: (string * core_type option * expression * bool) list;
  directives: string list;
  props: prop list;
  template: [`string of string | `expression of expression] option;
  lifecycle: (string * expression) list;
  emits: string list;
  compile: bool;
  debug: bool;
  types: bool;
  convert_all: bool;
  modules: (string * string) list option;
}

let empty_acc = {
  name=None; globals=[]; datas=[]; methods=[]; computeds=[]; watchs=[]; props=[];
  template=None; lifecycle=[]; emits=[]; compile=false; debug=false; types=false;
  convert_all=false; modules=None; directives=[];
}

let get_str_pat p = match p.ppat_desc with
  | Ppat_var {txt; _} -> txt
  | Ppat_any -> "_"
  | Ppat_constraint ({ppat_desc=Ppat_var {txt; _}; _}, _) -> txt
  | Ppat_constraint ({ppat_desc=Ppat_any; _}, _) -> "_"
  | _ -> Location.raise_errorf ~loc:p.ppat_loc "pattern expected to be '_', a variable or a constraint of these patterns"

let get_list_expression e =
  let rec aux acc e = match e.pexp_desc with
    | Pexp_construct ({txt=Lident "[]"; _}, None) -> acc
    | Pexp_construct ({txt=Lident "::"; _}, Some {pexp_desc=Pexp_tuple [e1; e2]; _}) ->
      aux (e1 :: acc) e2
    | _ -> Location.raise_errorf ~loc:e.pexp_loc "wrong expression for a list" in
  List.rev (aux [] e)

let remove_poly c = match c.ptyp_desc with
  | Ptyp_poly (_, c) -> c
  | _ -> c

let rec get_exit_type e = match e.pexp_desc with
  | Pexp_fun (_, _, _, e) -> get_exit_type e
  | Pexp_constraint (_, c) -> Some (remove_poly c)
  | _ -> None

let js_mod, dom_mod = match Sys.getenv_opt "VUE_MODULE" with
  | Some s ->
    Ppx_deriving_jsoo_lib.Ppx_js.wrapper := Some s;
    begin match String.rindex_opt s '.' with
      | None -> ref s, ref (s ^ "." ^ "Dom_html")
      | Some i ->
        ref s, ref (String.sub s 0 i ^ "Dom_html")
    end
  | _ ->
    ref "Ezjs_min", ref "Ezjs_min.Dom_html"

let vue_compiler = match Sys.getenv_opt "VUE_COMPILER", Sys.getenv_opt "OPAM_SWITCH_PREFIX" with
  | Some s, _ -> ref s
  | _, Some s -> ref (Filename.concat s "bin/vue-compiler")
  | _ -> ref "src/render.bundle.js"

let vue_compile = match Sys.getenv_opt "VUE_COMPILE" with
  | Some ("true"|"1") -> ref true
  | _ -> ref false

let vue_debug = match Sys.getenv_opt "VUE_DEBUG" with
  | Some "true" | Some "1" -> ref true
  | _ -> ref false

let jstyp ~loc s arg =
  ptyp_constr ~loc {txt=Longident.parse (!js_mod ^ "." ^ s); loc} arg
let jsid ~loc s = evar ~loc (!js_mod ^ "." ^ s)
let jsapp ~loc s l = eapply ~loc (jsid ~loc s) l
let domtyp ~loc s arg =
  ptyp_constr ~loc {txt=Longident.parse (!dom_mod ^ "." ^ s); loc} arg
let domid ~loc s = evar ~loc (!dom_mod ^ "." ^ s)

let field_name s =
  let s = match String.rindex_opt s '_' with
    | None -> s
    | Some i when i = String.length s - 1 -> s
    | Some _ -> s ^ "_" in
  match String.get s 0 with
  | 'A'..'Z' -> "_" ^ s
  | _ | exception _ -> s

let kebab s =
  String.fold_left (fun acc c -> match c with
    | '_' -> acc ^ "-"
    | 'A'..'Z' ->
      let acc = if acc = "" then "" else acc ^ "-" in
      acc ^ String.make 1 (Char.chr @@ Char.code c + 32)
    | c -> acc ^ String.make 1 c) "" s

let hooks = [
  "beforeCreate"; "created"; "beforeMount"; "mounted"; "beforeUpdate";
  "updated"; "beforeUnmount"; "unmounted"]

let instances = [
  "data"; "props"; "el"; "options"; "parent"; "root"; "slots"; "refs"; "attrs";
  "ref" ]

let converted_type acc convert c =
  if convert then
    match Ppx_deriving_jsoo_lib.Jsoo_type.type_of_core ~name:"" ~params:[] ?modules:acc.modules c with
    | Ppx_deriving_jsoo_lib.Common.TT c, _ -> c
    | Ppx_deriving_jsoo_lib.Common.CT c, _ -> jstyp ~loc:c.ptyp_loc "t" [ c ]
  else c

let converted_expr ?(of_=false) acc convert c e =
  match convert, c with
  | true, Some c ->
    let c = remove_poly c in
    let m = Ppx_deriving_jsoo_lib.Jsoo_conv.expr_of_core ~name:"" ~params:[] ?modules:acc.modules c in
    let conv = if of_ then m.Ppx_deriving_jsoo_lib.Common.e_of else m.Ppx_deriving_jsoo_lib.Common.e_to in
    eapply ~loc:e.pexp_loc conv [ e ]
  | _ -> e

let data_type_fields ~loc acc =
  List.map (fun (k, c, _, convert) ->
    let c = Option.fold ~none:(ptyp_any ~loc) ~some:(converted_type acc convert) c in
    otag ~loc {txt=field_name k; loc} @@
    jstyp ~loc "prop" [c]) acc.datas

let data_class_type_fields ~loc acc =
  List.map (fun (k, c, _, convert) ->
    let c = Option.fold ~none:(ptyp_any ~loc) ~some:(converted_type acc convert) c in
    pctf_method ~loc ({txt=field_name k; loc}, Public, Concrete, jstyp ~loc "prop" [c])
  ) acc.datas

let global_type_fields ~loc acc =
  List.map (fun (k, c, _, convert) ->
    let c = Option.fold ~none:(ptyp_any ~loc) ~some:(converted_type acc convert) c in
    otag ~loc {txt=field_name k; loc} @@
    jstyp ~loc "readonly_prop" [c]) acc.globals

let computed_type_fields ~loc acc =
  List.map (fun (k, c, _, convert) ->
    let c = Option.fold ~none:(ptyp_any ~loc) ~some:(converted_type acc convert) c in
    otag ~loc {txt=field_name k; loc} @@
    jstyp ~loc "readonly_prop" [c]) acc.computeds

let computed_class_type_fields ~loc acc =
  List.map (fun (k, c, _, convert) ->
    let c = Option.fold ~none:(ptyp_any ~loc) ~some:(converted_type acc convert) c in
    pctf_method ~loc ({txt=field_name k; loc}, Public, Concrete, jstyp ~loc "readonly_prop" [c])
  ) acc.computeds

let prop_type_fields ~loc acc =
  List.map (fun p ->
    let c = Option.fold ~none:(ptyp_any ~loc) ~some:(converted_type acc p.convert) p.typ in
    otag ~loc {txt=field_name p.key; loc} @@
    jstyp ~loc "readonly_prop" [c]) acc.props

let prop_class_type_fields ~loc acc =
  List.map (fun p ->
    let c = Option.fold ~none:(ptyp_any ~loc) ~some:(converted_type acc p.convert) p.typ in
    pctf_method ~loc ({txt=field_name p.key; loc}, Public, Concrete, jstyp ~loc "readonly_prop" [c])
  ) acc.props

let method_type_fields ~loc acc =
  let rec aux ?(first=true) e = match e.pexp_desc, first with
    | Pexp_fun (_, _, _, e), true -> aux ~first:false e
    | Pexp_fun (_, _, {ppat_desc=Ppat_constraint (_, c); _}, e), _ ->
      ptyp_arrow ~loc Nolabel (remove_poly c) (aux ~first:false e)
    | Pexp_fun (_, _, _, e), _ ->
      ptyp_arrow ~loc Nolabel (ptyp_any ~loc) (aux ~first:false e)
    | Pexp_constraint (_, c), _ -> jstyp ~loc "meth" [remove_poly c]
    | _ -> jstyp ~loc "meth" [ptyp_any ~loc] in
  List.map (fun (k, _, e, _) ->
    let c = aux e in
    otag ~loc {txt=field_name k; loc} @@ c) acc.methods

let method_class_type_fields ~loc acc =
  let rec aux ?(first=true) e = match e.pexp_desc, first with
    | Pexp_fun (_, _, _, e), true -> aux ~first:false e
    | Pexp_fun (_, _, {ppat_desc=Ppat_constraint (_, c); _}, e), _ ->
      ptyp_arrow ~loc Nolabel (remove_poly c) (aux ~first:false e)
    | Pexp_fun (_, _, _, e), _ ->
      ptyp_arrow ~loc Nolabel (ptyp_any ~loc) (aux ~first:false e)
    | Pexp_constraint (_, c), _ -> jstyp ~loc "meth" [remove_poly c]
    | _ -> jstyp ~loc "meth" [ptyp_any ~loc] in
  List.map (fun (k, _, e, _) ->
    let c = aux e in
    pctf_method ~loc ({txt=field_name k; loc}, Public, Concrete, c)) acc.methods

let app_type ~loc acc =
  let global_type =
    let fields = global_type_fields ~loc acc in
    let ct = ptyp_object ~loc fields Closed in
    jstyp ~loc "t" [ct] in
  if acc.types then
    jstyp ~loc "t" [
      ptyp_object ~loc [
        oinherit ~loc (ptyp_constr ~loc {txt=Lident "all"; loc} []);
        oinherit ~loc [%type: (_, _, _, _, _, _, _, [%t global_type]) Vue.app]
      ] Closed
    ]
  else
    let fields =
      data_type_fields ~loc acc @ prop_type_fields ~loc acc @
      computed_type_fields ~loc acc @ method_type_fields ~loc acc @
      [ oinherit ~loc [%type: (_, _, _, _, _, _, _, [%t global_type]) Vue.app] ] in
    let ct = ptyp_object ~loc fields Closed in
    jstyp ~loc "t" [ct]

let vue_type ~loc acc =
  if acc.types then
    Some (jstyp ~loc "t" [ptyp_constr ~loc {txt=Lident "all"; loc} []])
  else
    let fields =
      data_type_fields ~loc acc @ prop_type_fields ~loc acc @ computed_type_fields ~loc acc @ method_type_fields ~loc acc in
    match fields with
    | [] -> None
    | _ ->
      let ct = ptyp_object ~loc fields Closed in
      Some (jstyp ~loc "t" [ct])

let all_types ~loc acc =
  pstr_class_type ~loc @@
  List.map (fun (name, fields) ->
    let name = {txt=name; loc} in
    class_infos ~loc ~virt:Concrete ~params:[] ~name
      ~expr:(pcty_signature ~loc @@ class_signature ~self:(ptyp_any ~loc) ~fields)
  ) [
    "data", data_class_type_fields ~loc acc;
    "props", prop_class_type_fields ~loc acc;
    "computed", computed_class_type_fields ~loc acc;
    "methods", method_class_type_fields ~loc acc;
    "all", [ pctf_inherit ~loc (pcty_constr ~loc {txt=Lident "data"; loc} []);
             pctf_inherit ~loc (pcty_constr ~loc {txt=Lident "props"; loc} []);
             pctf_inherit ~loc (pcty_constr ~loc {txt=Lident "computed"; loc} []);
             pctf_inherit ~loc (pcty_constr ~loc {txt=Lident "methods"; loc} [])]
  ]

let render ~loc s =
  if not (String.contains s ' ') && not (Sys.file_exists !vue_compiler) then (
    Location.raise_errorf ~loc "vue-compiler not found at path: %S" !vue_compiler)
  else
    let ic = Unix.open_process_in @@ Filename.quote_command !vue_compiler [ s ] in
    let rec aux acc =
      try
        let s = input_line ic in
        aux (s :: acc)
      with _ ->
        close_in ic;
        String.concat "\n" @@ List.rev acc in
    let code = String.trim @@ aux [] in
    match Unix.close_process_in ic with
    | Unix.WEXITED 0 ->
      jsapp ~loc "Unsafe.pure_js_expr" [estring ~loc code]
    | Unix.WEXITED i | Unix.WSIGNALED i | Unix.WSTOPPED i ->
      Location.raise_errorf ~loc "render compilation failed with code %d" i

let check_computed e = match e.pexp_desc with
  | Pexp_fun (_, _, p, _) -> Location.raise_errorf ~loc:p.ppat_loc "'computed' have only one argument"
  | _ -> e

type x = X of (string * x list)

let rec type_name c = match c.ptyp_desc with
  | Ptyp_constr ({txt; _}, l) ->
    let rec aux acc = function
      | [] -> Some acc
      | h :: tl -> match type_name h with
        | None -> None
        | Some x -> aux (acc @ [x]) tl in
    begin match aux [] l with
      | None -> None
      | Some l -> Some (X (Longident.name txt, l))
    end
  | _ -> None

let check_watch ~name acc e = match e.pexp_desc with
  | Pexp_fun (_, _, _, {pexp_desc=Pexp_fun (_, _, _, {pexp_desc=Pexp_fun (_, _, p, _); _}); _}) ->
    Location.raise_errorf ~loc:p.ppat_loc "'watch' have only 3 arguments"
  | Pexp_fun (_, _, p_new, {pexp_desc=Pexp_fun (_, _, p_old, elast); _}) ->
    let loc = e.pexp_loc in
    begin match p_new.ppat_desc, p_old.ppat_desc with
      | Ppat_constraint (_, c_new), Ppat_constraint (_, c_old) ->
        if type_name c_new = type_name c_old then e
        else Location.raise_errorf ~loc:c_old.ptyp_loc "'watch' should have same types for new and old value"
      | Ppat_constraint (_, c_new), _ ->
        pexp_fun ~loc Nolabel None p_new (pexp_fun ~loc Nolabel None (ppat_constraint ~loc p_old {c_new with ptyp_loc=p_old.ppat_loc}) elast)
      | _, Ppat_constraint (_, c_old) ->
        pexp_fun ~loc Nolabel None (ppat_constraint ~loc p_new {c_old with ptyp_loc=p_new.ppat_loc}) (pexp_fun ~loc Nolabel None p_old elast)
      | _ ->
        let c = match List.find_opt (fun (k, _) -> k = name) @@
            (List.map (fun (k, c, _, _) -> k, c) acc.datas) @ (List.map (fun p -> p.key, p.typ) acc.props) with
        | Some (_, Some c) -> c
        | _ -> ptyp_var ~loc (name ^ "_arg") in
        pexp_fun ~loc Nolabel None (ppat_constraint ~loc p_new c)
          (pexp_fun ~loc Nolabel None (ppat_constraint ~loc p_old c) elast)
    end
  | _ -> Location.raise_errorf ~loc:e.pexp_loc "'watch' needs 3 arguments (this, new, old)"

let check_lifecycle e = match e.pexp_desc with
  | Pexp_fun (_, _, p, _) -> Location.raise_errorf ~loc:p.ppat_loc "'lifecycle' have only one argument"
  | Pexp_constraint (e, {ptyp_desc=Ptyp_constr ({txt=Lident"unit"; _}, []); _}) -> e
  | _ ->
    let loc = e.pexp_loc in
    pexp_constraint ~loc e (ptyp_constr ~loc {txt=Lident"unit"; loc} [])

let check_kind acc e = function
  | None -> e
  | Some `computed -> check_computed e
  | Some `watch name -> check_watch ~name acc e
  | Some `lifecycle -> check_lifecycle e

let rec wrap_method ?this ?kind ?(pats=[]) ?(convert=false) ?c ~key acc e =
  let loc = e.pexp_loc in
  match e.pexp_desc, this with
  | Pexp_fun (_, _, p, e), None ->
    let this = get_str_pat p in
    let e = check_kind acc e kind in
    wrap_method ~this ~key ~convert ?c acc e
  | Pexp_fun (_, _, p, e), Some this ->
    let p2 = match convert, p.ppat_desc with
      | true, Ppat_constraint (p, c) ->
        ppat_constraint ~loc:p.ppat_loc p (converted_type acc true c)
      | _ -> p in
    pexp_fun ~loc Nolabel None p2 (wrap_method ~this ~key ~pats:(pats @ [p]) ~convert ?c acc e)
  | _, Some _ ->
    let loc = e.pexp_loc in
    let this = jsapp ~loc "Unsafe.coerce" [ evar ~loc "_this" ] in
    let args = List.map (fun p ->
      let loc = p.ppat_loc in
      let e, c = match p.ppat_desc with
        | Ppat_var {txt; _} -> evar ~loc txt, None
        | Ppat_any -> evar ~loc "_", None
        | Ppat_constraint ({ppat_desc=Ppat_var {txt; _}; _}, c) -> evar ~loc txt, Some c
        | Ppat_constraint ({ppat_desc=Ppat_any; _}, c) -> evar ~loc "_", Some c
        | _ -> Location.raise_errorf ~loc "pattern expected to be '_', a variable or a constraint of these patterns" in
      converted_expr ~of_:true acc convert c e
    ) pats in
    let e = eapply ~loc (evar ~loc key) (this :: args) in
    converted_expr acc convert c e
  | _ ->
    Location.raise_errorf ~loc "unexpected expression for method"

let wrap_directive e =
  match e.pexp_desc with
  | Pexp_fun (_, _, _, {pexp_desc=Pexp_fun (_, _, _, {pexp_desc=Pexp_fun (_, _, p, _); _}); _}) ->
    Location.raise_errorf ~loc:p.ppat_loc "'directive' have only 2 arguments"
  | Pexp_fun (_, _, p_el, {pexp_desc=Pexp_fun (_, _, p_binding, elast); _}) ->
    let p_el = match p_el.ppat_desc with
      | Ppat_constraint _ -> p_el
      | _ ->
        let loc = p_el.ppat_loc in
        ppat_constraint ~loc p_el (jstyp ~loc "t" [ domtyp ~loc "element" [] ]) in
    let p_binding = match p_binding.ppat_desc with
      | Ppat_constraint _ -> p_binding
      | _ ->
        let loc = p_binding.ppat_loc in
        ppat_constraint ~loc p_binding (jstyp ~loc "t" [ ptyp_constr ~loc  {txt=Longident.parse "Vue.binding"; loc} [ ptyp_any ~loc ] ]) in
    pexp_fun ~loc:e.pexp_loc Nolabel None p_el
      (pexp_fun ~loc:e.pexp_loc Nolabel None p_binding
         (pexp_constraint ~loc:elast.pexp_loc elast (ptyp_constr ~loc:elast.pexp_loc {txt=Lident "unit"; loc=elast.pexp_loc} [])))
  | _ -> Location.raise_errorf ~loc:e.pexp_loc "'directive' needs 2 arguments (el, binding)"

let prop_arg_type ~loc acc p =
  let typ = Option.map (converted_type acc p.convert) p.typ in
  match typ, p.cons with
  | None, None -> jsid ~loc "undefined", None, `unknown
  | _, Some cons -> jsapp ~loc "def" [ cons ], typ, `unknown
  | Some c, _ ->
    let c = remove_poly c in
    let aux ~optional c =
      let cons s =
        jsapp ~loc "def" [
          pexp_constraint ~loc
            (eapply ~loc (evar ~loc "(##.)") [
               jsid ~loc "Unsafe.global";
               evar ~loc s
             ]) @@
          jstyp ~loc "constr" [ c ] ] in
      match c.ptyp_desc with
      | Ptyp_constr ({txt; _}, l) ->
        begin match Longident.name txt with
          | "int" | "Int.t" -> cons "_Number", Some c, (if optional then `optional else `not_optional)
          | "t" | "Js.t" | "Js_of_ocaml.Js.t" | "Ezjs_min.t" ->
            begin match l with
              | [ {ptyp_desc=Ptyp_constr ({txt; _}, _); _} ] ->
                begin match Longident.last_exn txt with
                  | "number" -> cons "_Number", Some c, (if optional then `optional else `not_optional)
                  | "js_string" -> cons "_String", Some c, (if optional then `optional else `not_optional)
                  | "bool" | "Bool.t" -> cons "_Boolean", Some c, (if optional then `optional else `not_optional)
                  | "bigInt" -> cons "_BigInt", Some c, (if optional then `optional else `not_optional)
                  | _ -> cons "_Object", Some c, (if optional then `optional else `not_optional)
                end
              | _ -> cons "_Object", Some c, (if optional then `optional else `not_optional)
            end
          | _ -> jsid ~loc "undefined", Some c, `unknown
        end
      | Ptyp_arrow _ -> cons "_Function", Some c, `unknown
      | _ ->  jsid ~loc "undefined", Some c, `unknown in
    match c.ptyp_desc with
    | Ptyp_constr ({txt; _}, [ c2 ]) ->
      begin match Longident.last_exn txt with
        | "optdef" -> aux ~optional:true c2
        | _ -> aux ~optional:false c
      end
    | _ -> aux ~optional:false c

let prop_arg_required p = match p.req, p.typ with
  | true, _ -> true | _, None -> false
  | _, Some {ptyp_desc=Ptyp_constr ({txt; _}, _); _} ->
    (match Longident.last_exn txt with "optdef" -> false | _ -> true)
  | _ -> true

let prop_arg ~loc acc p =
  let t, c, opt = prop_arg_type ~loc acc p in
  let dft = match p.dft, opt with
    | None, _ -> jsid ~loc "undefined"
    | Some e, (`unknown | `not_optional) ->
      jsapp ~loc "def" [ converted_expr acc p.convert p.typ e ]
    | Some e, `optional -> converted_expr acc p.convert p.typ e in
  let c = Option.value ~default:(ptyp_any ~loc) c in
  [%expr
    (object%js
      val type_ = [%e t]
      val required = [%e if p.req then jsapp ~loc "def" [ jsid ~loc "_true" ] else jsid ~loc "undefined"]
      val default = [%e dft]
      val validator = [%e match p.validator with None -> jsid ~loc "undefined" | Some e -> jsapp ~loc "def" [ e ]]
    end : [%t jstyp ~loc "t" [[%type: [%t c] Vue.prop_arg]]])]

let create_arg ~loc ?options acc =
  let aux fields =
    let cs = class_structure ~self:(pvar ~loc "_this") ~fields in
    pexp_extension ~loc ({txt="js";loc}, PStr [ pstr_eval ~loc (pexp_object ~loc cs) [] ]) in
  let datas =
    let fields = List.map (fun (key, c, e, convert) ->
      let e = match e.pexp_desc with
        | Pexp_fun _ -> wrap_method ~convert ?c ~key acc e
        | _ -> converted_expr acc convert c e in
      pcf_val ~loc ({txt=field_name key; loc}, Mutable, Cfk_concrete (Fresh, e))) acc.datas in
    pcf_method ~loc ({txt="data"; loc}, Public, Cfk_concrete (Fresh, aux fields)) in
  let methods = match acc.methods with
    | [] -> jsid ~loc "undefined"
    | _ ->
      let fields = List.map (fun (key, c, e, convert) ->
        pcf_method ~loc ({txt=field_name key; loc}, Public, Cfk_concrete (Fresh, wrap_method ~key ~convert ?c acc e))
      ) acc.methods in
      jsapp ~loc "def" [aux fields] in
  let methods = pcf_val ~loc ({txt="methods"; loc}, Immutable, Cfk_concrete (Fresh, methods)) in
  let computeds = match acc.computeds with
    | [] -> jsid ~loc "undefined"
    | _ ->
      let fields = List.map (fun (key, c, e, convert) ->
        pcf_method ~loc ({txt=field_name key; loc}, Public, Cfk_concrete (Fresh, wrap_method ~kind:`computed ~key ~convert ?c acc e))
      ) acc.computeds in
      jsapp ~loc "def" [aux fields] in
  let computeds = pcf_val ~loc ({txt="computed"; loc}, Immutable, Cfk_concrete (Fresh, computeds)) in
  let watchs = match acc.watchs with
    | [] -> jsid ~loc "undefined"
    | _ ->
      let fields = List.map (fun (key, c, e, convert) ->
        pcf_method ~loc ({txt=field_name key; loc}, Public, Cfk_concrete (Fresh, wrap_method ~kind:(`watch key) ~key ~convert ?c acc e))
      ) acc.watchs in
      jsapp ~loc "def" [aux fields] in
  let watchs = pcf_val ~loc ({txt="watch"; loc}, Immutable, Cfk_concrete (Fresh, watchs)) in
  let props = match acc.props with
    | [] -> jsid ~loc "undefined"
    | _ ->
      let fields = List.map (fun p ->
        pcf_val ~loc ({txt=field_name p.key; loc}, Immutable, Cfk_concrete (Fresh, prop_arg ~loc acc p))
      ) acc.props in
      jsapp ~loc "def" [aux fields] in
  let props = pcf_val ~loc ({txt="props"; loc}, Immutable, Cfk_concrete (Fresh, props)) in
  let directives = match acc.directives with
    | [] -> jsid ~loc "undefined"
    | _ ->
      let fields = List.map (fun key ->
        pcf_method ~loc ({txt=field_name key; loc}, Public, Cfk_concrete (Fresh, evar ~loc key))
      ) acc.directives in
      jsapp ~loc "def" [aux fields] in
  let directives = pcf_val ~loc ({txt="directives"; loc}, Immutable, Cfk_concrete (Fresh, directives)) in
  let template, render = match acc.template, acc.compile with
    | None, _ -> jsid ~loc "undefined", jsid ~loc "undefined"
    | Some (`string s), false ->
      jsapp ~loc "def" [ eapply ~loc (jsid ~loc "string") [ estring ~loc s ] ],
      jsid ~loc "undefined"
    | Some (`expression e), _ -> jsapp ~loc "def" [ e ], jsid ~loc "undefined"
    | Some (`string s), true ->
      jsid ~loc "undefined",
      jsapp ~loc "def" [ render ~loc s ] in
  let template = pcf_val ~loc ({txt="template"; loc}, Immutable, Cfk_concrete (Fresh, template)) in
  let render = pcf_val ~loc ({txt="render"; loc}, Immutable, Cfk_concrete (Fresh, render)) in
  let emits = match acc.emits with
    | [] -> jsid ~loc "undefined"
    | _ -> jsapp ~loc "def" [ jsapp ~loc "array" [pexp_array ~loc @@ List.map (fun s -> jsapp ~loc "string" [estring ~loc s]) acc.emits ] ] in
  let emits = pcf_val ~loc ({txt="emits"; loc}, Immutable, Cfk_concrete (Fresh, emits)) in
  let lifecycle = List.map (fun (key, e) ->
    pcf_method ~loc ({txt=key; loc}, Public, Cfk_concrete (Fresh, wrap_method ~kind:`lifecycle ~key acc e))
  ) acc.lifecycle in
  let aux_component e acc = match e.pexp_desc with
    | Pexp_construct ({txt; _}, None) ->
      acc @ [Longident.last_exn txt, evar ~loc (Longident.name txt ^ ".component")]
    | Pexp_ident {txt; _} -> acc @ [Longident.last_exn txt, e]
    | Pexp_tuple [ {pexp_desc=Pexp_constant Pconst_string (txt, _, _); _}; e ] ->
      acc @ [txt, e]
    | _ -> acc in
  let rec aux_list e acc = match e.pexp_desc with
    | Pexp_construct ({txt=Lident "[]"; _}, None) -> acc
    | Pexp_construct ({txt=Lident "::"; _}, Some {pexp_desc=Pexp_tuple [e1; e2]; _}) ->
      aux_component e1 (aux_list e2 acc)
    | _ -> acc in
  let components, debug, name = match options with
    | None -> jsid ~loc "undefined", false, None
    | Some options ->
      let l, debug, name = List.fold_left (fun (cos, dbg, n) ({txt; _}, e) ->
        match Longident.name txt, e.pexp_desc with
        | "components", _ -> (aux_list e []), dbg, n
        | "debug", _ -> cos, true, n
        | "name", Pexp_constant Pconst_string (s, _, _) -> cos, dbg, Some s
        | _ -> cos, dbg, n) ([], false, None) options in
      match l with
      | [] -> jsid ~loc "undefined", debug, name
      | _ ->
        let fields = List.map (fun (k, e) ->
          let e2 = [%expr
            [%e jsid ~loc "Unsafe.meth_call"] ([%e jsid ~loc "Unsafe.global"]##._Vue)
              "defineComponent"
              [| [%e jsid ~loc "Unsafe.inject"] [%e e] |] ] in
          [%expr
            (Option.fold ~none:[%e estring ~loc (field_name k)]
               ~some:[%e jsid ~loc "to_string"] ([%e jsid ~loc "Optdef.to_option"] [%e e]##.name)),
            [%e jsid ~loc "Unsafe.inject"] [%e e2]]) l in
        [%expr [%e jsid ~loc "def"] ([%e jsid ~loc "Unsafe.obj"] [%e pexp_array ~loc fields])],
        debug, name in
  let name = match acc.name, name with
    | _, Some s | Some s, _ ->
      jsapp ~loc "def" [ jsapp ~loc "string" [ estring ~loc (kebab s) ] ]
    | _ -> jsid ~loc "undefined" in
  let name = pcf_val ~loc ({txt="name"; loc}, Immutable, Cfk_concrete (Fresh, name)) in
  let components = pcf_val ~loc ({txt="components"; loc}, Immutable, Cfk_concrete (Fresh, components)) in
  let fields = [datas; methods; computeds; watchs; props; directives; template; render; emits; name; components] @ lifecycle in
  let create_arg = class_structure ~self:(pvar ~loc "_this") ~fields in
  let e = pexp_extension ~loc ({txt="js";loc}, PStr [ pstr_eval ~loc (pexp_object ~loc create_arg) [] ]) in
  if debug then Format.eprintf "%s@." @@ Pprintast.string_of_expression e;
  e

let create_app ~loc acc options =
  let aux_component e eafter =
    let expr = match e.pexp_desc with
      | Pexp_construct ({txt; _}, None) ->
        [%expr Vue.component _app [%e evar ~loc (Longident.name txt ^ ".component")] ]
      | Pexp_tuple [ {pexp_desc=Pexp_constant Pconst_string (txt, _, _); _}; e ] ->
        [%expr Vue.component ~name:[%e estring ~loc txt] _app [%e e]]
      | _ -> [%expr Vue.component _app [%e e]] in
    pexp_let ~loc Nonrecursive [ value_binding ~loc ~pat:(pvar ~loc "_app") ~expr ] eafter in
  let rec aux_list e eafter = match e.pexp_desc with
    | Pexp_construct ({txt=Lident "[]"; _}, None) -> eafter
    | Pexp_construct ({txt=Lident "::"; _}, Some {pexp_desc=Pexp_tuple [e1; e2]; _}) ->
      aux_component e1 (aux_list e2 eafter)
    | _ -> eafter in
  let components, mount, id, unhide, export, plugins = List.fold_left (fun (cos, mo, id, uh, ex, pl) ({txt; _}, e) ->
    match Longident.name txt, e.pexp_desc with
    | "mount", Pexp_constant Pconst_string (s, _, _) -> cos, true, s, uh, ex, pl
    | "mount", _ -> cos, true, id, uh, ex, pl
    | "components", _ -> (aux_list e), mo, id, uh, ex, pl
    | "id", Pexp_constant Pconst_string (s, _, _) -> cos, mo, s, uh, ex, pl
    | "unhide", Pexp_constant Pconst_string (s, _, _) -> cos, mo, s, true, ex, pl
    | "unhide", _ -> cos, mo, id, true, ex, pl
    | "export", Pexp_constant Pconst_string (s, _, _) -> cos, mo, s, uh, true, pl
    | "export", _ -> cos, mo, id, uh, true, pl
    | "plugins", _ -> cos, mo, id, uh, ex, get_list_expression e
    | _ -> cos, mo, id, uh, ex, pl)
    (Fun.id, false, "app", false, false, []) options in
  let arg = create_arg ~loc acc in
  let rec global l eafter = match l with
    | (k, _, e, _) :: tl ->
      let exp = global tl eafter in
      let e = [%expr Vue.set_global _app [%e estring ~loc k] [%e e]] in
      pexp_sequence ~loc e exp
    | [] -> eafter in
  let typ = app_type ~loc acc in
  let rec use l eafter = match l with
    | [] -> eafter
    | p :: tl ->
      let e = use tl eafter in
      let expr = [%expr Vue.use _app [%e jsapp ~loc "Unsafe.inject" [p]]] in
      pexp_let ~loc Nonrecursive [ value_binding ~loc ~pat:(pvar ~loc "_app") ~expr ] e in
  let mount eafter =
    if mount then
      pexp_let ~loc Nonrecursive [ value_binding ~loc ~pat:(pvar ~loc "_app") ~expr:[%expr Vue.mount ~id:[%e estring ~loc id] _app] ] eafter
    else eafter in
  let export eafter =
    if export then
      pexp_sequence ~loc (jsapp ~loc "export" [estring ~loc id; evar ~loc "_app" ]) eafter
    else eafter in
  let unhide eafter =
    if unhide then
      [%expr
        (match [%e domid ~loc "getElementById_opt"] [%e estring ~loc id] with
         | None -> ()
         | Some app -> app##.style##.display := string "block");
        (match [%e domid ~loc "getElementById_opt"] ([%e estring ~loc id] ^ "-loading") with
         | None -> ()
         | Some loading -> loading##.style##.display := string "none");
        [%e eafter]
      ]
    else eafter in
  let e = [%expr
    let _app : [%t typ] = Vue.create_app (Some [%e arg]) in
    [%e use plugins @@ global acc.globals @@ components @@ mount @@ unhide @@ export [%expr _app]]
  ] in
  if acc.debug then Format.eprintf "%s@." (Pprintast.string_of_expression e);
  e

let infer_type e =
  let loc = e.pexp_loc in
  match e.pexp_desc with
  | Pexp_constant Pconst_string _ ->
    Some (ptyp_constr ~loc {txt=Lident "string"; loc} [])
  | Pexp_constant Pconst_integer (_, Some 'l') ->
    Some (ptyp_constr ~loc {txt=Lident "int32"; loc} [])
  | Pexp_constant Pconst_integer (_, Some 'L') ->
    Some (ptyp_constr ~loc {txt=Lident "int64"; loc} [])
  | Pexp_constant Pconst_integer (_, Some 'n') ->
    Some (ptyp_constr ~loc {txt=Lident "nativeint"; loc} [])
  | Pexp_constant Pconst_float _ ->
    Some (ptyp_constr ~loc {txt=Lident "float"; loc} [])
  | Pexp_constant Pconst_char _ ->
    Some (ptyp_constr ~loc {txt=Lident "char"; loc} [])
  | Pexp_construct ({txt=Lident ("true"|"false"); _}, None) ->
    Some (ptyp_constr ~loc {txt=Lident "bool"; loc} [])
  | _ -> None

let rec add_global ?(convert=false) acc = function
  | vb :: tl ->
    let key = get_str_pat vb.pvb_pat in
    let conv = convert && not (List.exists (fun a -> a.attr_name.txt = "noconv" || a.attr_name.txt = "noconvert") vb.pvb_attributes) in
    let typ = Option.fold ~none:(infer_type vb.pvb_expr) ~some:Option.some @@ get_exit_type vb.pvb_expr in
    add_global ~convert {acc with globals = (key, typ, vb.pvb_expr, conv) :: acc.globals} tl
  | [] -> {acc with globals = List.rev acc.globals}

let rec add_data ?(convert=false) acc = function
  | vb :: tl ->
    let key = get_str_pat vb.pvb_pat in
    let conv = convert && not (List.exists (fun a -> a.attr_name.txt = "noconv" || a.attr_name.txt = "noconvert") vb.pvb_attributes) in
    let typ = Option.fold ~none:(infer_type vb.pvb_expr) ~some:Option.some @@ get_exit_type vb.pvb_expr in
    add_data ~convert {acc with datas = (key, typ, vb.pvb_expr, conv) :: acc.datas} tl
  | [] ->
    {acc with datas = List.rev acc.datas}

let rec add_method ?(convert=false) acc = function
  | vb :: tl ->
    let key = get_str_pat vb.pvb_pat in
    let conv = convert && not (List.exists (fun a -> a.attr_name.txt = "noconv" || a.attr_name.txt = "noconvert") vb.pvb_attributes) in
    let typ = get_exit_type vb.pvb_expr in
    add_method ~convert {acc with methods = (key, typ, vb.pvb_expr, conv) :: acc.methods} tl
  | [] -> {acc with methods = List.rev acc.methods}

let rec add_computed ?(convert=false) acc = function
  | vb :: tl ->
    let key = get_str_pat vb.pvb_pat in
    let conv = convert && not (List.exists (fun a -> a.attr_name.txt = "noconv" || a.attr_name.txt = "noconvert") vb.pvb_attributes) in
    let typ = get_exit_type vb.pvb_expr in
    add_computed ~convert {acc with computeds = (key, typ, vb.pvb_expr, conv) :: acc.computeds} tl
  | [] -> {acc with computeds = List.rev acc.computeds}

let rec add_watch ?(convert=false) acc = function
  | vb :: tl ->
    let key = get_str_pat vb.pvb_pat in
    let conv = convert && not (List.exists (fun a -> a.attr_name.txt = "noconv" || a.attr_name.txt = "noconvert") vb.pvb_attributes) in
    let typ = get_exit_type vb.pvb_expr in
    add_watch ~convert {acc with watchs = (key, typ, vb.pvb_expr, conv) :: acc.watchs} tl
  | [] -> {acc with watchs = List.rev acc.watchs}

let rec add_directive ?(convert=false) acc = function
  | vb :: tl ->
    let key = get_str_pat vb.pvb_pat in
    add_directive ~convert {acc with directives = key :: acc.directives} tl
  | [] -> {acc with directives = List.rev acc.directives}

let rec add_prop ?(convert=false) acc = function
  | vb :: tl ->
    let key = get_str_pat vb.pvb_pat in
    let typ = Option.fold ~none:(infer_type vb.pvb_expr) ~some:Option.some @@ get_exit_type vb.pvb_expr in
    let conv = convert && not (List.exists (fun a -> a.attr_name.txt = "noconv" || a.attr_name.txt = "noconvert") vb.pvb_attributes) in
    let p = {key; typ; cons=None; validator=None; dft=None; req=false; convert=conv} in
    let aux_dft e = match e.pexp_desc with
      | Pexp_ident {txt; _} ->
        begin match Longident.last_exn txt with
          | "undefined" -> None
          | _ -> Some e
        end
      | Pexp_construct ({txt=Lident "None"; _}, _) -> None
      | _ -> Some e in
    let p = match vb.pvb_expr.pexp_desc with
      | Pexp_record (l, _) | Pexp_constraint ({pexp_desc=Pexp_record (l, _); _}, _) ->
        List.fold_left (fun p ({txt; _}, e) ->
          match Longident.last_exn txt with
          | "cons" | "type" -> { p with cons = Some e }
          | "req" | "required" -> { p with req = true }
          | "dft" | "default" -> { p with dft = Some e }
          | "validator" -> { p with validator = Some e }
          | _ -> p
        ) p l
      | Pexp_construct ({txt=Lident "()"; _}, None)
      | Pexp_constraint ({pexp_desc=Pexp_construct ({txt=Lident "()"; _}, None); _}, _) -> p
      | Pexp_constraint (e, _) ->
        { p with dft = aux_dft e }
      | _ -> { p with dft = aux_dft vb.pvb_expr } in
    add_prop ~convert {acc with props = p :: acc.props} tl
  | [] -> {acc with props = List.rev acc.props}

let add_lifecycle ~name acc e =
  { acc with lifecycle = acc.lifecycle @ [ name, e ] }

let add_emit ~name acc =
  { acc with emits = acc.emits @ [ name ] }

let trim_html s =
  let l = String.split_on_char '\n' s in
  match l with
  | "" :: s :: _ | s :: _ ->
    let i, _ = String.fold_left (fun (i, stop) c -> if stop then (i, stop) else if c = ' ' then (i+1, false) else (i, true)) (0, false) s in
    let l = List.map (fun s -> if String.length s > i then String.sub s i (String.length s - i) else s) l in
    String.trim @@ String.concat "\n" l
  | _ -> s

let wrap_this acc e = match e.pexp_desc, vue_type ~loc:e.pexp_loc acc with
  | _, None -> e
  | Pexp_fun (_, _, {ppat_desc=Ppat_constraint (p, _); _}, e), Some c
  | Pexp_fun (_, _, p, e), Some c ->
    pexp_fun ~loc:e.pexp_loc Nolabel None (ppat_constraint ~loc:p.ppat_loc p c) e
  | _ -> e

let instance_attrs ~loc acc key e =
  let fields = match key with
    | "data" -> data_type_fields ~loc acc
    | "props" -> prop_type_fields ~loc acc
    | _ -> [] in
  let t, key, e, f = match fields, key, e.pexp_desc with
    | _ :: _, _, _ ->
      let ct = ptyp_object ~loc fields Closed in
      Some (jstyp ~loc "t" [ct]), key, e, Fun.id
    | _, "el", _ ->
      Some (jstyp ~loc "optdef" [ jstyp ~loc "t" [ domtyp ~loc "element" [] ] ]),
      key, e, Fun.id
    | _, "ref", Pexp_apply (e, [_, {pexp_desc=Pexp_constant Pconst_string (s, _, _); _}]) ->
      Some (jstyp ~loc "optdef" [ jstyp ~loc "t" [ domtyp ~loc "element" [] ] ]),
      "refs", e, (fun e -> jsapp ~loc "Unsafe.get" [
        e; jsapp ~loc "string" [ estring ~loc s ] ])
    | _ -> None, key, e, Fun.id in
  let e = f @@ jsapp ~loc "Unsafe.get" [ e; jsapp ~loc "string" [ estring ~loc ("$" ^ key) ] ] in
  match t with
  | None -> e
  | Some t -> pexp_constraint ~loc e t

let do_convert l =
  List.exists (fun pv ->
    List.exists (fun a -> a.attr_name.txt = "conv" || a.attr_name.txt = "convert")
      pv.pvb_attributes) l

let convert_all_and_modules_aux l =
  let convert_all = List.exists (fun ({txt; _}, _) -> txt = Lident "convert" || txt = Lident "conv") l in
  let modules = List.find_map (function
    | ({txt=Lident "modules"; _}, e) ->
      let l = get_list_expression e in
      let l = List.filter_map (fun e -> match e.pexp_desc with
        | Pexp_tuple [{pexp_desc=Pexp_construct ({txt=m1; _}, _); _}; {pexp_desc=Pexp_construct ({txt=m2; _}, _); _}] ->
          Some (Longident.name m1, Longident.name m2)
        | _ -> None) l in
      Some l
    | _ -> None) l in
  convert_all, modules

let convert_all_and_modules =
  object(_self)
    inherit [acc] Ast_traverse.fold as super
    method! structure_item it acc = match it.pstr_desc with
      | Pstr_extension (({txt=("app"|"vue.app"|"comp"|"vue.comp"|"component"|"vue.component"); _}, PStr [{pstr_desc=Pstr_eval ({pexp_desc=Pexp_record (l, _); _}, _); _}]), _) ->
        let convert_all, modules = convert_all_and_modules_aux l in
        { acc with convert_all; modules }
      | _ -> super#structure_item it acc

    method! expression e acc = match e.pexp_desc with
      | Pexp_extension ({txt=("app"|"vue.app"|"component"|"vue.component"); _}, PStr [ {pstr_desc=Pstr_eval ({pexp_desc=Pexp_record (l, _); _}, _); _} ]) ->
        let convert_all, modules = convert_all_and_modules_aux l in
        { acc with convert_all; modules }
      | _ -> super#expression e acc
  end

let ast_fold =
  object(self)
    inherit [acc] Ast_traverse.fold as super
    method! expression e acc =
      match e.pexp_desc with
      | Pexp_extension ({txt=("global"|"glob"|"vue.global"|"vue.glob"); _}, PStr [ {pstr_desc=Pstr_eval ({pexp_desc=Pexp_let (_, l, elast); _}, _); _} ] ) ->
        let acc = add_global ~convert:(acc.convert_all || do_convert l) acc l in
        let acc = List.fold_left (fun acc vb -> self#value_binding vb acc) acc l in
        self#expression elast acc
      | Pexp_extension ({txt=("data"|"vue.data"); _}, PStr [ {pstr_desc=Pstr_eval ({pexp_desc=Pexp_let (_, l, elast); _}, _); _} ] ) ->
        let acc = add_data ~convert:(acc.convert_all || do_convert l) acc l in
        let acc = List.fold_left (fun acc vb -> self#value_binding vb acc) acc l in
        self#expression elast acc
      | Pexp_extension ({txt=("meth"|"method"|"vue.meth"|"vue.method"); _}, PStr [ {pstr_desc=Pstr_eval ({pexp_desc=Pexp_let (_, l, elast); _}, _); _} ] ) ->
        let acc = add_method ~convert:(acc.convert_all || do_convert l) acc l in
        let acc = List.fold_left (fun acc vb -> self#value_binding vb acc) acc l in
        self#expression elast acc
      | Pexp_extension ({txt=("computed"|"comp"|"vue.computed"|"vue.comp"); _}, PStr [ {pstr_desc=Pstr_eval ({pexp_desc=Pexp_let (_, l, elast); _}, _); _} ] ) ->
        let acc = add_computed ~convert:(acc.convert_all || do_convert l) acc l in
        let acc = List.fold_left (fun acc vb -> self#value_binding vb acc) acc l in
        self#expression elast acc
      | Pexp_extension ({txt=("watch"|"vue.watch"); _}, PStr [ {pstr_desc=Pstr_eval ({pexp_desc=Pexp_let (_, l, elast); _}, _); _} ] ) ->
        let acc = add_watch ~convert:(acc.convert_all || do_convert l) acc l in
        let acc = List.fold_left (fun acc vb -> self#value_binding vb acc) acc l in
        self#expression elast acc
      | Pexp_extension ({txt=("dir"|"vue.dir"|"directive"|"vue.directive"); _}, PStr [ {pstr_desc=Pstr_eval ({pexp_desc=Pexp_let (_, l, elast); _}, _); _} ] ) ->
        let acc = add_directive ~convert:(acc.convert_all || do_convert l) acc l in
        let acc = List.fold_left (fun acc vb -> self#value_binding vb acc) acc l in
        self#expression elast acc
      | Pexp_extension ({txt=("prop"|"vue.prop"); _}, PStr [ {pstr_desc=Pstr_eval ({pexp_desc=Pexp_let (_, l, elast); _}, _); _} ] ) ->
        let acc = add_prop ~convert:(acc.convert_all || do_convert l) acc l in
        self#expression elast acc
      | Pexp_extension ({txt=("template"|"vue.template"|"render"|"vue.render" as txt); _}, PStr [ {pstr_desc=Pstr_eval ({pexp_desc=Pexp_let (_, [{pvb_expr={pexp_desc=Pexp_constant Pconst_string (tpl, _, _); _}; _}], elast); _}, _); _} ] ) ->
        let template = Some (`string tpl) in
        let compile = txt = "render" || txt = "vue.render" || !vue_compile in
        self#expression elast { acc with compile; template }
      | Pexp_extension ({txt=("template"|"vue.template"); _}, PStr [ {pstr_desc=Pstr_eval ({pexp_desc=Pexp_let (_, [vb], elast); _}, _); _} ] ) ->
        let loc = vb.pvb_expr.pexp_loc in
        let template = Some (`expression (pexp_constraint ~loc vb.pvb_expr (jstyp ~loc "t" [ jstyp ~loc "js_string" [] ]))) in
        self#expression elast { acc with template }
      | Pexp_extension ({txt=("emit"|"vue.emit"); _}, PStr [ {pstr_desc=Pstr_eval ({pexp_desc=Pexp_apply ({pexp_desc=Pexp_constant Pconst_string (name, _, _); _}, _); _}, _); _} ] ) ->
        add_emit ~name acc
      | Pexp_extension ({txt=("app"|"vue.app"|"component"|"vue.component"); _}, PStr [ {pstr_desc=Pstr_eval ({pexp_desc=Pexp_record (l, _); _}, _); _} ]) ->
        let types = List.exists (fun ({txt; _}, _) -> txt = Lident "types") l  in
        let debug = List.exists (fun ({txt; _}, _) -> txt = Lident "debug") l  in
        {acc with types; debug}
      | _ ->
        super#expression e acc

    method! structure_item it acc =
      match it.pstr_desc with
      | Pstr_extension (({txt=("global"|"glob"|"vue.global"|"vue.glob"); _}, PStr [ {pstr_desc=Pstr_value (_, l); _} ]), _) ->
        let acc = add_global ~convert:(acc.convert_all || do_convert l) acc l in
        List.fold_left (fun acc vb -> self#value_binding vb acc) acc l
      | Pstr_extension (({txt=("data"|"vue.data"); _}, PStr [ {pstr_desc=Pstr_value (_, l); _} ]), _) ->
        let acc = add_data ~convert:(acc.convert_all || do_convert l) acc l in
        List.fold_left (fun acc vb -> self#value_binding vb acc) acc l
      | Pstr_extension (({txt=("meth"|"method"|"vue.meth"|"vue.method"); _}, PStr [ {pstr_desc=Pstr_value (_, l); _} ]), _) ->
        let acc = add_method ~convert:(acc.convert_all || do_convert l) acc l in
        List.fold_left (fun acc vb -> self#value_binding vb acc) acc l
      | Pstr_extension (({txt=("computed"|"comp"|"vue.computed"|"vue.comp"); _}, PStr [ {pstr_desc=Pstr_value (_, l); _} ]), _) ->
        let acc = add_computed ~convert:(acc.convert_all || do_convert l) acc l in
        List.fold_left (fun acc vb -> self#value_binding vb acc) acc l
      | Pstr_extension (({txt=("watch"|"vue.watch"); _}, PStr [ {pstr_desc=Pstr_value (_, l); _} ]), _) ->
        let acc = add_watch ~convert:(acc.convert_all || do_convert l) acc l in
        List.fold_left (fun acc vb -> self#value_binding vb acc) acc l
      | Pstr_extension (({txt=("dir"|"vue.dir"|"directive"|"vue.directive"); _}, PStr [ {pstr_desc=Pstr_value (_, l); _} ]), _) ->
        let acc = add_directive ~convert:(acc.convert_all || do_convert l) acc l in
        List.fold_left (fun acc vb -> self#value_binding vb acc) acc l
      | Pstr_extension (({txt=("prop"|"vue.prop"); _}, PStr [ {pstr_desc=Pstr_value (_, l); _} ]), _) ->
        let acc = add_prop ~convert:(acc.convert_all || do_convert l) acc l in
        List.fold_left (fun acc vb -> self#value_binding vb acc) acc l
      | Pstr_extension (({txt=("template"|"vue.template"|"render"|"vue.render" as txt); _}, PStr [ {pstr_desc=Pstr_eval ({pexp_desc=Pexp_constant Pconst_string (tpl, _, _); _}, _); _} ]), _)
      | Pstr_extension ((
          {txt=("template"|"vue.template"|"render"|"vue.render" as txt); _},
          PStr [ {pstr_desc=Pstr_value (_, [{pvb_expr={pexp_desc=Pexp_constant Pconst_string (tpl, _, _); _}; _}]); _}]), _) ->
        let template = Some (`string (trim_html tpl)) in
        let compile = txt = "render" || txt = "vue.render" || !vue_compile in
        { acc with compile; template }
      | Pstr_extension (({txt=("template"|"vue.template"); _}, PStr [ {pstr_desc=Pstr_value (_, [vb]); _} ]), _) ->
        let loc = vb.pvb_expr.pexp_loc in
        { acc with template = Some (`expression (pexp_constraint ~loc vb.pvb_expr (jstyp ~loc "t" [ jstyp ~loc "js_string" [] ]))) }
      | Pstr_extension (({txt; _}, PStr [ {pstr_desc=Pstr_value (_, [vb]); _} ]), _) when List.mem txt hooks ->
        let acc = add_lifecycle ~name:txt acc vb.pvb_expr in
        self#value_binding vb acc
      | Pstr_extension (({txt; _}, PStr [ {pstr_desc=Pstr_eval (e, _); _} ]), _) when List.mem txt hooks ->
        let acc = add_lifecycle ~name:txt acc e in
        self#expression e acc
      | Pstr_extension (({txt=("app"|"vue.app"|"comp"|"vue.comp"|"component"|"vue.component"); _}, PStr [{pstr_desc=Pstr_eval ({pexp_desc=Pexp_record (l, _); _}, _); _}]), _) ->
        let types = List.exists (fun ({txt; _}, _) -> txt = Lident "types") l  in
        let debug = List.exists (fun ({txt; _}, _) -> txt = Lident "debug") l  in
        {acc with types; debug}
      | Pstr_module _ -> acc
      | _ -> super#structure_item it acc

    method! structure s acc =
      let acc2 = convert_all_and_modules#structure s acc in
      List.fold_left (fun acc it -> self#structure_item it acc) acc2 s
  end

let next_expr ~loc acc this f =
  let tunit ~loc = ptyp_constr ~loc {txt=Lident "unit"; loc} [] in
  let f = match f.pexp_desc with
    | Pexp_fun (_, _, ({ppat_desc=Ppat_constraint _; _} as p), e) ->
      pexp_fun ~loc:f.pexp_loc Nolabel None p (pexp_constraint ~loc e (tunit ~loc:e.pexp_loc))
    | Pexp_fun (_, _, p, e) ->
      begin match vue_type ~loc:p.ppat_loc acc with
        | None ->
          pexp_fun ~loc:e.pexp_loc Nolabel None p
            (pexp_constraint ~loc e (tunit ~loc:e.pexp_loc))
        | Some c ->
          pexp_fun ~loc:e.pexp_loc Nolabel None (ppat_constraint ~loc:p.ppat_loc p c)
            (pexp_constraint ~loc e (tunit ~loc:e.pexp_loc))
      end
    | _ ->
      let loc = f.pexp_loc in
      begin match vue_type ~loc acc with
        | None -> f
        | Some c ->
          pexp_fun ~loc Nolabel None (ppat_constraint ~loc (pvar ~loc "_x") c)
            (pexp_constraint ~loc (eapply ~loc f [ evar ~loc "_x" ]) (tunit ~loc))
      end in
  let expr = [%expr
    [%e jsid ~loc "Unsafe.meth_call"] [%e this] "$nextTick"
      [| [%e jsid ~loc "Unsafe.inject" ] ([%e jsid ~loc "wrap_meth_callback"] (fun _this () -> [%e f ] _this)) |] ] in
  pexp_constraint ~loc expr (ptyp_constr ~loc {txt=Lident "unit"; loc} []) , acc

let ast_map =
  object(self)
    inherit [acc] Ast_traverse.fold_map as super
    method! expression e acc =
      match e.pexp_desc with
      | Pexp_extension ({txt=("global"|"glob"|"vue.global"|"vue.glob"|"data"|"vue.data"|"template"|"vue.template"|"render"|"vue.render"|"prop"|"vue.prop"); _}, PStr [ {pstr_desc=Pstr_eval ({pexp_desc=Pexp_let (_, _, elast); _}, _); _} ] ) ->
        self#expression elast acc
      | Pexp_extension ({txt=("meth"|"method"|"vue.meth"|"vue.method"|"computed"|"comp"|"vue.computed"|"vue.comp"|"watch"|"vue.watch"); _}, PStr [ {pstr_desc=Pstr_eval (e, _); _} ] ) ->
        let e = wrap_this acc e in
        self#expression e acc
      | Pexp_extension ({txt=("dir"|"vue.dir"|"directive"|"vue.directive"); _}, PStr [ {pstr_desc=Pstr_eval (e, _); _} ] ) ->
        let e = wrap_directive e in
        self#expression e acc
      | Pexp_extension ({txt=("emit"|"vue.emit"); loc}, PStr [ {pstr_desc=Pstr_eval ({pexp_desc=Pexp_apply ({pexp_desc=Pexp_constant Pconst_string (name, _, _); _}, l); _}, _); _} ] ) ->
        let e = match l with
          | (_, this) :: args ->
            let args = (jsapp ~loc "string" [estring ~loc name]) :: List.map snd args in
            jsapp ~loc "Unsafe.meth_call" [
              this; (estring ~loc "$emit");
              pexp_array ~loc (List.map (fun e -> jsapp ~loc "Unsafe.inject" [ e ]) args) ]
          | _ -> Location.raise_errorf ~loc "missing instance argument for 'emit'" in
        self#expression e acc
      | Pexp_extension ({txt; loc}, PStr [{pstr_desc=Pstr_eval (e, _); _}] ) when List.mem txt instances ->
        instance_attrs ~loc acc txt e, acc
      | Pexp_extension ({txt=("update"|"vue.update"); loc}, PStr [ {pstr_desc=Pstr_eval (this, _); _} ]) ->
        let expr = jsapp ~loc "Unsafe.meth_call" [
          this; (estring ~loc "$forceUpdate"); pexp_array ~loc []
        ] in
        pexp_constraint ~loc expr (ptyp_constr ~loc {txt=Lident "unit"; loc} []) , acc
      | Pexp_extension ({txt=("next"|"vue.next"); loc}, PStr [ {pstr_desc=Pstr_eval ({pexp_desc=Pexp_apply (this, [_, f]); _}, _); _} ]) ->
        let f, _ = self#expression f acc in
        next_expr ~loc acc this f
      | Pexp_extension ({txt=("app"|"vue.app"); loc}, PStr l) ->
        let options = match l with
          | [ {pstr_desc=Pstr_eval ({pexp_desc=Pexp_record (l, _); _}, _); _} ] -> l
          | _ -> [] in
        create_app ~loc acc options, acc
      | Pexp_extension ({txt=("component"|"vue.component"|"comp"|"vue.comp"); loc}, PStr l) ->
        let options = match l with
          | [ {pstr_desc=Pstr_eval ({pexp_desc=Pexp_record (l, _); _}, _); _} ] -> l
          | _ -> [] in
        create_arg ~loc ~options acc, acc
      | _ ->
        super#expression e acc

    method! value_binding vb acc =
      let loc = vb.pvb_loc in
      match vb.pvb_expr.pexp_desc with
      | Pexp_extension ({txt=("app"|"vue.app"); _}, PStr l) ->
        let options = match l with
          | [ {pstr_desc=Pstr_eval ({pexp_desc=Pexp_record (l, _); _}, _); _} ] -> l
          | _ -> [] in
        let pvb_expr = create_app ~loc acc options in
        {vb with pvb_expr}, acc
      | Pexp_extension ({txt=("component"|"vue.component"); _}, PStr l) ->
        let options = match l with
          | [ {pstr_desc=Pstr_eval ({pexp_desc=Pexp_record (l, _); _}, _); _} ] -> l
          | _ -> [] in
        let pvb_expr = create_arg ~loc ~options acc in
        {vb with pvb_expr}, acc
      | _ -> super#value_binding vb acc

    method! structure s acc_old =
      let acc = ast_fold#structure s {empty_acc with name=acc_old.name} in
      let s = List.fold_left (fun s it ->
        match it.pstr_desc with
        | Pstr_extension (({txt=("global"|"glob"|"vue.global"|"vue.glob"|"prop"|"vue.prop"|"template"|"vue.template"|"render"|"vue.render"); _}, PStr [ {pstr_desc=Pstr_value (_, _); _} ]), _) ->
          s
        | Pstr_extension (({txt=("meth"|"method"|"vue.meth"|"vue.method"|"computed"|"comp"|"vue.computed"|"vue.comp"|"watch"|"vue.watch"); _}, PStr [ {pstr_desc=Pstr_value (rec_flag, l); pstr_loc; _} ]), _) ->
          let l = List.map (fun vb ->
            let pvb_expr = wrap_this acc vb.pvb_expr in
            fst @@ self#value_binding {vb with pvb_expr} acc) l in
          s @ [ pstr_value ~loc:pstr_loc rec_flag l ]
        | Pstr_extension (({txt=("dir"|"vue.dir"|"directive"|"vue.directive"); _}, PStr [ {pstr_desc=Pstr_value (rec_flag, l); pstr_loc; _} ]), _) ->
          let l = List.map (fun vb ->
            let pvb_expr = wrap_directive vb.pvb_expr in
            fst @@ self#value_binding {vb with pvb_expr} acc) l in
          s @ [ pstr_value ~loc:pstr_loc rec_flag l ]
        | Pstr_extension (({txt=("data"|"vue.data"); _}, PStr [ {pstr_desc=Pstr_value (rec_flag, l); pstr_loc; _} ]), _) ->
          let l = List.filter_map (fun vb ->
            match vb.pvb_expr.pexp_desc with
            | Pexp_fun _ ->
              let pvb_expr = wrap_this acc vb.pvb_expr in
              Some (fst @@ self#value_binding {vb with pvb_expr} acc)
            | _ -> None) l in
          begin match l with
            | [] -> s
            | _ -> s @ [ pstr_value ~loc:pstr_loc rec_flag l ]
          end
        | Pstr_extension (({txt=("template"|"vue.template"|"render"|"vue.render"); _}, PStr [ {pstr_desc=Pstr_eval (_, _); _} ]), _) -> s
        | Pstr_extension (({txt; _}, PStr [ {pstr_desc=Pstr_value (rec_flag, [vb]); pstr_loc; _} ]), _) when List.mem txt hooks ->
          let pvb_expr = wrap_this acc vb.pvb_expr in
          s @ [ pstr_value ~loc:pstr_loc rec_flag [ fst @@ self#value_binding {vb with pvb_expr} acc ] ]
        | Pstr_extension (({txt; loc}, PStr [ {pstr_desc=Pstr_eval (e, _); _} ]), _) when List.mem txt hooks ->
          let e = wrap_this acc e in
          let expr = fst @@ self#expression e acc in
          s @ [ pstr_value ~loc:e.pexp_loc Nonrecursive [ value_binding ~loc:e.pexp_loc ~pat:(pvar ~loc txt) ~expr ] ]
        | Pstr_module {pmb_name={txt=Some modu; loc}; pmb_expr={pmod_desc=Pmod_structure st; _}; _} ->
          let it = pstr_module ~loc @@
            module_binding ~loc ~name:{txt=Some modu; loc}
              ~expr:(pmod_structure ~loc (fst @@ self#structure st {empty_acc with name=Some modu})) in
          s @ [it]
        | Pstr_extension (({txt=("app"|"vue.app"); loc}, PStr l), _) ->
          let options = match l with
            | [ {pstr_desc=Pstr_eval ({pexp_desc=Pexp_record (l, _); _}, _); _} ] -> l
            | _ -> [] in
          let expr = create_app ~loc acc options in
          s @ [ pstr_value ~loc Nonrecursive [ value_binding ~loc ~pat:(pvar ~loc "_app") ~expr ] ]
        | Pstr_extension (({txt=("comp"|"vue.comp"|"component"|"vue.component"); loc}, PStr l), _) ->
          let options = match l with
            | [ {pstr_desc=Pstr_eval ({pexp_desc=Pexp_record (l, _); _}, _); _} ] -> l
            | _ -> [] in
          let expr = create_arg ~loc ~options acc in
          s @ [ pstr_value ~loc Nonrecursive [ value_binding ~loc ~pat:(pvar ~loc "component") ~expr ] ]
        | _ ->
          let it = fst @@ super#structure_item it acc in
          s @ [it]) [] s in
      let s = match s, acc.types with
        | h :: _ , true ->
          let types = all_types ~loc:h.pstr_loc acc in
          let rec aux = function
            | ({pstr_desc=(Pstr_type _|Pstr_module _|Pstr_modtype _|Pstr_open _|Pstr_class_type _|Pstr_include _); _} as it) :: tl ->
              it :: aux tl
            | l -> types :: l in
          aux s
        | _ -> s in
      s, acc_old

  end

let () =
  Driver.register_transformation "vue" ~impl:(fun s ->
    let s = fst @@ ast_map#structure s empty_acc in
    if !vue_debug then Format.eprintf "%s@." (Pprintast.string_of_structure s);
    s)