From 9beb3e2055abec6f6fb9ca1ae3dda7e433d4e618 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 20 Nov 2024 23:45:35 +0000 Subject: [PATCH] refactor: remove uses of [Stdune.List] Signed-off-by: Rudi Grinberg Signed-off-by: Rudi Grinberg --- ocaml-lsp-server/src/code_actions.ml | 10 ++++------ ocaml-lsp-server/src/import.ml | 25 ++++++++++++++++++++++-- ocaml-lsp-server/src/ocaml_lsp_server.ml | 4 ++-- ocaml-lsp-server/src/workspace_symbol.ml | 4 +--- 4 files changed, 30 insertions(+), 13 deletions(-) diff --git a/ocaml-lsp-server/src/code_actions.ml b/ocaml-lsp-server/src/code_actions.ml index 662599eea..5b896f486 100644 --- a/ocaml-lsp-server/src/code_actions.ml +++ b/ocaml-lsp-server/src/code_actions.ml @@ -54,12 +54,10 @@ let compute_ocaml_code_actions (params : CodeActionParams.t) state doc = ] in let batchable, non_batchable = - List.partition_map - ~f:(fun ca -> - match ca.run with - | `Batchable f -> Left f - | `Non_batchable f -> Right f) - enabled_actions + List.partition_map enabled_actions ~f:(fun ca -> + match ca.run with + | `Batchable f -> Base.Either.First f + | `Non_batchable f -> Second f) in let* batch_results = if List.is_empty batchable diff --git a/ocaml-lsp-server/src/import.ml b/ocaml-lsp-server/src/import.ml index 425eab511..791172144 100644 --- a/ocaml-lsp-server/src/import.ml +++ b/ocaml-lsp-server/src/import.ml @@ -37,13 +37,34 @@ include struct end module List = struct - include Stdune.List - open Base.List + include Base.List + let compare xs ys ~compare = + Base.List.compare (fun x y -> Ordering.to_int (compare x y)) xs ys + ;; + + let sort xs ~compare = sort xs ~compare:(fun x y -> Ordering.to_int (compare x y)) + let fold_left2 xs ys ~init ~f = Stdlib.List.fold_left2 f init xs ys + let assoc xs key = Assoc.find ~equal:Poly.equal xs key + let assoc_opt xs key = assoc xs key + let mem t x ~equal = mem t x ~equal + let map t ~f = map t ~f + let concat_map t ~f = concat_map t ~f + let flatten t = Stdlib.List.flatten t + let filter_map t ~f = filter_map t ~f + let fold_left t ~init ~f = fold_left t ~init ~f let findi xs ~f = findi xs ~f + let find_opt xs ~f = find xs ~f + + let sort_uniq xs ~compare = + Stdlib.List.sort_uniq (fun x y -> Ordering.to_int (compare x y)) xs + ;; + + let for_all xs ~f = for_all xs ~f let find_mapi xs ~f = find_mapi xs ~f let sub xs ~pos ~len = sub xs ~pos ~len let hd_exn t = hd_exn t + let hd_opt t = hd t let nth_exn t n = nth_exn t n let hd t = hd t let filter t ~f = filter t ~f diff --git a/ocaml-lsp-server/src/ocaml_lsp_server.ml b/ocaml-lsp-server/src/ocaml_lsp_server.ml index ec7f8e119..c72b5147b 100644 --- a/ocaml-lsp-server/src/ocaml_lsp_server.ml +++ b/ocaml-lsp-server/src/ocaml_lsp_server.ml @@ -527,6 +527,7 @@ let on_request match req with | Client_request.UnknownRequest { meth; params } -> (match + List.assoc [ ( Req_switch_impl_intf.meth , fun ~params state -> Fiber.of_thunk (fun () -> @@ -545,8 +546,7 @@ let on_request , Semantic_highlighting.Debug.on_request_full ) ; ( Req_hover_extended.meth , fun ~params _ -> Req_hover_extended.on_request ~params rpc ) - ] - |> List.assoc_opt meth + ] meth with | None -> Jsonrpc.Response.Error.raise diff --git a/ocaml-lsp-server/src/workspace_symbol.ml b/ocaml-lsp-server/src/workspace_symbol.ml index b51d977ea..ff5b7f4df 100644 --- a/ocaml-lsp-server/src/workspace_symbol.ml +++ b/ocaml-lsp-server/src/workspace_symbol.ml @@ -368,9 +368,7 @@ let run server (state : State.t) (params : WorkspaceSymbolParams.t) = | Error `Cancelled -> assert false | Error (`Exn exn) -> Exn_with_backtrace.reraise exn) in - List.partition_map symbols_results ~f:(function - | Ok r -> Left r - | Error e -> Right e) + List.partition_result symbols_results in let+ () = match errors with