@@ -13,6 +13,8 @@ let not_supported () =
1313 Jsonrpc.Response.Error. raise
1414 (make_error ~code: InternalError ~message: " Request not supported yet!" () )
1515
16+ let enable_dune_rpc = false
17+
1618let initialize_info : InitializeResult.t =
1719 let codeActionProvider =
1820 let codeActionKinds =
@@ -970,49 +972,51 @@ let start () =
970972 Fiber. fork_and_join_unit
971973 (fun () -> Fiber.Pool. run detached)
972974 (fun () ->
975+ let run_dune () =
976+ let * (init_params : InitializeParams.t ) = Server. initialized server in
977+ let progress =
978+ Progress. create init_params.capabilities
979+ ~report_progress: (fun progress ->
980+ Server. notification server
981+ (Server_notification. WorkDoneProgress progress))
982+ ~create_task: (fun task ->
983+ Server. request server (Server_request. WorkDoneProgressCreate task))
984+ in
985+ let dune =
986+ let dune' = Dune. create diagnostics progress in
987+ dune := Some dune';
988+ dune'
989+ in
990+ let * state = Dune. run dune in
991+ let message =
992+ match state with
993+ | Error Binary_not_found ->
994+ Some " Dune must be installed for project functionality"
995+ | Error Out_of_date ->
996+ Some
997+ " Dune is out of date. Install dune >= 3.0 for project \
998+ functionality"
999+ | Ok () -> None
1000+ in
1001+ match message with
1002+ | None -> Fiber. return ()
1003+ (* We disable the warnings because dune 3.0 isn't available yet *)
1004+ | Some _ when true -> Fiber. return ()
1005+ | Some message ->
1006+ let * (_ : InitializeParams.t ) = Server. initialized server in
1007+ let state = Server. state server in
1008+ task_if_running state ~f: (fun () ->
1009+ let log = LogMessageParams. create ~type_: Warning ~message in
1010+ Server. notification server (Server_notification. LogMessage log))
1011+ in
9731012 let * () =
9741013 Fiber. fork_and_join_unit
9751014 (fun () -> Server. start server)
9761015 (fun () ->
977- let * (init_params : InitializeParams.t ) =
978- Server. initialized server
979- in
980- let progress =
981- Progress. create init_params.capabilities
982- ~report_progress: (fun progress ->
983- Server. notification server
984- (Server_notification. WorkDoneProgress progress))
985- ~create_task: (fun task ->
986- Server. request server
987- (Server_request. WorkDoneProgressCreate task))
988- in
989- let dune =
990- let dune' = Dune. create diagnostics progress in
991- dune := Some dune';
992- dune'
993- in
994- let * state = Dune. run dune in
995- let message =
996- match state with
997- | Error Binary_not_found ->
998- Some " Dune must be installed for project functionality"
999- | Error Out_of_date ->
1000- Some
1001- " Dune is out of date. Install dune >= 3.0 for project \
1002- functionality"
1003- | Ok () -> None
1004- in
1005- match message with
1006- | None -> Fiber. return ()
1007- (* We disable the warnings because dune 3.0 isn't available yet *)
1008- | Some _ when true -> Fiber. return ()
1009- | Some message ->
1010- let * (_ : InitializeParams.t ) = Server. initialized server in
1011- let state = Server. state server in
1012- task_if_running state ~f: (fun () ->
1013- let log = LogMessageParams. create ~type_: Warning ~message in
1014- Server. notification server
1015- (Server_notification. LogMessage log)))
1016+ if enable_dune_rpc then
1017+ run_dune ()
1018+ else
1019+ Fiber. return () )
10161020 in
10171021 let * () =
10181022 Fiber. parallel_iter
0 commit comments