diff options
Diffstat (limited to 'editor')
-rwxr-xr-x | editor/dune | 1 | ||||
-rwxr-xr-x | editor/editor.ml | 47 | ||||
-rwxr-xr-x | editor/j/dune | 7 | ||||
-rwxr-xr-x | editor/j/j.ml | 47 | ||||
-rwxr-xr-x | editor/j/j.mli | 32 | ||||
-rwxr-xr-x | editor/prosemirror/bindings.ml | 98 | ||||
-rwxr-xr-x | editor/prosemirror/dune | 1 | ||||
-rwxr-xr-x | editor/prosemirror/prosemirror.ml | 119 | ||||
-rwxr-xr-x | editor/prosemirror/prosemirror.mli | 67 | ||||
-rwxr-xr-x | editor/quill.ml | 101 | ||||
-rwxr-xr-x | editor/quill.mli | 70 |
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 |