Added prosemirror deps

11 files changed, 195 insertions, 395 deletions

diff --git a/editor/dune b/editor/dune
index cb571b5..b16e85f 100755
--- a/editor/dune
+++ b/editor/dune
@@ -4,7 +4,6 @@
    brr
    brr.note
    elements
-   j
    prosemirror
    blog
    )
diff --git a/editor/editor.ml b/editor/editor.ml
index d5ae84b..c32a5ba 100755
--- a/editor/editor.ml
+++ b/editor/editor.ml
@@ -1,12 +1,12 @@
 open Js_of_ocaml
 open Brr
 
-let create_new_state pm pm_model pm_state mySchema content =
+let create_new_state pm mySchema content =
   let module PM = Prosemirror in
 
   let doc = PM.Model.(
       DOMParser.parse
-        (DOMParser.from_schema pm_model mySchema)
+        (DOMParser.from_schema pm mySchema)
         (Jv.Id.of_jv content)) in
 
   let props = PM.State.creation_prop () in
@@ -14,7 +14,7 @@ let create_new_state pm pm_model pm_state mySchema content =
   props##.plugins := Js.some (PM.example_setup pm mySchema);
 
   PM.State.create
-    pm_state
+    pm
     props
 
 let storage_key = (Jstr.v "editor")
@@ -25,40 +25,27 @@ let prosemirror id content =
       let module PM = Prosemirror in
       let pm = PM.v () in
 
