open Js_of_ocaml open Brr type t = Jv.t type t' = t let v : unit -> t = fun () -> Jv.get Jv.global "PM" module O = Bindings.TypedObject module Model = struct include Bindings.Model module DOMParser = struct type parser = Jv.t let from_schema : t -> schema Js.t -> parser = fun t schema -> let model = Jv.get t "model" in let parser = Jv.get model "DOMParser" in Jv.call (Jv.Id.to_jv parser) "fromSchema" [|Jv.Id.to_jv schema|] let parse : parser -> El.t -> node Js.t = fun dom_parser el -> Jv.call dom_parser "parse" [|Jv.Id.to_jv el|] |> Jv.Id.of_jv end let schema_spec: node_spec Bindings.ordered_map Js.t -> mark_spec Bindings.ordered_map Js.t option -> string option -> schema_spec Js.t = fun nodes marks_opt topNode_opt -> let marks = Jv.of_option ~none:Jv.null Jv.Id.to_jv marks_opt and topNode = Jv.of_option ~none:Jv.null Jv.of_string topNode_opt in Jv.obj [| "nodes", (Jv.Id.to_jv nodes) ; "marks", marks ; "topNode", topNode |] |> Jv.Id.of_jv let schema : t -> schema_spec Js.t -> schema Js.t = fun t spec -> let model = Jv.get t "model" in Jv.new' (Jv.get model "Schema") [| Jv.Id.to_jv spec |] |> Jv.Id.of_jv let empty_fragment : t -> fragment Js.t = fun t -> let model = Jv.get t "model" in let fragment = Jv.get model "Fragment" in Jv.get fragment "empty" |> Jv.Id.of_jv module Dom_output_spec = struct let v : ?attrs:< .. > -> string -> domOutputSpec Js.t list -> domOutputSpec Js.t = fun ?attrs name elems -> let elems = match attrs with | None -> elems | Some v -> Jv.Id.(of_jv @@ to_jv @@ v)::elems in let elems = (Jv.Id.of_jv @@ Jv.of_string name)::elems in (Jv.of_list Jv.Id.to_jv elems) |> Jv.Id.to_jv |> Jv.Id.of_jv let hole : domOutputSpec Js.t = 0 |> Jv.Id.to_jv |> Jv.Id.of_jv let of_ : 'a -> domOutputSpec Js.t = fun elem -> elem |> Jv.Id.to_jv |> Jv.Id.of_jv let of_el : Brr.El.t -> domOutputSpec Js.t = of_ let of_jstr : Jstr.t -> domOutputSpec Js.t = of_ let of_obj : < dom: node Js.t Js.readonly_prop ; contentDOM : node Js.t Js.opt Js.readonly_prop > Js.t -> domOutputSpec Js.t = of_ end module ParseRule = struct let tag : Jstr.t -> parse_rule Js.t = fun name -> Jv.obj [| "tag", Jv.of_jstr name |] |> Jv.Id.of_jv end end module State = struct include Bindings.State let configuration_prop : unit -> configuration_prop Js.t = fun () -> Js.Unsafe.obj [||] let creation_prop : unit -> creation_prop Js.t = fun () -> Js.Unsafe.obj [||] let create : t -> creation_prop Js.t -> editor_state Js.t = fun t props -> let state = Jv.get t "state" in let editor_state = Jv.get state "EditorState" in Jv.call editor_state "create" [|Jv.Id.to_jv props|] |> Jv.Id.of_jv let fromJSON : t -> configuration_prop Js.t -> Brr.Json.t -> editor_state Js.t = fun t config json -> let state = Jv.get t "state" in let editor_state = Jv.get state "EditorState" in Jv.call editor_state "fromJSON" [|Jv.Id.to_jv config ; json |] |> Jv.Id.of_jv let selection_from : selection Js.t -> Model.resolved_pos Js.t = fun selection -> Jv.Id.(of_jv @@ Jv.get (to_jv selection) "$from") let selection_to : selection Js.t -> Model.resolved_pos Js.t = fun selection -> Jv.Id.(of_jv @@ Jv.get (to_jv selection) "$to") let node_selection : t -> Model.resolved_pos Js.t -> node_selection Js.t = fun t pos -> let state = Jv.get t "state" in Jv.new' (Jv.get state "NodeSelection") [| Jv.Id.to_jv pos |] |> Jv.Id.of_jv let is_selectable : t -> Model.node Js.t -> bool Js.t = fun t node -> let selection = Jv.get (Jv.get t "state") "NodeSelection" in Jv.call selection "isSelectable" [|Jv.Id.to_jv node|] |> Jv.Id.of_jv let selection_at_start : t-> Model.node Js.t -> selection Js.t = fun t node -> let selection = Jv.get (Jv.get t "state") "NodeSelection" in Jv.call selection "atStart" [|Jv.Id.to_jv node|] |> Jv.Id.of_jv let create_node_selection : t -> Model.node Js.t -> int -> node_selection Js.t = fun t doc number -> let state = Jv.get t "state" in Jv.call (Jv.get state "NodeSelection") "create" Jv.Id.[|to_jv doc; Jv.of_int number|] |> Jv.Id.of_jv let create_text_selection : t -> Model.node Js.t -> int -> node_selection Js.t = fun t doc number -> let state = Jv.get t "state" in Jv.call (Jv.get state "TextSelection") "create" Jv.Id.[|to_jv doc; Jv.of_int number|] |> Jv.Id.of_jv let cursor : selection Js.t -> Model.resolved_pos Js.t Js.opt = fun selection -> Jv.Id.(of_jv @@ Jv.get (to_jv selection) "$cursor") let create_str_meta_data : Jstr.t -> 'a meta_data Js.t = Obj.magic end (* Editor view *) module View = struct module EditorProps = struct type t = Jv.t end include Bindings.View let direct_editor_props : unit -> direct_editor_props Js.t = fun () -> Js.Unsafe.obj [||] let editor_view : t -> El.t -> direct_editor_props Js.t -> editor_view Js.t = fun t node props -> Jv.new' (Jv.get (Jv.get t "view") "EditorView") [|Jv.Id.to_jv node ; Jv.Id.to_jv props|] |> Jv.Id.of_jv end module Transform = struct include Bindings.Transform let offset : t -> int -> step_map Js.t = fun t n -> let stepmap = Jv.get (Jv.get t "transform") "StepMap" in Jv.call stepmap "offset" [|Jv.Id.to_jv n|] |> Jv.Id.of_jv let insertPoint : t -> Model.node Js.t -> pos:int -> Model.node_type Js.t -> int Js.opt = fun t node ~pos node_t -> let transform = Jv.get t "transform" in Jv.call transform "insertPoint" Jv.Id.[|to_jv node ; to_jv pos; to_jv node_t|] |> Jv.Id.of_jv end module Commands = struct type t = State.editor_state Js.t -> State.dispatch Js.opt -> bool Js.t let baseKeymap : t' -> (string * t) array = fun t -> Jv.get (Jv.get t "commands") "baseKeymap" |> Jv.Id.of_jv let set_block_type : t' -> Model.node_type Js.t -> < .. > Js.t Js.opt -> t = fun t node props -> Jv.call (Jv.get t "commands") "setBlockType" Jv.Id.[| to_jv node ; to_jv props |] |> Jv.Id.of_jv let toggle_mark : t' -> Model.mark_type Js.t -> < .. > Js.t Js.opt -> t = fun t mark props -> Jv.call (Jv.get t "commands") "toggleMark" Jv.Id.[| to_jv mark ; to_jv props |] |> Jv.Id.of_jv end module History = struct include Bindings.History let history_prop : unit -> history_prop Js.t = fun () -> Js.Unsafe.obj [||] let history : t -> history_prop Js.t -> State.plugin Js.t = fun t props -> Jv.call (Jv.get t "history") "history" [|Jv.Id.to_jv props|] |> Jv.Id.of_jv let undo : t -> Commands.t = fun t state fn -> Jv.call (Jv.get t "history") "undo" [|Jv.Id.to_jv state; Jv.repr fn|] |> Jv.Id.of_jv let redo : t -> Commands.t = fun t state fn -> Jv.call (Jv.get t "history") "redo" [|Jv.Id.to_jv state; Jv.repr fn|] |> Jv.Id.of_jv end module Keymap = struct let keymap : t -> (string * Commands.t) array -> State.plugin Js.t = fun t props -> let props = Jv.obj @@ Array.map (fun (id, f) -> (id, Jv.repr f)) props in Jv.call (Jv.get t "keymap") "keymap" [|props|] |> Jv.Id.of_jv end module InputRule = struct type input_rule let create : t -> Js.regExp Js.t -> fn:(State.editor_state Js.t -> Jstr.t Js.js_array Js.t -> from:int -> to_:int -> State.transaction Js.t Js.opt) Js.callback -> input_rule Js.t = fun t match' ~fn -> Jv.new' (Jv.get (Jv.get t "inputrules") "InputRule") [|Jv.Id.to_jv match' ; Jv.Id.to_jv fn|] |> Jv.Id.of_jv let to_plugin : t -> input_rule Js.t Js.js_array Js.t -> State.plugin Js.t = fun t rules -> let obj = Jv.obj [|("rules", Jv.Id.to_jv rules)|] in Jv.call (Jv.get t "inputrules") "inputRules" [| obj |] |> Jv.Id.of_jv end module SchemaBasic = struct include Bindings.SchemaBasic let schema : t -> Model.schema Js.t = fun t -> Jv.get (Jv.get t "schema_basic") "schema" |> Jv.Id.of_jv let nodes : t -> nodes Js.t = fun t -> Jv.get (Jv.get t "schema_basic") "nodes" |> Jv.Id.of_jv end module SchemaList = struct let add_list_nodes : t -> Model.node_spec Bindings.ordered_map Js.t -> Jstr.t -> Jstr.t option -> Model.node_spec Bindings.ordered_map Js.t = fun t nodes item_content list_group_opt -> let schema_list = Jv.get t "schema_list" in let list_group = Jv.of_option ~none:Jv.null Jv.of_jstr list_group_opt in Jv.call schema_list "addListNodes" [|Jv.Id.to_jv nodes ; Jv.of_jstr item_content ; list_group |] |> Jv.Id.of_jv end module Menu = struct include Bindings.Menu let menuItemSpec : unit -> menuItemSpec Js.t = fun () -> Js.Unsafe.obj [||] let menu_item : t -> menuItemSpec Js.t -> menuItem Js.t = fun t spec -> let menu = Jv.get t "menu" in Jv.new' (Jv.get menu "MenuItem") [| Jv.Id.to_jv spec |] |> Jv.Id.of_jv end (* Example Setup *) module Example = struct include Bindings.Example let options : Model.schema Js.t -> options Js.t = fun schema -> Jv.obj [|("schema", Jv.Id.to_jv schema)|] |> Jv.Id.of_jv let example_setup : t -> options Js.t -> State.plugin Js.t Js.js_array Js.t = fun t options -> let setup = Jv.get t "example_setup" in Jv.call setup "exampleSetup" [|Jv.Id.to_jv options|] |> Jv.Id.of_jv let buildMenuItems : t -> Model.schema Js.t -> menuItems Js.t = fun t schema -> let setup = Jv.get t "example_setup" in Jv.call setup "buildMenuItems" [|Jv.Id.to_jv schema|] |> Jv.Id.of_jv end