Bindings to prosemirror

4 files changed, 736 insertions, 0 deletions

diff --git a/editor/prosemirror/bindings.ml b/editor/prosemirror/bindings.ml
new file mode 100755
index 0000000..d2ef2e6
--- /dev/null
+++ b/editor/prosemirror/bindings.ml
@@ -0,0 +1,376 @@
+open Js_of_ocaml.Js
+
+module Model = struct
+
+  type mark
+
+  type schema
+
+  type content_match
+
+  type node_spec
+
+  type slice
+
+  class type _node_props = object ('this)
+
+    method inlineContent:
+      bool readonly_prop
+    (** True if this node type has inline content. *)
+
+    method isBlock:
+      bool readonly_prop
+
+    method isText:
+      bool readonly_prop
+
+    method isInline:
+      bool readonly_prop
+
+    method isTextblock:
+      bool readonly_prop
+
+    method isLeaf:
+      bool readonly_prop
+
+    method isAtom:
+      bool readonly_prop
+
+  end
+
+  class type node_type = object ('this)
+
+    inherit _node_props
+
+    method name:
+      string readonly_prop
+
+    method schema:
+      schema t readonly_prop
+
+    method spec:
+      node_spec t readonly_prop
+
+    method contentMatch:
+      content_match t readonly_prop
+
+    method hasRequiredAttrs:
+      unit -> bool meth
+
+  end
+
+  class type mark_type = object ('this)
+  end
+
+  (** Common signature between fragment and node *)
+  class type _element = object ('this)
+
+    method childCount:
+      int readonly_prop
+    (** The number of children that the node has. *)
+
+    method child:
+      int -> node t meth
+    (**  Get the child node at the given index. Raise an error when the index
+         is out of range. *)
+
+    method maybeChild:
+      int -> node t opt meth
+    (** Get the child node at the given index, if it exists. *)
+
+    method eq:
+      'this t -> bool meth
+    (** Compare this element to another one. *)
+
+    method cut:
+      int -> int opt -> 'this meth
+    (** Cut out the element between the two given positions. *)
+
+    method toString:
+      unit -> Jstr.t meth
+    (** Return a debugging string that describes this element. *)
+
+    method forEach:
+      (node t -> int -> int) -> unit meth
+
+  end
+
+  and fragment = object ('this)
+
+    inherit _element
+
+    method size:
+      int readonly_prop
+    (** The size of the fragment, which is the total of the size of its
+        content nodes. *)
+
+    method append:
+      'this t -> 'this t meth
+
+    method lastChild:
+      node t opt readonly_prop
+
+    method firstChild:
+      node t opt readonly_prop
+
+  end
+
+  and node = object ('this)
+
+    inherit _element
+
+    inherit _node_props
+
+    method _type:
+      node_type t readonly_prop
+
+    method attrs:
+      < .. > t readonly_prop
+
+    method content:
+      fragment t readonly_prop
+
+    method marks:
+      mark t js_array t readonly_prop
+
+    method sameMarkupd:
+      node t -> bool meth
+  end
+
+end
+
+module Transform = struct
+
+  type step_result
+
+  class type step = object ('this)
+
+  end
+
+  class type replace_step = object ('this)
+
+    inherit step
+
+  end
+
+  class type replace_around_step = object ('this)
+
+    inherit step
+
+  end
+
+  class type add_mark_step = object ('this)
+
+    inherit step
+
+  end
+
+
+  class type transform = object ('this)
+
+    method doc:
+      Model.node t readonly_prop
+
+    method steps:
+      step t js_array t readonly_prop
+
+    method docs:
+      Model.node t js_array t readonly_prop
+
+    method step:
+      step t -> 'this t meth
+
+  end
+
+end
+
+(**
+
+   The class is defined outside of the module View for prevent recursive
+   declaration.
+
+*)
+class type _editor_props = object ('this)
+
+end
+
+
+module State = struct
+
+  class type plugin = object ('this)
+
+    method props : _editor_props t readonly_prop
+
+  end
+
+  class type selection = object ('this)
+
+    method content:
+      unit -> Model.slice t meth
+
+    method replace:
+      transaction t -> Model.slice t -> unit meth
+
+  end
+
+  and transaction = object ('this)
+
+    inherit Transform.transform
+
+    method time:
+      int readonly_prop
+
+    method setTime:
+      int -> 'this t meth
+
+    method storedMarks:
+      Model.mark t js_array t opt readonly_prop
+
+    method setStoredMarks:
+      Model.mark t js_array t opt -> 'this t meth
+
+    method addStoredMark:
+      Model.mark t -> 'this t meth
+
+    method removeStoredMark_mark:
+      Model.mark t -> 'this t meth
+
+    method removeStoredMark_marktype:
+      Model.mark_type t -> 'this t meth
+
+    method ensureMarks:
+      Model.mark t js_array t -> 'this t meth
+
+    method storedMarksSet:
+      bool readonly_prop
+
+    method selection:
+      selection t readonly_prop
+
+    method setSelection:
+      selection t -> 'this t meth
+
+    method deleteSelection:
+      'this t meth
+
+    method replaceSelection:
+      Model.slice t -> 'this t meth
+
+    method selectionSet:
+      bool readonly_prop
+
+    method before:
+      Model.node t readonly_prop
+
+  end
+
+  class type configuration_prop = object ('this)
+
+    method schema:
+      Model.schema t opt prop
+
+    method plugins:
+      plugin t js_array t opt prop
+
+  end
+
+  class type creation_prop = object ('this)
+
+    inherit configuration_prop
+
+    method doc:
+      Model.node t opt prop
+
+    method selection:
+      selection t opt prop
+
+    method storedMarks:
+      Model.mark t js_array t opt prop
+
+  end
+
+  class type editor_state = object ('this)
+
+    method doc :
+      Model.node t readonly_prop
+
+    method selection:
+      selection t readonly_prop
+
+    method storedMarks:
+      Model.mark t js_array t opt readonly_prop
+
+    method schema:
+      Model.schema t readonly_prop
+
+    method plugins:
+      plugin t js_array t readonly_prop
+
+    method apply:
+      transaction t -> 'this t meth
+
+    method tr:
+      transaction t readonly_prop
+
+    method reconfigure:
+      configuration_prop t meth
+
+    method toJSON:
+      unit -> Brr.Json.t meth
+
+  end
+
+end
+
+module View = struct
+
+  class type editor_props = _editor_props
+
+  class type direct_editor_props = object ('this)
+
+    inherit editor_props
+
+    method state:
+      State.editor_state t writeonly_prop
+
+    (** The call back is called with this = instance of editor_view *)
+    method dispatchTransaction:
+      (editor_view t, State.transaction t -> unit) meth_callback writeonly_prop
+
+  end
+
+  and editor_view = object ('this)
+
+    method state:
+      State.editor_state t readonly_prop
+
+    method dom:
+      Brr.El.t readonly_prop prop
+
+    method editable:
+      bool readonly_prop prop
+
+    method update:
+      direct_editor_props t -> unit meth
+
+    method setProps:
+      direct_editor_props t -> unit meth
+
+    method updateState:
+      State.editor_state t -> unit meth
+
+  end
+
+end
+
+module History = struct
+
+  class type history_prop = object ('this)
+
+    method depth: int opt prop
+
+    method newGroupDelay: int opt prop
+
+  end
+
+end
diff --git a/editor/prosemirror/dune b/editor/prosemirror/dune
new file mode 100755
index 0000000..4fff7b2
--- /dev/null
+++ b/editor/prosemirror/dune
@@ -0,0 +1,9 @@
+(library
+ (name prosemirror)
+ (libraries 
+   brr
+   js_of_ocaml
+   j
+   )
+ (preprocess (pps js_of_ocaml-ppx))
+ )
diff --git a/editor/prosemirror/prosemirror.ml b/editor/prosemirror/prosemirror.ml
new file mode 100755
index 0000000..bf72227
--- /dev/null
+++ b/editor/prosemirror/prosemirror.ml
@@ -0,0 +1,206 @@
+open Js_of_ocaml
+open Brr
+
+type t = Jv.t
+
+let v
+  : unit -> t
+  = fun () ->
+    Jv.get Jv.global "PM"
+
+type pm_schema
+
+type pm_state = Jv.t
+
+type pm_view = Jv.t
+
+
+let state
+  : (t, pm_state) J.prop
+  = J.prop "state"
+
+let view
+  : (t, pm_view) J.prop
+  = J.prop "view"
+
+type schema
+
+let schema_basic
+  : (t, Jv.t) J.prop
+  = J.prop "schema_basic"
+
+(* Model *)
+
+type pm_model = Jv.t
+
+let model
+  : (t, pm_model) J.prop
+  = J.prop "model"
+
+module Model = struct
+
+  include Bindings.Model
+
+  module DOMParser = struct
+
+    type t = Jv.t
+
+    let from_schema
+      : pm_model -> schema Js.t -> t
+      = fun model schema ->
+        let parser = Jv.get model "DOMParser" in
+        Jv.call (Jv.Id.to_jv parser) "fromSchema" [|Jv.Id.to_jv schema|]
+
+    let parse
+      : t -> 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 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
+
+end
+
+type pm_transform = Jv.t
+
+let transform
+  : (t, pm_transform) J.prop
+  = J.prop "prosemirror-transform"
+
+
+module State = struct
+
+  include Bindings.State
+
+  let configuration_prop
+    : unit -> configuration_prop Js_of_ocaml.Js.t
+    = fun () -> Js_of_ocaml.Js.Unsafe.obj [||]
+
+  let creation_prop
+    : unit -> creation_prop Js.t
+    = fun () -> Js_of_ocaml.Js.Unsafe.obj [||]
+
+  let create
+    : pm_state -> creation_prop Js.t -> editor_state Js.t
+    = fun state props ->
+      let editor_state = Jv.get state "EditorState" in
+      Jv.call editor_state "create" [|Jv.Id.to_jv props|]
+      |> Jv.Id.of_jv
+
+  let fromJSON
+    : pm_state -> configuration_prop Js_of_ocaml.Js.t -> Brr.Json.t -> editor_state Js.t
+    = fun state config json ->
+      let editor_state = Jv.get state "EditorState" in
+      Jv.call editor_state "fromJSON" [|Jv.Id.to_jv config ; json |]
+      |> Jv.Id.of_jv
+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_of_ocaml.Js.Unsafe.obj [||]
+
+  let editor_view
+    : pm_view -> El.t -> direct_editor_props Js.t -> editor_view Js.t
+    = fun view node props ->
+      Jv.new' (Jv.get view "EditorView") [|Jv.Id.to_jv node ; Jv.Id.to_jv props|]
+      |> Jv.Id.of_jv
+end
+
+(* Schema list *)
+
+type schema_list = Jv.t
+
+let schema_list
+  : (t, schema_list) J.prop
+  = J.prop "schema_list"
+
+module SchemaList = struct
+
+  let js f = Jv.of_jstr @@ Jstr.v f
+
+  let js_opt = Jv.of_option
+      ~none:Jv.null
+      js
+
+  let add_list_nodes
+    : schema_list -> ?listGroup:string -> node:Model.node Js.t -> itemContent:string -> unit
+    = fun s ?listGroup ~node ~itemContent ->
+      Jv.call (Jv.Id.to_jv s) "addListNodes" [|Jv.Id.to_jv node; js itemContent ; js_opt listGroup|]
+      |> ignore
+
+end
+
+module History = struct
+
+  include Bindings.History
+
+  let history_prop
+    : unit -> history_prop Js.t
+    = fun () -> Js_of_ocaml.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 -> State.editor_state Js.t -> (State.transaction -> unit) -> bool
+    = 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 -> State.editor_state Js.t -> (State.transaction -> unit) -> bool
+    = 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 * (State.editor_state Js.t -> (State.transaction -> unit) -> bool)) 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 Commands = struct
+
+  let baseKeymap
+    : t -> (string * (State.editor_state Js.t -> (State.transaction -> unit) -> bool)) array
+    = fun t ->
+      Jv.get (Jv.get t "commands") "baseKeymap"
+      |> Jv.Id.of_jv
+
+end
+
+(* Example Setup *)
+
+let example_setup
+  : t -> Model.schema Js.t -> State.plugin Js.t Js.js_array Js.t
+  = fun t schema ->
+    let setup = Jv.get t "example_setup" in
+    let props = Jv.obj [|("schema", Jv.Id.to_jv schema)|] in
+    Jv.call setup "exampleSetup" [|props|]
+    |> Jv.Id.of_jv
diff --git a/editor/prosemirror/prosemirror.mli b/editor/prosemirror/prosemirror.mli
new file mode 100755
index 0000000..1e0e889
--- /dev/null
+++ b/editor/prosemirror/prosemirror.mli
@@ -0,0 +1,145 @@
+open Js_of_ocaml
+open Brr
+
+type t
+
+val v
+  : unit -> t
+
+type schema_list
+
+type pm_schema
+
+type pm_state 
+
+type pm_view 
+
+type pm_model
+
+type pm_transform
+
+val state
+  : (t, pm_state) J.prop
+
+val view
+  : (t, pm_view) J.prop
+
+val model
+  : (t, pm_model) J.prop
+
+type schema
+
+val schema_basic
+  : (t, Jv.t) J.prop
+
+val schema_list
+  : (t, schema_list) J.prop
+
+
+val transform
+  : (t, pm_transform) J.prop
+
+
+module rec Model : sig
+
+  include module type of Bindings.Model
+
+
+  module DOMParser : sig
+    type t
+
+    val from_schema
+      : pm_model -> schema Js.t -> t
+
+    val parse
+      : t -> El.t -> node Js.t
+
+  end
+
+  val empty_fragment 
+    : t -> fragment Js.t
+
+end
+
+and SchemaList : sig
+
+  val add_list_nodes
+    : schema_list -> ?listGroup:string -> node:Model.node Js.t -> itemContent:string -> unit
+
+end
+
+(* State *)
+
+and State : sig
+
+  include module type of Bindings.State
+
+  val configuration_prop 
+    : unit -> configuration_prop Js.t 
+
+  val creation_prop 
+    : unit -> creation_prop Js.t 
+
+  val create
+    : pm_state -> creation_prop Js.t -> editor_state Js.t
+
+  val fromJSON 
+    : pm_state -> configuration_prop Js.t -> Brr.Json.t -> editor_state Js.t
+
+end
+
+(* Editor view *)
+
+and View : sig
+
+  module EditorProps : sig
+
+    type t
+
+  end
+
+  include module type of Bindings.View
+
+  val direct_editor_props 
+    : unit -> direct_editor_props Js.t
+
+  val editor_view
+    : pm_view -> El.t -> direct_editor_props Js.t -> editor_view Js.t
+
+end
+
+module History : sig
+
+  include module type of Bindings.History
+
+  val history_prop 
+    : unit -> history_prop Js.t
+
+  val history 
+    : t -> history_prop Js.t -> State.plugin Js.t
+
+  val undo 
+    : t -> State.editor_state Js.t -> (State.transaction -> unit) -> bool
+
+  val redo
+    : t -> State.editor_state Js.t -> (State.transaction -> unit) -> bool
+end
+
+module Keymap : sig
+
+  val keymap
+    : t -> (string * (State.editor_state Js.t -> (State.transaction -> unit) -> bool)) array -> State.plugin Js.t
+
+end
+
+module Commands : sig
+
+  val baseKeymap 
+    : t -> (string * (State.editor_state Js.t -> (State.transaction -> unit) -> bool)) array
+
+end
+
+(* Example Setup *)
+
+val example_setup
+  : t -> Model.schema Js.t -> State.plugin Js.t Js.js_array Js.t