Added markdown output

5 files changed, 552 insertions, 12 deletions

diff --git a/editor/actions/dune b/editor/actions/dune
index 4044b52..10279dd 100755
--- a/editor/actions/dune
+++ b/editor/actions/dune
@@ -3,6 +3,7 @@
  (libraries 
    brr
    brr.note
+   omd
    elements
    blog
    forms
diff --git a/editor/actions/editor_actions.ml b/editor/actions/editor_actions.ml
index 91d2a24..518e0c7 100755
--- a/editor/actions/editor_actions.ml
+++ b/editor/actions/editor_actions.ml
@@ -17,8 +17,8 @@ type t =
   }
 
 let build
-  : unit -> t
-  = fun () ->
+  : Prosemirror.t -> t
+  = fun pm ->
 
     let delete_button = El.button
         ~at:At.[ class' (Jstr.v "action-button") ]
@@ -56,6 +56,16 @@ let build
             ~at:At.[ class' (Jstr.v "fa")
                    ; class' (Jstr.v "fa-2x")
                    ; class' (Jstr.v "fa-upload") ] ]
+
+    and cog_button = El.button
+        ~at:At.[class' (Jstr.v "action-button")]
+        [ El.i
+            []
+            ~at:At.[ class' (Jstr.v "fa")
+                   ; class' (Jstr.v "fa-2x")
+                   ; class' (Jstr.v "fa-cog") ]
+        ]
+
     in
 
     (* We are waiting for event inside another event ( form validation inside
@@ -89,6 +99,11 @@ let build
           Ev.click
           (fun _ -> Import.create ())
           load_button)
+    and cog_event =
+      Evr.on_el
+        Ev.click
+        (fun _ -> To_markdown.create pm)
+        cog_button
     in
 
 
@@ -128,14 +143,7 @@ let build
       ; export_button
       ; load_button
       ; delete_button
-      ; El.button
-          ~at:At.[class' (Jstr.v "action-button")]
-          [ El.i
-              []
-              ~at:At.[ class' (Jstr.v "fa")
-                     ; class' (Jstr.v "fa-2x")
-                     ; class' (Jstr.v "fa-cog") ]
-          ]
+      ; cog_button
       ; El.hr ()
       ; ul ] in
 
@@ -145,7 +153,8 @@ let build
         ; redirect_event
         ; add_event
         ; export_event
-        ; import_event ] in
+        ; import_event
+        ; cog_event ] in
 
     { ev = result_event
     ; childs
diff --git a/editor/actions/editor_actions.mli b/editor/actions/editor_actions.mli
index 0e9997b..a0a3c3b 100755
--- a/editor/actions/editor_actions.mli
+++ b/editor/actions/editor_actions.mli
@@ -2,7 +2,7 @@ type t
 
 (** Create the elements to be declared inside the panel *)
 val build
-  : unit -> t
+  : Prosemirror.t -> t
 
 (** Get the events triggered by the actions buttons *)
 val get_event
diff --git a/editor/actions/of_markdown.ml b/editor/actions/of_markdown.ml
new file mode 100755
index 0000000..580c6c4
--- /dev/null
+++ b/editor/actions/of_markdown.ml
@@ -0,0 +1,236 @@
+open StdLabels
+module Js = Js_of_ocaml.Js
+module PM = Prosemirror
+
+type node_t = PM.Model.node Js.t
+
+module FromMarkdown = struct
+
+  type t = PM.t * Omd.doc
+
+  (** Add the given mark in the mark list.
+      The attributes, if any, are added to the mark properties. *)
+  let add_attribute
+    : string -> PM.Model.schema Js.t -> PM.Model.mark Js.t list -> Jv.prop PM.O.t Js.opt -> PM.Model.mark Js.t list
+    = fun name schema marks attributes ->
+      match PM.O.get schema##.marks name with
+      | None -> marks
+      | Some mark_type ->
+        let m = schema##mark_fromType mark_type attributes in
+        m::marks
+
+  (** The function [parse_inline] will tranform all the inline markup to a
+      Prosemirror node.
+
+      This apply to element like bold, links and so one. *)
+  let rec parse_inline_content
+    : Prosemirror.View.editor_view Js.t
+      -> PM.t
+      -> PM.Model.mark Js.t list
+      -> Omd.attributes Omd.inline
+      -> node_t Js.js_array Js.t
+    = fun view pm marks -> function
+      | Omd.Concat (attrs, els) ->
+        ignore attrs;
+
+        let nodes =
+          List.to_seq els
+          |> Seq.map (fun e -> parse_inline_content view pm marks e)
+          |> Array.of_seq
+          |> Js.array in
+
+        (* Flatten each array returned *)
+        nodes##reduce_init
+          (Js.wrap_callback
+           @@ fun (init: node_t Js.js_array Js.t) (elems: node_t Js.js_array Js.t) _ _ ->
+           init##concat elems)
+          (new%js Js.array_empty)
+
+      | Omd.Strong (attrs, content) ->
+        (* Strong (or Emph) elements just add the coresponding mark and
+           process the content further *)
+        ignore attrs;
+        let marks = add_attribute
+            "strong"
+            view##.state##.schema
+            marks
+            Js.null in
+        parse_inline_content view pm marks content
+
+      | Omd.Emph (attrs, content) ->
+        ignore attrs;
+        let marks = add_attribute
+            "em"
+            view##.state##.schema
+            marks
+            Js.null in
+        parse_inline_content view pm marks content
+
+      | Omd.Text (attrs, text) ->
+        ignore attrs;
+        (* Convert the marks as js array *)
+        let js_marks = Js.array @@ Array.of_list marks in
+        Js.array
+          [| view##.state##.schema##text
+               (Jstr.of_string text)
+               (Js.some js_marks)
+          |]
+
+      | Omd.Code (attrs, content) ->
+        ignore attrs;
+        let marks = add_attribute
+            "code"
+            view##.state##.schema
+            marks
+            Js.null in
+        let js_marks = Js.array @@ Array.of_list marks in
+        Js.array
+          [| view##.state##.schema##text
+               (Jstr.of_string content)
+               (Js.some js_marks)
+          |]
+
+      | Omd.Link (attrs, link_attrs) ->
+        ignore attrs;
+        let attrs' = PM.O.init
+            [| "href", link_attrs.destination
+            (* TODO Handle title *)
+            |] in
+        let marks = add_attribute
+            "link"
+            view##.state##.schema
+            marks
+            (Js.some attrs') in
+        parse_inline_content view pm marks link_attrs.label
+
+      | _ ->
+        (* TODO Handle Break *)
+        Brr.Console.(log [Jstr.v "Other"]);
+        new%js Js.array_empty
+
+  let rec parse_block
+    : Prosemirror.View.editor_view Js.t -> PM.t -> Omd.attributes Omd.block -> node_t option
+    = fun view pm -> function
+
+      | Omd.Paragraph (attrs, elements) ->
+        ignore attrs;
+        let marks = [] in
+        (* Transform each node inside the markdown document and add them into the
+           paragraph node *)
+        let nodes = parse_inline_content view pm marks elements in
+        let fragment = PM.Model.Fragment.from_array pm nodes in
+        let node = view##.state##.schema##node
+            (Jstr.v "paragraph")
+            (Js.null)
+            (Js.some fragment)
+            (Js.null) in
+        Some node
+
+      | Omd.Heading (attrs, level, elements) ->
+        ignore attrs;
+        let marks = [] in
+        (* Heading is like a paragraph, but with an attribute (the level) *)
+        let attributes = object%js val level = level end
+        and nodes = parse_inline_content view pm marks elements in
+        let fragment = PM.Model.Fragment.from_array pm nodes in
+        let node = view##.state##.schema##node
+            (Jstr.v "heading")
+            (Js.some attributes)
+            (Js.some fragment)
+            (Js.null) in
+        Some node
+
+      | Omd.List (attrs, type_, spacing, elements) ->
+        ignore attrs;
+        ignore spacing;
+
+        let type_list = match type_ with
+          | Omd.Ordered _ -> "ordered_list"
+          | Omd.Bullet _ -> "bullet_list" in
+
+        (* The whole list node is declared as ordered or bullet depending of
+           the type given by the markdown.
+
+           Each element insiide the list is transformed as a list_item.
+
+           The list_item node can itself contains other blocks (recursively) *)
+        let nodes = List.map elements
+            ~f:(fun list_entry ->
+                let nodes = (List.filter_map list_entry
+                               ~f:(fun e -> parse_block view pm e))
+                            |> Array.of_list
+                            |> Js.array in
+                let fragment = PM.Model.Fragment.from_array pm nodes in
+                view##.state##.schema##node
+                  (Jstr.v "list_item")
+                  (Js.null)
+                  (Js.some fragment)
+                  (Js.null)
+              ) in
+        let nodes_array= nodes
+                         |> Array.of_list
+                         |> Js.array in
+
+        let fragment = PM.Model.Fragment.from_array pm nodes_array in
+        let node = view##.state##.schema##node
+            (Jstr.v type_list)
+            (Js.null)
+            (Js.some fragment)
+            (Js.null) in
+        Some node
+
+      | Omd.Thematic_break attrs ->
+        ignore attrs;
+        let node = view##.state##.schema##node
+            (Jstr.v "horizontal_rule")
+            (Js.null)
+            (Js.null)
+            (Js.null) in
+        Some node
+
+      | Omd.Blockquote(attrs, elements) ->
+        ignore attrs;
+        let nodes =
+          List.filter_map elements
+            ~f:(fun e -> parse_block view pm e)
+          |> Array.of_list
+          |> Js.array in
+        let fragment = PM.Model.Fragment.from_array pm nodes in
+        let node = view##.state##.schema##node
+            (Jstr.v "blockquote")
+            (Js.null)
+            (Js.some fragment)
+            (Js.null) in
+        Some node
+
+      | _ ->
+        Brr.Console.(log [Jstr.v "Other block"]);
+        None
+
+  let parse
+    : Prosemirror.View.editor_view Js.t -> PM.t -> Omd.doc -> unit
+    = fun view pm doc ->
+      Brr.Console.( log [ doc ]);
+      (* Transform each node inside the markdown document and add them into the
+         root node *)
+      let nodes =
+        doc
+        |> List.filter_map ~f:(fun b -> parse_block view pm b)
+        |> Array.of_list
+        |> Js.array
+      in
+      let fragment = PM.Model.Fragment.from_array pm nodes in
+      let document = view##.state##.schema##node
+          (Jstr.v "doc")
+          (Js.null)
+          (Js.some fragment)
+          (Js.null) in
+      Brr.Console.(log [ document ])
+
+  let update
+    : t -> State.t -> State.t
+    = fun (pm, doc) state ->
+      let () = parse state.State.view pm doc in
+      state
+end
+
diff --git a/editor/actions/to_markdown.ml b/editor/actions/to_markdown.ml
new file mode 100755
index 0000000..c1ac774
--- /dev/null
+++ b/editor/actions/to_markdown.ml
@@ -0,0 +1,294 @@
+module Js = Js_of_ocaml.Js
+module PM = Prosemirror
+
+type buffer = Jstr.t Js.js_array Js.t
+type f = (buffer -> PM.Model.node Js.t -> unit)
+
+let render_mark_type = object%js
+
+  method code
+    = fun (mark:PM.Model.mark Js.t) (buffer: buffer) ->
+      ignore mark;
+      (* There may be a bug here, if the code itself contains `` .
+
+         The encoder should search inside the node if the patern is present,
+         and adjust the number of backticks accordingly
+
+         https://spec.commonmark.org/0.29/#code-span *)
+      ignore @@ buffer##push (Jstr.v "``");
+      fun (buffer:buffer) ->
+        ignore @@ buffer##push (Jstr.v "``")
+
+  method strong
+    = fun (mark:PM.Model.mark Js.t) (buffer: buffer) ->
+      ignore mark;
+      ignore @@ buffer##push (Jstr.v "**");
+      fun (buffer:buffer) ->
+        ignore @@ buffer##push (Jstr.v "**")
+
+  method em
+    = fun (mark:PM.Model.mark Js.t) (buffer: buffer) ->
+      ignore mark;
+      ignore @@ buffer##push (Jstr.v "*");
+      fun (buffer:buffer) ->
+        ignore @@ buffer##push (Jstr.v "*")
+
+  (**
+     https://spec.commonmark.org/0.29/#links
+  *)
+  method link
+    = fun (mark:PM.Model.mark Js.t) (buffer: buffer) ->
+      ignore @@ buffer##push (Jstr.v "[");
+      fun (buffer:buffer) ->
+        ignore @@ buffer##push (Jstr.v "](");
+        let href_opt = PM.O.get (mark##.attrs) "href" in
+        Option.iter
+          (fun href -> ignore @@ buffer##push (href))
+          href_opt;
+        ignore @@ buffer##push (Jstr.v ")");
+
+end
+
+type render_state =
+  { level : int
+  ; apply_indent : bool }
+
+(* Check if a property exists in the object with the name of
+   node type, and if so, call the appropriate method.
+*)
+let process_node obj (state:render_state) buffer node =
+  let name = node##._type##.name in
+  match Jv.find' (Jv.Id.to_jv obj) name with
+  | None ->
+    Brr.Console.(log
+                   [ Jstr.v "Unknow type"
+                   ; name
+                   ; node ])
+  | Some _ ->
+
+    Jv.call'
+      (Jv.Id.to_jv obj)
+      name
+      [| Jv.Id.to_jv state
+       ; Jv.Id.to_jv buffer
+       ; Jv.Id.to_jv node
+      |]
+
+let render_node_type = object%js (_this)
+
+  (* https://spec.commonmark.org/0.29/#thematic-breaks *)
+  method horizontal_rule_
+    = fun (state:render_state) (buffer: buffer) (node:PM.Model.node Js.t) ->
+      ignore state;
+      ignore node;
+      if state.level <> 0 then (
+        ignore @@ buffer##push (Jstr.v "\n");
+        ignore @@ buffer##push (Jstr.(repeat state.level (v " ") ));
+        ignore @@ buffer##push (Jstr.v "---\n");
+      ) else (
+        ignore @@ buffer##push (Jstr.v "\n---\n")
+      )
+
+  method text
+    = fun (state:render_state) (buffer: buffer) (node:PM.Model.node Js.t) ->
+
+      ignore state;
+      (* Execute each mark as an environment like
+         \begin{environement}
+            …
+         \end{environment}
+
+         this way, nested marks are working correctly
+
+      *)
+      let post_render = node##.marks##reduce_init
+          (Js.wrap_callback @@ fun (acc:(buffer -> unit) Js.js_array Js.t) (mark: PM.Model.mark Js.t) (_:int) _ ->
+           let name = mark##._type##.name in
+           match Jv.find' (Jv.Id.to_jv render_mark_type) name with
+           | None ->
+             Brr.Console.(
+               log [ Jstr.v "Unknown mark type"
+                   ; name]);
+             acc
+           | Some _ ->
+             (* Add the element as first (lifo) *)
+             ignore @@ acc##unshift
+               (Jv.call'
+                  (Jv.Id.to_jv render_mark_type)
+                  name
+                  [| Jv.Id.to_jv mark
+                   ; Jv.Id.to_jv buffer
+                  |]);
+             acc)
+          (new%js Js.array_empty)
+      in
+      let () =
+        if node##.isText == Js._true then
+          Js.Opt.iter
+            node##.text
+            (fun content -> ignore @@ buffer##push content) in
+      post_render##forEach
+        (Js.wrap_callback @@ fun (call:(buffer -> unit)) (_:int) _ -> call buffer)
+
+  method heading
+    = fun (state:render_state) (buffer: buffer) (node:PM.Model.node Js.t) ->
+
+      let h_level:int = node##.attrs##.level in
+      ignore @@ buffer##push (Jstr.(repeat h_level (v "#") ));
+      ignore @@ buffer##push (Jstr.v " ");
+      node##.content##forEach
+        ( Js.wrap_meth_callback @@ fun _ node ~offset ~index ->
+          let _ = offset
+          and _ = index in
+          process_node _this state buffer node);
+      ignore @@ buffer##push (Jstr.(v "\n\n" ))
+
+  method paragraph
+    = fun (state:render_state) (buffer: buffer) (node:PM.Model.node Js.t) ->
+      node##.content##forEach
+        ( Js.wrap_meth_callback @@ fun _ node ~offset ~index ->
+          ignore offset;
+          ignore index;
+          if state.apply_indent then (
+            ignore @@ buffer##push (Jstr.(repeat state.level (v " ") ))
+          );
+          process_node _this state buffer node);
+      ignore @@ buffer##push (Jstr.(v "\n" ))
+
+  method list_item_
+    = fun (state:render_state) (buffer: buffer) (node:PM.Model.node Js.t) ->
+
+      node##.content##forEach
+        ( Js.wrap_meth_callback @@ fun _ node ~offset ~index ->
+          ignore offset;
+          (* The first element in the list should be correctly indented, but if
+              there is many elements inside the list (paragraph) we have to
+              apply the indentation again.
+          *)
+          let new_state = { state with apply_indent = index <> 0 } in
+          process_node _this new_state buffer node);
+
+  method bullet_list_
+    = fun (state:render_state) (buffer: buffer) (node:PM.Model.node Js.t) ->
+      node##.content##forEach
+        ( Js.wrap_meth_callback @@ fun _ node ~offset ~index ->
+          ignore offset;
+          if state.level <> 0 && (index <> 0 || state.apply_indent) then (
+            ignore @@ buffer##push (Jstr.(repeat state.level (v " ") ))
+          );
+          ignore @@ buffer##push (Jstr.v "- ");
+          let new_state =
+            { level = state.level + 2
+            ; apply_indent = false
+            } in
+          process_node _this new_state buffer node);
+      if (state.level == 0) then
+        ignore @@ buffer##push (Jstr.(v "\n" ))
+
+  method ordered_list_
+    = fun (state:render_state) (buffer: buffer) (node:PM.Model.node Js.t) ->
+      node##.content##forEach
+        ( Js.wrap_meth_callback @@ fun _ node ~offset ~index ->
+          ignore offset;
+          if state.level <> 0 && (index <> 0 || state.apply_indent) then (
+            ignore @@ buffer##push (Jstr.(repeat state.level (v " ") ))
+          );
+          let num = Jstr.of_int (1 + index) in
+          let prefix = Jstr.( num + (v ". ")) in
+          ignore @@ buffer##push prefix;
+          let new_state =
+            { level = state.level + (Jstr.length prefix)
+            ; apply_indent = false
+            } in
+          process_node _this new_state buffer node);
+      if (state.level == 0) then
+        ignore @@ buffer##push (Jstr.(v "\n" ))
+
+  (* https://spec.commonmark.org/0.29/#fenced-code-blocks *)
+  method code_block_
+    = fun (state:render_state) (buffer: buffer) (node:PM.Model.node Js.t) ->
+      ignore @@ buffer##push (Jstr.v "```\n");
+      node##.content##forEach
+        ( Js.wrap_meth_callback @@ fun _ node ~offset ~index ->
+          ignore index;
+          ignore offset;
+          let new_state =
+            { state with
+              apply_indent = true
+            } in
+          process_node _this new_state buffer node);
+      if state.apply_indent then (
+        ignore @@ buffer##push (Jstr.(repeat state.level (v " ") ))
+      );
+      ignore @@ buffer##push (Jstr.v "\n```\n")
+
+  (** https://spec.commonmark.org/0.29/#block-quotes *)
+  method blockquote
+    = fun (state:render_state) (buffer: buffer) (node:PM.Model.node Js.t) ->
+      node##.content##forEach
+        ( Js.wrap_meth_callback @@ fun _ node ~offset ~index ->
+          ignore index;
+          ignore offset;
+          ignore @@ buffer##push (Jstr.v "> ");
+          let new_state =
+            { level = state.level + 2
+            ; apply_indent = false
+            } in
+          process_node _this new_state buffer node);
+      ignore @@ buffer##push (Jstr.v "\n");
+end
+
+
+
+module ToMarkdown = struct
+
+  type t = PM.t
+
+  let update
+    : t -> State.t -> State.t
+    = fun pm state ->
+
+      let view = state.State.view in
+      let root_node = view##.state##.doc in
+      let buffer = new%js Js.array_empty in
+
+      Brr.Console.(log [Obj.magic root_node]);
+
+      let () = root_node##forEach
+          (Js.wrap_meth_callback @@ fun _ node ~offset ~index ->
+           let _ = offset
+           and _ = index in
+
+           let init =
+             { level = 0
+             ; apply_indent = false } in
+
+
+           process_node render_node_type init buffer node
+          ) in
+
+      (* Concatenate the array into a single string *)
+      let js_markdown = buffer##join (Js.string "") in
+      let markdown = Js.to_string js_markdown in
+      Brr.Console.(log [js_markdown]);
+      let doc = Omd.of_string markdown in
+      let new_doc = Of_markdown.FromMarkdown.parse view pm doc in
+
+      Brr.Console.(log
+      [ Jstr.v "Are the same ?"
+          ; (Obj.magic @@ Js_of_ocaml.Js.bool (root_node = new_doc))
+      ]);
+
+      (* The function does not actually update the state, and return it
+         unchanged *)
+      state
+
+end
+
+(** Create a new element *)
+let create
+  : PM.t -> State.event
+  = fun pm ->
+    State.E
+      ( pm
+      , (module ToMarkdown : State.Event with type t = ToMarkdown.t ))