aboutsummaryrefslogtreecommitdiff
path: root/editor/prosemirror/prosemirror.ml
blob: bf72227b84063fd12dab3a0fe68a966021dbe36f (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
open Js_of_ocaml
open Brr

type t = Jv.t

let v
  : unit -> t
  = 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

    let from_schema
      : pm_model -> schema Js.t -> t
      = fun model schema ->
        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
      = fun dom_parser el ->
        Jv.call dom_parser "parse" [|Jv.Id.to_jv el|]
        |> Jv.Id.of_jv

  end

  let empty_fragment
    : t -> fragment Js.t
    = fun t ->
      let model = Jv.get t "model" in
      let fragment = Jv.get model "Fragment" in
      Jv.get fragment "empty"
      |> Jv.Id.of_jv

end

type pm_transform = Jv.t

let transform
  : (t, pm_transform) J.prop
  = J.prop "prosemirror-transform"


module State = struct

  include Bindings.State

  let configuration_prop
    : unit -> configuration_prop Js_of_ocaml.Js.t
    = fun () -> Js_of_ocaml.Js.Unsafe.obj [||]

  let creation_prop
    : unit -> creation_prop Js.t
    = fun () -> Js_of_ocaml.Js.Unsafe.obj [||]

  let create
    : pm_state -> creation_prop Js.t -> editor_state Js.t
    = fun state props ->
      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 ->
      let editor_state = Jv.get state "EditorState" in
      Jv.call editor_state "fromJSON" [|Jv.Id.to_jv config ; json |]
      |> Jv.Id.of_jv
end

(* Editor view *)

module View = struct

  module EditorProps = struct
    type t = Jv.t
  end

  include Bindings.View
  let direct_editor_props
    : unit -> direct_editor_props Js.t
    = 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 ->
      Jv.new' (Jv.get view "EditorView") [|Jv.Id.to_jv node ; Jv.Id.to_jv props|]
      |> Jv.Id.of_jv
end

(* Schema list *)

type schema_list = Jv.t

let schema_list
  : (t, schema_list) J.prop
  = J.prop "schema_list"

module SchemaList = struct

  let js f = Jv.of_jstr @@ Jstr.v f

  let js_opt = Jv.of_option
      ~none:Jv.null
      js

  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

end

module History = struct

  include Bindings.History

  let history_prop
    : unit -> history_prop Js.t
    = fun () -> Js_of_ocaml.Js.Unsafe.obj [||]

  let history
    : t -> history_prop Js.t -> State.plugin Js.t
    = fun t props ->
      Jv.call (Jv.get t "history") "history" [|Jv.Id.to_jv props|]
      |> Jv.Id.of_jv

  let undo
    : t -> State.editor_state Js.t -> (State.transaction -> unit) -> bool
    = fun t state fn ->
      Jv.call (Jv.get t "history") "undo" [|Jv.Id.to_jv state; Jv.repr fn|]
      |> Jv.Id.of_jv

  let redo
    : t -> State.editor_state Js.t -> (State.transaction -> unit) -> bool
    = fun t state fn ->
      Jv.call (Jv.get t "history") "redo" [|Jv.Id.to_jv state; Jv.repr fn|]
      |> Jv.Id.of_jv
end

module Keymap = struct

  let keymap
    : t -> (string * (State.editor_state Js.t -> (State.transaction -> unit) -> bool)) array -> State.plugin Js.t
    = fun t props ->
      let props = Jv.obj @@ Array.map (fun (id, f) -> (id, Jv.repr f)) props in
      Jv.call (Jv.get t "keymap") "keymap" [|props|]
      |> Jv.Id.of_jv

end

module Commands = struct

  let baseKeymap
    : t -> (string * (State.editor_state Js.t -> (State.transaction -> unit) -> bool)) array
    = fun t ->
      Jv.get (Jv.get t "commands") "baseKeymap"
      |> Jv.Id.of_jv

end

(* Example Setup *)

let example_setup
  : t -> Model.schema Js.t -> State.plugin Js.t Js.js_array Js.t
  = fun t schema ->
    let setup = Jv.get t "example_setup" in
    let props = Jv.obj [|("schema", Jv.Id.to_jv schema)|] in
    Jv.call setup "exampleSetup" [|props|]
    |> Jv.Id.of_jv