-      let ( let+ ) o f = Option.iter f o
-      and ( and+ ) a b =
-        match a, b with
-        | Some a, Some b -> Some (a, b)
-        | _ -> None
+      let specs = PM.Model.schema_spec
+          (PM.SchemaList.add_list_nodes
+             pm
+             ((PM.SchemaBasic.schema pm)##.spec##.nodes)
+             (Jstr.v "paragraph block*")
+             (Some (Jstr.v "block")))
+          (Some (PM.SchemaBasic.schema pm)##.spec##.marks)
+          None in
 
-      in
-
-      let+ pm_state = J.get pm PM.state
-      and+ pm_view  = J.get pm PM.view
-      and+ pm_model = J.get pm PM.model
-      and+ schema_basic = J.get pm PM.schema_basic
-      and+ schema_list = J.get pm PM.schema_list
-
-      in
-
-      let _ = schema_basic
-      and _ = schema_list in
-
-      let mySchema = Js_of_ocaml.Js.Unsafe.eval_string {|new PM.model.Schema({
-    nodes: PM.schema_list.addListNodes(PM.schema_basic.schema.spec.nodes, "paragraph block*", "block"),
-    marks: PM.schema_basic.schema.spec.marks
-  })|} in
+      let mySchema = PM.Model.schema pm specs in
 
 
       (* Create the initial state *)
       let storage = Brr_io.Storage.local G.window in
       let opt_data = Brr_io.Storage.get_item storage storage_key in
       let state = match opt_data with
-        | None -> create_new_state pm pm_model pm_state mySchema content
+        | None -> create_new_state pm mySchema content
         | Some contents ->
           (* Try to load from the storage *)
           begin match Json.decode contents with
-            | Error _ -> create_new_state pm pm_model pm_state mySchema content
+            | Error _ -> create_new_state pm mySchema content
             | Ok json ->
               Console.(log [Jstr.v "Loading json"]);
 
@@ -68,8 +55,8 @@ let prosemirror id content =
 
               let obj = PM.State.configuration_prop () in
               obj##.plugins := Js.some (PM.example_setup pm mySchema);
-              obj##.schema := mySchema;
-              PM.State.fromJSON pm_state obj json
+              obj##.schema := Js.some mySchema;
+              PM.State.fromJSON pm obj json
           end
       in
 
@@ -84,7 +71,7 @@ let prosemirror id content =
 
 
       let view = PM.View.editor_view
-          pm_view
+          pm
           (Jv.Id.of_jv id)
           props in
 
diff --git a/editor/j/dune b/editor/j/dune
deleted file mode 100755
index 56e6691..0000000
--- a/editor/j/dune
+++ /dev/null
@@ -1,7 +0,0 @@
-(library
- (name j)
- (libraries 
-   brr
-   js_of_ocaml
-   )
- )
diff --git a/editor/j/j.ml b/editor/j/j.ml
deleted file mode 100755
index 96b22e0..0000000
--- a/editor/j/j.ml
+++ /dev/null
@@ -1,47 +0,0 @@
-type ('a, 'b) prop = Jv.prop'
-
-let prop
-  : string -> ('a, 'b) prop
-  = Jstr.of_string
-
-let get
-  : 'a -> ('a, 'b) prop -> 'b option
-  = fun obj prop ->
-    Jv.get' (Jv.Id.to_jv obj) prop
-    |> Jv.to_option Jv.Id.of_jv
-
-let set
-  : 'a -> ('a, 'b) prop -> 'b -> unit
-  = fun obj prop value ->
-    Jv.set'
-      (Jv.Id.to_jv obj)
-      prop
-      (Jv.Id.to_jv value)
-
-(* Objects *)
-
-type 'a constr = (Jstr.t * Jv.t)
-
-let c
-  : ('a, 'b) prop -> 'b -> 'a constr
-  = fun prop v ->
-    (prop, Jv.Id.to_jv v)
-
-let obj
-  : 'a constr Array.t -> 'a
-  = fun props ->
-    Jv.Id.of_jv @@ Jv.obj' props
-
-(* Arrays *)
-
-type 'a array = Jv.t
-
-let to_array
-  : 'a array -> 'a Array.t
-  = fun arr ->
-    Jv.to_array Jv.Id.of_jv arr
-
-let of_array
-  : 'a Array.t -> 'a array
-  = fun arr ->
-    Jv.of_array Jv.Id.to_jv arr
diff --git a/editor/j/j.mli b/editor/j/j.mli
deleted file mode 100755
index 796bb9d..0000000
--- a/editor/j/j.mli
+++ /dev/null
@@ -1,32 +0,0 @@
-(** The type properties *)
-type ('a, 'b) prop
-
-val prop
-  : string -> ('a, 'b) prop
-
-val get
-  : 'a -> ('a, 'b) prop -> 'b option
-
-val set
-  : 'a -> ('a, 'b) prop -> 'b -> unit
-
-
-(* Arrays *)
-
-type 'a array
-
-val to_array
-  : 'a array -> 'a Array.t
-
-val of_array
-  : 'a Array.t -> 'a array
-
-(* Object constructor *)
-
-type 'a constr
-
-val c
-  : ('a, 'b) prop -> 'b -> 'a constr
-
-val obj
-  : 'a constr Array.t -> 'a
diff --git a/editor/prosemirror/bindings.ml b/editor/prosemirror/bindings.ml
index d2ef2e6..08db819 100755
--- a/editor/prosemirror/bindings.ml
+++ b/editor/prosemirror/bindings.ml
@@ -1,14 +1,53 @@
 open Js_of_ocaml.Js
 
+class type ['a] ordered_map = object ('this)
+
+  method get:
+    Jstr.t -> 'a t opt meth
+
+  method update:
+    Jstr.t -> 'a t -> Jstr.t opt -> 'this meth
+
+  method remove:
+    Jstr.t -> 'this meth
+
+  method addToStart:
+    Jstr.t -> 'a t -> 'this meth
+
+  method addToEnd:
+    Jstr.t -> 'a t -> 'this meth
+
+end
+
 module Model = struct
 
   type mark
 
-  type schema
+  type node_spec
+
+  type mark_spec
 
-  type content_match
+  class type schema_spec = object ('this)
 
-  type node_spec
+    method nodes:
+      node_spec ordered_map t readonly_prop
+
+    method marks:
+      mark_spec ordered_map t readonly_prop
+
+    method topNode:
+      Jstr.t opt readonly_prop
+
+  end
+
+  class type schema = object ('this)
+
+    method spec:
+      schema_spec t prop
+
+  end
+
+  type content_match
 
   type slice
 
@@ -43,7 +82,7 @@ module Model = struct
     inherit _node_props
 
     method name:
-      string readonly_prop
+      Jstr.t readonly_prop
 
     method schema:
       schema t readonly_prop
@@ -363,6 +402,57 @@ module View = struct
 
 end
 
+module SchemaBasic = struct
+
+  class type nodes = object ('this)
+
+    method doc:
+      Model.node_spec t prop
+
+    method paragraph:
+      Model.node_spec t prop
+
+    method blockquote:
+      Model.node_spec t prop
+
+    method horizontal_rule:
+      Model.node_spec t prop
+
+    method heading:
+      Model.node_spec t prop
+
+    method code_block:
+      Model.node_spec t prop
+
+    method text:
+      Model.node_spec t prop
+
+    method image:
+      Model.node_spec t prop
+
+    method hard_break:
+      Model.node_spec t prop
+
+  end
+
+  class type marks = object ('this)
+
+    method link:
+      Model.mark_spec t prop
+
+    method em:
+      Model.mark_spec t prop
+
+    method strong:
+      Model.mark_spec t prop
+
+    method code:
+      Model.mark_spec t prop
+
+  end
+
+end
+
 module History = struct
 
   class type history_prop = object ('this)
diff --git a/editor/prosemirror/dune b/editor/prosemirror/dune
index 4fff7b2..730af26 100755
--- a/editor/prosemirror/dune
+++ b/editor/prosemirror/dune
@@ -3,7 +3,6 @@
  (libraries 
    brr
    js_of_ocaml
-   j
    )
  (preprocess (pps js_of_ocaml-ppx))
  )
diff --git a/editor/prosemirror/prosemirror.ml b/editor/prosemirror/prosemirror.ml
index bf72227..c19abe0 100755
--- a/editor/prosemirror/prosemirror.ml
+++ b/editor/prosemirror/prosemirror.ml
@@ -8,57 +8,53 @@ let v
   = 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
+    type parser = Jv.t
 
     let from_schema
-      : pm_model -> schema Js.t -> t
-      = fun model 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
-      : t -> El.t -> node Js.t
+      : 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 ->
@@ -69,13 +65,6 @@ module Model = struct
 
 end
 
-type pm_transform = Jv.t
-
-let transform
-  : (t, pm_transform) J.prop
-  = J.prop "prosemirror-transform"
-
-
 module State = struct
 
   include Bindings.State
@@ -89,15 +78,17 @@ module State = struct
     = fun () -> Js_of_ocaml.Js.Unsafe.obj [||]
 
   let create
-    : pm_state -> creation_prop Js.t -> editor_state Js.t
-    = fun state props ->
+    : 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
-    : pm_state -> configuration_prop Js_of_ocaml.Js.t -> Brr.Json.t -> editor_state Js.t
-    = fun state config json ->
+    : t -> configuration_prop Js_of_ocaml.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
@@ -117,33 +108,39 @@ module View = struct
     = 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 ->
+    : t -> El.t -> direct_editor_props Js.t -> editor_view Js.t
+    = fun t node props ->
+      let view = Jv.get t "view" in
       Jv.new' (Jv.get view "EditorView") [|Jv.Id.to_jv node ; Jv.Id.to_jv props|]
       |> Jv.Id.of_jv
 end
 
-(* Schema list *)
+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
 
-type schema_list = Jv.t
+      let list_group = Jv.of_option ~none:Jv.null Jv.of_jstr list_group_opt in
 
-let schema_list
-  : (t, schema_list) J.prop
-  = J.prop "schema_list"
+      Jv.call schema_list "addListNodes"
+        [|Jv.Id.to_jv nodes
+         ; Jv.of_jstr item_content
+         ; list_group |]
+      |> Jv.Id.of_jv
 
-module SchemaList = struct
+end
 
-  let js f = Jv.of_jstr @@ Jstr.v f
+module SchemaBasic = struct
 
-  let js_opt = Jv.of_option
-      ~none:Jv.null
-      js
+  include Bindings.SchemaBasic
 
-  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
+  let schema
+    : t -> Model.schema Js.t
+    = fun t ->
+      Jv.get (Jv.get t "schema_basic") "schema"
+      |> Jv.Id.of_jv
 
 end
 
diff --git a/editor/prosemirror/prosemirror.mli b/editor/prosemirror/prosemirror.mli
index 1e0e889..aa27bf4 100755
--- a/editor/prosemirror/prosemirror.mli
+++ b/editor/prosemirror/prosemirror.mli
@@ -6,65 +6,41 @@ 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
 
+  val schema_spec: 
+    node_spec Bindings.ordered_map Js.t
+    -> mark_spec Bindings.ordered_map Js.t option 
+    -> string option 
+    -> schema_spec Js.t
+
+  val schema 
+    : t -> schema_spec Js.t -> schema Js.t 
 
   module DOMParser : sig
-    type t
+
+    type parser
 
     val from_schema
-      : pm_model -> schema Js.t -> t
+      : t -> schema Js.t -> parser
 
     val parse
-      : t -> El.t -> node Js.t
+      : parser -> 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
+    : t -> Model.node_spec Bindings.ordered_map Js.t -> Jstr.t -> Jstr.t option -> Model.node_spec Bindings.ordered_map Js.t
 
 end
 
@@ -81,10 +57,10 @@ and State : sig
     : unit -> creation_prop Js.t 
 
   val create
-    : pm_state -> creation_prop Js.t -> editor_state Js.t
+    : t -> creation_prop Js.t -> editor_state Js.t
 
   val fromJSON 
-    : pm_state -> configuration_prop Js.t -> Brr.Json.t -> editor_state Js.t
+    : t -> configuration_prop Js.t -> Brr.Json.t -> editor_state Js.t
 
 end
 
@@ -104,7 +80,16 @@ and View : sig
     : unit -> direct_editor_props Js.t
 
   val editor_view
-    : pm_view -> El.t -> direct_editor_props Js.t -> editor_view Js.t
+    : t -> El.t -> direct_editor_props Js.t -> editor_view Js.t
+
+end
+
+module SchemaBasic : sig
+
+  include module type of Bindings.SchemaBasic
+
+  val schema 
+    : t -> Model.schema Js.t
 
 end
 
diff --git a/editor/quill.ml b/editor/quill.ml
deleted file mode 100755
index 8069d90..0000000
--- a/editor/quill.ml
+++ /dev/null
@@ -1,101 +0,0 @@
-open Brr
-
-type t = Jv.t
-
-type options
-
-let bounds
-  : (options, El.t) J.prop
-  = J.prop "bounds"
-
-let debug
-  : (options, Jstr.t) J.prop
-  = J.prop "debug"
-
-let placeholder
-  : (options, Jstr.t) J.prop
-  = J.prop "placeholder"
-
-let readonly
-  : (options, Jstr.t) J.prop
-  = J.prop "readonly"
-
-let theme
-  : (options, Jstr.t) J.prop
-  = J.prop "theme"
-
-let scrollingContainer
-  : (options, El.t) J.prop
-  = J.prop "scrollingContainer"
-
-let options
-  : unit -> options
-  =  Jv.Id.of_jv @@ Jv.obj' [||]
-
-(** Constructor.
-
-    [quill element] will create the editor inside the given element
-
-*)
-let quill
-  : ?options:options -> El.t -> (t, Jv.Error.t) Result.t
-  = fun ?options element ->
-    let quill = Jv.get Jv.global "Quill" in
-
-    let options = Jv.of_option ~none:Jv.undefined Jv.Id.to_jv options in
-
-    match Jv.new' quill Jv.Id.[| to_jv element; options |] with
-    | exception Jv.Error e -> Error e
-    | v -> Ok v
-
-
-type delta = Jv.t
-
-let delta_to_json
-  : delta -> Brr.Json.t
-  = Jv.Id.to_jv
-
-let delta_of_json
-  : Brr.Json.t -> delta
-  = Jv.Id.of_jv
-
-(* Operations is an array *)
-type operations = Jv.t
-
-let ops
-  : (delta, operations) J.prop
-  = J.prop "ops"
-
-
-(** Return the editor content *)
-let get_contents
-  : t -> delta
-  = fun t ->
-    Jv.call t "getContents" [||]
-
-let set_contents
-  : t -> delta -> unit
-  = fun t contents ->
-    ignore @@ Jv.call t "setContents" [|contents|]
-
-(** [extract_content t index length] return the content starting from index,
-    with length elements *)
-let extract_contents
-  : t -> int -> int -> delta
-  = fun t index length ->
-    Jv.call t "getContents" [|Jv.of_int index; Jv.of_int length|]
-
-let on_text_change
-  : t -> (string -> string -> string -> unit) -> unit
-  = fun t callback ->
-    ignore @@ Jv.call t "on" [|Jv.Id.to_jv @@ Jstr.v "text-change" ; Jv.repr callback|]
-
-(* [update_contents t delta] replace the content with the commands given
-   by delta.
-*)
-let update_contents
-  : t -> delta -> delta
-  = fun t delta ->
-    Jv.call t "updateContents" [|delta|]
-
-
diff --git a/editor/quill.mli b/editor/quill.mli
deleted file mode 100755
index 7405102..0000000
--- a/editor/quill.mli
+++ /dev/null
@@ -1,70 +0,0 @@
-open Brr
-
-(** Constructor options *)
-type options
-
-val options
-  : unit -> options
-
-val bounds
-  : (options, El.t) J.prop
-
-val debug
-  : (options, Jstr.t) J.prop
-
-val placeholder
-  : (options, Jstr.t) J.prop
-
-val readonly
-  : (options, Jstr.t) J.prop
-
-val theme
-  : (options, Jstr.t) J.prop
-
-val scrollingContainer
-  : (options, El.t) J.prop
-
-type delta 
-
-val delta_to_json
-  : delta -> Json.t
-
-val delta_of_json
-  : Json.t -> delta
-
-type operations 
-
-val ops
-  : (delta, operations) J.prop
-
-type t 
-
-(** Constructor.
-
-    [quill element] will create the editor inside the given element
-
-*)
-val quill
-  : ?options:options -> El.t -> (t, Jv.Error.t) Result.t
-
-
-(** Return the editor content *)
-val get_contents
-  : t -> delta
-
-val set_contents
-  : t -> delta -> unit
-
-(** [extract_content t index length] return the content starting from index,
-    with length elements *)
-val extract_contents
-  : t -> int -> int -> delta
-
-val on_text_change
-  : t -> (string -> string -> string -> unit) -> unit
-
-(* [update_contents t delta] replace the content with the commands given
-   by delta.
-*)
-val update_contents
-  : t -> delta -> delta