From f4a59ed2811d4dca2daad58d083078c01488dd11 Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@dailly.me>
Date: Mon, 7 Feb 2022 15:54:32 +0100
Subject: Added prosemirror deps
---
editor/dune | 1 -
editor/editor.ml | 47 ++++++---------
editor/j/dune | 7 ---
editor/j/j.ml | 47 ---------------
editor/j/j.mli | 32 ----------
editor/prosemirror/bindings.ml | 98 ++++++++++++++++++++++++++++--
editor/prosemirror/dune | 1 -
editor/prosemirror/prosemirror.ml | 119 ++++++++++++++++++-------------------
editor/prosemirror/prosemirror.mli | 67 ++++++++-------------
editor/quill.ml | 101 -------------------------------
editor/quill.mli | 70 ----------------------
11 files changed, 195 insertions(+), 395 deletions(-)
delete mode 100755 editor/j/dune
delete mode 100755 editor/j/j.ml
delete mode 100755 editor/j/j.mli
delete mode 100755 editor/quill.ml
delete mode 100755 editor/quill.mli
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
--
cgit v1.2.3