From 1961a9779b482cf9cbdb3365137c2e74423067c6 Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@dailly.me>
Date: Mon, 7 Feb 2022 16:00:56 +0100
Subject: Text editor using quill

---
 editor/editor.ml | 203 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 203 insertions(+)
 create mode 100755 editor/editor.ml

(limited to 'editor/editor.ml')

diff --git a/editor/editor.ml b/editor/editor.ml
new file mode 100755
index 0000000..aeb96c1
--- /dev/null
+++ b/editor/editor.ml
@@ -0,0 +1,203 @@
+open Brr
+open Note
+
+module Prop
+  : sig
+
+    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
+  end
+
+= struct
+
+  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)
+
+end
+
+module Quill = struct
+
+  type t = Jv.t
+
+  type options
+
+  let bounds
+    : (options, El.t) Prop.prop
+    = Prop.prop "bounds"
+
+  let debug
+    : (options, Jstr.t) Prop.prop
+    = Prop.prop "debug"
+
+  let placeholder
+    : (options, Jstr.t) Prop.prop
+    = Prop.prop "placeholder"
+
+  let readonly
+    : (options, Jstr.t) Prop.prop
+    = Prop.prop "readonly"
+
+  let theme
+    : (options, Jstr.t) Prop.prop
+    = Prop.prop "theme"
+
+  let scrollingContainer
+    : (options, El.t) Prop.prop
+    = Prop.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
+
+  (* Operations is an array *)
+  type operations = Jv.t
+
+  let ops
+    : (delta, operations) Prop.prop
+    = Prop.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 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|]
+
+
+end
+
+let storage_key = (Jstr.v "content")
+let save_contents
+  : Quill.t -> unit
+  = fun editor ->
+    let storage = Brr_io.Storage.local G.window in
+    let contents = Quill.get_contents editor in
+    Brr_io.Storage.set_item
+      storage
+      storage_key
+      (Json.encode @@ Jv.Id.of_jv @@ contents)
+    |> Console.log_if_error ~use:()
+
+let load_contents
+  : Quill.t -> unit
+  = fun editor ->
+    let storage = Brr_io.Storage.local G.window in
+    Brr_io.Storage.get_item
+      storage
+      storage_key
+    |> Option.iter (fun contents ->
+
+
+        Json.decode contents
+        |> Result.map (fun json ->
+            Quill.set_contents editor json
+          )
+        |> Console.log_if_error ~use:()
+      )
+
+
+
+let page_main id =
+  begin match (Jv.is_none id) with
+    | true -> Console.(error [str "No element with id '%s' found"; id])
+    | false ->
+      let options = Quill.options () in
+      Prop.set options Quill.placeholder (Jstr.v "Nouvelle note…");
+      Prop.set options Quill.theme (Jstr.v "snow");
+
+      (* Create the editor with the configuration *)
+      Quill.quill ~options (Jv.Id.of_jv id)
+      |> Result.iter (fun editor ->
+
+          load_contents editor;
+
+
+          let () = Quill.on_text_change editor (fun delta old source ->
+              let _ = delta
+              and _ = old
+              and _ = source
+              in
+              ()
+            )
+          in
+
+          (* Attach an event on focus out *)
+          let out_event = Brr_note.Evr.on_el
+              (Ev.focusout)
+              (fun _ -> save_contents editor)
+              (Jv.Id.of_jv id) in
+
+          (* Prevent the event to be garbage collected *)
+          E.log out_event  (fun _ -> ())
+          |> Option.iter Logr.hold
+        )
+  end
+
+let () =
+
+  let open Jv in
+  let editor = obj
+      [| "attach", (repr page_main)
+      |] in
+
+  set global "editor" editor
-- 
cgit v1.2.3