open Brr module Js = Js_of_ocaml.Js 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 Fragment = struct (** https://prosemirror.net/docs/ref/#model.Fragment^fromArray *) let from_array : t -> node Js.t Js.js_array Js.t -> fragment Js.t = fun t elements -> let model = Jv.get t "model" in let class_ = Jv.get model "Fragment" in Jv.call (Jv.Id.to_jv class_) "fromArray" [| Jv.Id.to_jv elements |] |> Jv.Id.of_jv end module Mark = struct let _set_from : t -> 'a Js.t -> mark Js.t = fun t element -> let model = Jv.get t "model" in let class_ = Jv.get model "Mark" in Jv.call (Jv.Id.to_jv class_) "setFrom" [| Jv.Id.to_jv element |] |> Jv.Id.of_jv let set_from_mark : t -> mark Js.t -> mark Js.t = _set_from end 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 (** Create a new inputRule. The callback is called with the following elements : - the editor state - the elements matched by the regex - starting position - ending position and shall return a transaction if any modifications are applied. *) 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