-
Notifications
You must be signed in to change notification settings - Fork 32
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Showing
49 changed files
with
853 additions
and
229 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,57 @@ | ||
| open Js_of_ocaml | ||
|
|
||
| let rec obj_to_json (cobj : < .. > Js.t) : Yojson.Safe.t = | ||
| let open Js in | ||
| let open Js.Unsafe in | ||
| let typeof_cobj = to_string (typeof cobj) in | ||
| match typeof_cobj with | ||
| | "string" -> `String (to_string @@ coerce cobj) | ||
| | "boolean" -> `Bool (to_bool @@ coerce cobj) | ||
| | "number" -> `Int (int_of_float @@ float_of_number @@ coerce cobj) | ||
| | _ -> | ||
| if instanceof cobj array_empty then | ||
| `List Array.(to_list @@ map obj_to_json @@ to_array @@ coerce cobj) | ||
| else if instanceof cobj Typed_array.arrayBuffer then | ||
| `String (Typed_array.String.of_arrayBuffer @@ coerce cobj) | ||
| else if instanceof cobj Typed_array.uint8Array then | ||
| `String (Typed_array.String.of_uint8Array @@ coerce cobj) | ||
| (* Careful in case we miss cases here, what about '{}' for example, we | ||
| should also stop on functions? *) | ||
| else if instanceof cobj Unsafe.global##._Object then | ||
| Js.array_map | ||
| (fun key -> (Js.to_string key, obj_to_json (Js.Unsafe.get cobj key))) | ||
| (Js.object_keys cobj) | ||
| |> Js.to_array |> Array.to_list | ||
| |> fun al -> `Assoc al | ||
| else if Js.Opt.(strict_equals (some cobj) null) then `Null | ||
| else if Js.Optdef.(strict_equals (def cobj) undefined) then ( | ||
| Firebug.console##info "undefined branch!!!!"; | ||
| `Null) | ||
| else ( | ||
| Firebug.console##error "failure in coq_lsp_worker:obj_to_json"; | ||
| Firebug.console##error cobj; | ||
| Firebug.console##error (Json.output cobj); | ||
| raise (Failure "coq_lsp_worker:obj_to_json")) | ||
|
|
||
| (* Old code, which is only useful for debug *) | ||
| (* let json_string = Js.to_string (Json.output cobj) in *) | ||
| (* Yojson.Safe.from_string json_string *) | ||
|
|
||
| let rec json_to_obj (cobj : < .. > Js.t) (json : Yojson.Safe.t) : < .. > Js.t = | ||
| let open Js.Unsafe in | ||
| let ofresh j = json_to_obj (obj [||]) j in | ||
| match json with | ||
| | `Bool b -> coerce @@ Js.bool b | ||
| | `Null -> pure_js_expr "null" | ||
| | `Assoc l -> | ||
| List.iter (fun (p, js) -> set cobj p (ofresh js)) l; | ||
| coerce @@ cobj | ||
| | `List l -> coerce @@ Array.(Js.array @@ map ofresh (of_list l)) | ||
| | `Float f -> coerce @@ Js.number_of_float f | ||
| | `String s -> coerce @@ Js.string s | ||
| | `Int m -> coerce @@ Js.number_of_float (float_of_int m) | ||
| | `Intlit s -> coerce @@ Js.number_of_float (float_of_string s) | ||
| | `Tuple t -> coerce @@ Array.(Js.array @@ map ofresh (of_list t)) | ||
| | `Variant (_, _) -> pure_js_expr "undefined" | ||
|
|
||
| let json_to_obj json = json_to_obj (Js.Unsafe.obj [||]) json |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,5 @@ | ||
| open Js_of_ocaml | ||
|
|
||
| (* Object to Yojson converter *) | ||
| val obj_to_json : < .. > Js.t -> Yojson.Safe.t | ||
| val json_to_obj : Yojson.Safe.t -> < .. > Js.t |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,65 @@ | ||
| let point_lt { Lang.Point.line = l1; Lang.Point.character = c1; offset = _ } | ||
| { Lang.Point.line = l2; Lang.Point.character = c2; offset = _ } = | ||
| l1 < l2 || (l1 = l2 && c1 < c2) | ||
|
|
||
| let point_gt { Lang.Point.line = l1; Lang.Point.character = c1; offset = _ } | ||
| { Lang.Point.line = l2; Lang.Point.character = c2; offset = _ } = | ||
| l1 > l2 || (l1 = l2 && c1 > c2) | ||
|
|
||
| (* To move to doc.ml *) | ||
| let filter_map_range ~range ~nodes ~f = | ||
| let rec aux (nodes : Fleche.Doc.Node.t list) acc = | ||
| match nodes with | ||
| | [] -> List.rev acc | ||
| | node :: nodes -> ( | ||
| let open Lang.Range in | ||
| let nrange = node.range in | ||
| if point_lt nrange.end_ range.start then aux nodes acc | ||
| else if point_gt nrange.start range.end_ then List.rev acc | ||
| else | ||
| (* Node in scope *) | ||
| match f node with | ||
| | Some res -> aux nodes (res :: acc) | ||
| | None -> aux nodes acc) | ||
| in | ||
| aux nodes [] | ||
|
|
||
| (* util *) | ||
| let filter_map_cut f l = | ||
| match List.filter_map f l with | ||
| | [] -> None | ||
| | res -> Some res | ||
|
|
||
| (* Return list of pairs of diags, qf *) | ||
| let get_qf (d : Lang.Diagnostic.t) : _ option = | ||
| Option.bind d.data (function | ||
| | { Lang.Diagnostic.Data.quickFix = Some qf; _ } -> Some (d, qf) | ||
| | _ -> None) | ||
|
|
||
| let get_qfs ~range (doc : Fleche.Doc.t) = | ||
| let f { Fleche.Doc.Node.diags; _ } = filter_map_cut get_qf diags in | ||
| filter_map_range ~range ~nodes:doc.nodes ~f |> List.concat | ||
|
|
||
| let request ~range ~token:_ ~(doc : Fleche.Doc.t) = | ||
| let kind = Some "quickfix" in | ||
| let isPreferred = Some true in | ||
| let qf = get_qfs ~range doc in | ||
| let bf (d, qf) = | ||
| List.map | ||
| (fun { Lang.Qf.range; newText } -> | ||
| let oldText = | ||
| Fleche.Contents.extract_raw ~contents:doc.contents ~range | ||
| in | ||
| let title = Format.asprintf "Replace `%s` by `%s`" oldText newText in | ||
| let diagnostics = [ d ] in | ||
| let qf = [ Lsp.Workspace.TextEdit.{ range; newText } ] in | ||
| let changes = [ (doc.uri, qf) ] in | ||
| let edit = Some Lsp.Workspace.WorkspaceEdit.{ changes } in | ||
| Lsp.Core.CodeAction.{ title; kind; diagnostics; isPreferred; edit }) | ||
| qf | ||
| in | ||
| List.concat_map bf qf | ||
|
|
||
| let request ~range ~token ~(doc : Fleche.Doc.t) = | ||
| let res = request ~range ~token ~doc in | ||
| Ok (`List (List.map Lsp.Core.CodeAction.to_yojson res)) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1 @@ | ||
| val request : range:Lang.Range.t -> Request.document |
Oops, something went wrong.