jon.recoil.org
forked from
anil.recoil.org/monopam-myspace
My aggregated monorepo of OCaml code, automaintained
1module State = struct
2 module Config = struct
3 type t = Jv.t
4
5 let create ?doc ?selection ?extensions () =
6 let o = Jv.obj [||] in
7 Jv.Jstr.set_if_some o "doc" doc;
8 Jv.set_if_some o "selection" selection;
9 Jv.set_if_some o "extensions"
10 (Option.map (Jv.of_array Extension.to_jv) extensions);
11 o
12 end
13
14 module type Facet = sig
15 type t
16
17 include Jv.CONV with type t := t
18
19 type input
20 type output
21
22 val of_ : t -> input -> Extension.t
23 end
24
25 module FacetMaker (I : sig
26 type t
27
28 val to_jv : t -> Jv.t
29 end) : Facet with type input = I.t and type output = Jv.t = struct
30 type t = Jv.t
31
32 include (Jv.Id : Jv.CONV with type t := t)
33
34 type input = I.t
35 type output = Jv.t
36
37 let of_ t i = Jv.call t "of" [| I.to_jv i |] |> Extension.of_jv
38 end
39
40 type ('i, 'o) facet =
41 | Facet :
42 (module Facet with type input = 'i and type output = 'o and type t = 'a)
43 * 'a
44 -> ('i, 'o) facet
45
46 type t = Jv.t
47
48 include (Jv.Id : Jv.CONV with type t := t)
49
50 let create ?(config = Jv.undefined) () =
51 let editor_state = Jv.get Jv.global "__CM__state" in
52 Jv.call editor_state "create" [| config |]
53
54 let doc t = Jv.get t "doc" |> Text.of_jv
55
56 let set_doc t str =
57 let arg =
58 Jv.obj
59 [|
60 ("from", Jv.of_int 0);
61 ("to", Jv.of_int (Text.length (doc t)));
62 ("insert", Jv.of_jstr str);
63 |]
64 in
65 Jv.call t "update" [| Jv.obj [| ("changes", arg) |] |]
66end
67
68(* Helper for function *)
69module Func (I : sig
70 type t
71
72 include Jv.CONV with type t := t
73end) =
74struct
75 type t = I.t -> unit
76
77 let to_jv f = Jv.repr f
78end
79
80module View = struct
81 type t = Jv.t
82
83 include (Jv.Id : Jv.CONV with type t := t)
84
85 type opts = Jv.t
86
87 let opts ?state ?parent ?root ?dispatch () =
88 let o = Jv.obj [||] in
89 Jv.set_if_some o "state" state;
90 Jv.set_if_some o "root" (Option.map Brr.Document.to_jv root);
91 Jv.set_if_some o "dispatch" dispatch;
92 Jv.set_if_some o "parent" (Option.map Brr.El.to_jv parent);
93 o
94
95 let g = Jv.get Jv.global "__CM__view"
96 let create ?(opts = Jv.undefined) () = Jv.new' g [| opts |]
97 let state t = Jv.get t "state" |> State.of_jv
98 let set_state t v = Jv.call t "setState" [| State.to_jv v |] |> ignore
99
100 module Update = struct
101 type t = Jv.t
102
103 let state t = State.of_jv @@ Jv.get t "state"
104 let doc_changed t = Jv.to_bool @@ Jv.get t "docChanged"
105
106 include (Jv.Id : Jv.CONV with type t := t)
107 end
108
109 let dom t = Jv.get t "dom" |> Brr.El.of_jv
110
111 let update_listener () : (Update.t -> unit, Jv.t) State.facet =
112 let module F = State.FacetMaker (Func (Update)) in
113 let jv = Jv.get g "updateListener" in
114 Facet ((module F), F.of_jv jv)
115
116 let decorations () : (Decoration.Range_set.t, Jv.t) State.facet =
117 let module F = State.FacetMaker (Decoration.Range_set) in
118 let jv = Jv.get g "decorations" in
119 Facet ((module F), F.of_jv jv)
120
121 let request_measure t =
122 let _ = Jv.call t "requestMeasure" [||] in
123 ()
124
125 let line_wrapping () = Jv.get g "lineWrapping" |> Extension.of_jv
126
127 let set_doc t (doc : Jstr.t) =
128 let upd = State.set_doc (state t) doc in
129 let _ = Jv.call t "update" [| Jv.of_jv_array [| upd |] |] in
130 ()
131
132 let line_numbers fmt =
133 let fmt x _ = Jv.to_int x |> fmt |> Jv.of_string in
134 let config = Jv.obj [| ("formatNumber", Jv.callback ~arity:2 fmt) |] in
135 Jv.call Jv.global "__CM__lineNumbers" [| config |] |> Extension.of_jv
136
137 module Transaction = struct
138 type t = Jv.t
139
140 include (Jv.Id : Jv.CONV with type t := t)
141 end
142
143 let dispatch t transaction =
144 let _ = Jv.call t "dispatch" [| Transaction.to_jv transaction |] in
145 ()
146end