From 6799a75d62c44f01a58bbd8cd11215fb8d1e6708 Mon Sep 17 00:00:00 2001 From: Kento Okura Date: Thu, 30 Apr 2026 13:49:13 +0200 Subject: [PATCH] Implement failed import diagnostics Remove some tests, will prefer cram tests --- bin/docs/Forester_docs.ml | 16 +-- bin/forester/main.ml | 2 +- lib/compiler/Action.ml | 4 +- lib/compiler/Driver.ml | 56 +------- lib/compiler/Error.ml | 11 +- lib/compiler/Error.mli | 1 + lib/compiler/Imports.ml | 32 +++-- lib/compiler/Imports.mli | 1 - lib/compiler/Phases.ml | 19 ++- lib/compiler/test/Test_compiler.ml | 165 ------------------------ lib/compiler/test/Test_import_graph.ml | 25 +--- lib/compiler/test/dune | 1 - lib/core/Tree.ml | 4 +- lib/language_server/Did_create_files.ml | 2 +- 14 files changed, 58 insertions(+), 281 deletions(-) delete mode 100644 lib/compiler/test/Test_compiler.ml diff --git a/bin/docs/Forester_docs.ml b/bin/docs/Forester_docs.ml index 3b2987e..eccd65d 100644 --- a/bin/docs/Forester_docs.ml +++ b/bin/docs/Forester_docs.ml @@ -8,25 +8,11 @@ module EP = Eio.Path let () = Logs.set_level (Some Debug) -let index : Tree.t URI.Tbl.t = URI.Tbl.create 100 - let () = Logs.set_reporter (Logs_fmt.reporter ()); let@ env = Eio_main.run in - let dev = true in let config = Config.(default ~url:docs_url) () in - let init = State.make ~env ~config ~dev ~index () in - let forest = - init - |> Driver.force - [ - Load_configured_dirs; - Parse_all; - Build_import_graph; - Expand_all; - Eval_all; - ] - in + let forest = Driver.batch_run ~env ~config ~dev:false in let syndication = let blob_uri = URI.append_path_component Config.docs_url "index" in let query = diff --git a/bin/forester/main.ml b/bin/forester/main.ml index 605201f..1f0233b 100644 --- a/bin/forester/main.ml +++ b/bin/forester/main.ml @@ -60,8 +60,8 @@ let build ~env _ config_path dev no_theme emit_legacy_xml = } else config in - let forest = Driver.batch_run ~env ~dev ~config in Logs.debug (fun m -> m "Parsed config file %s" config_path); + let forest = Driver.batch_run ~env ~dev ~config in State.iter_diagnostics (fun _ d -> List.iter Error.print d) forest; if not no_theme then begin let theme_dir = diff --git a/lib/compiler/Action.ml b/lib/compiler/Action.ml index 045feef..3c5662f 100644 --- a/lib/compiler/Action.ml +++ b/lib/compiler/Action.ml @@ -56,5 +56,7 @@ let log : Format.formatter -> t -> unit = | Render _ -> p "render" | Query _ -> p "query" | Query_results _ -> p "query_results" - | Report_errors _ -> p "report_errors" + | Report_errors (errors, _) -> + let i = Int.to_string @@ List.length errors in + p @@ "report_errors (" ^ i ^ " errors)" | Run_jobs _ -> p "run_jobs" diff --git a/lib/compiler/Driver.ml b/lib/compiler/Driver.ml index 7e4af14..61c8162 100644 --- a/lib/compiler/Driver.ml +++ b/lib/compiler/Driver.ml @@ -35,7 +35,6 @@ let update (action : Action.t) (forest : State.t) = m "import graph has %d vertices" (Forest_graph.nb_vertex import_graph)); report ~errors ~and_then:Expand_all | Expand_all -> - Logs.debug (fun m -> m "expanding trees"); let errors = Phases.expand_all forest in report ~errors ~and_then:Eval_all | Expand uri -> begin @@ -51,7 +50,6 @@ let update (action : Action.t) (forest : State.t) = let errors = Phases.render uri in report ~errors ~and_then:Done | Eval_all -> - Logs.debug (fun m -> m "evaluating"); let jobs, errors = Phases.eval forest in report ~errors ~and_then:(Run_jobs jobs) | Render_all -> @@ -64,20 +62,18 @@ let update (action : Action.t) (forest : State.t) = let () = Phases.plant_assets ~forest in Done | Plant_foreign -> - Logs.debug (fun m -> m "Planting foreign forests"); let errors = Phases.implant_foreign ~forest in report ~errors ~and_then:Done | Run_jobs jobs -> let () = Phases.run_jobs forest jobs in Render_all | Load_tree path -> - let doc = Imports.load_tree path in + let doc = Phases.load_tree path in let lsp_uri = Tree.Loaded.uri doc in let uri = URI.of_lsp_uri ~base:forest.config.url lsp_uri in forest.={uri} <- Tree doc; Parse lsp_uri | Parse uri -> - Logs.debug (fun m -> m "Reparsing"); let uri = URI.of_lsp_uri ~base:forest.config.url uri in Phases.parse forest uri | Done -> Done @@ -93,15 +89,12 @@ let run_until_done a s : State.t = in go a s -let implant_foreign = run_until_done Plant_foreign -let plant_assets = run_until_done Plant_assets - let any_fatal = List.fold_left (fun acc x -> acc || Error.is_fatal x) false let batch_run ~env ~(config : Config.t) ~dev = - let init = - State.make ~env ~config ~dev () |> plant_assets |> implant_foreign - in + let forest = State.make ~env ~config ~dev () in + let _ = update Action.Plant_foreign forest in + let _ = update Action.Plant_assets forest in let rec go action state = let new_action = update action state in match action with @@ -115,7 +108,7 @@ let batch_run ~env ~(config : Config.t) ~dev = if any_fatal errors then go (Quit Fail) state else go new_action state | _ -> go new_action state in - go Load_configured_dirs init + go Load_configured_dirs forest let language_server ~env ~config = let init = State.make ~env ~config ~dev:true () in @@ -130,42 +123,3 @@ let language_server ~env ~config = let _ = update Plant_assets init in (* TODO: this ought to implant the foreign trees as well *) go Load_configured_dirs init - -let run_with_history a s = - let history = ref [] in - let rec go action state = - history := action :: !history; - match update action state with - | new_action -> - if action = Done then state - else begin - go new_action state - end - in - let forest = go a s in - (forest, List.rev !history) - -let collect_emitted_errors a s = - let errors = ref [] in - let rec go action state = - match update action state with - | new_action -> begin - match action with - | Done -> state - | Report_errors (errs, _) -> begin - errors := errs @ !errors; - go new_action state - end - | _ -> go new_action state - end - in - let forest = go a s in - (forest, List.rev !errors) - -let rec force : Action.t list -> State.t -> State.t = - fun msgs state -> - match msgs with - | [] -> state - | msg :: remaining -> - let _discard = update msg state in - force remaining state diff --git a/lib/compiler/Error.ml b/lib/compiler/Error.ml index cf5fb85..6780ef4 100644 --- a/lib/compiler/Error.ml +++ b/lib/compiler/Error.ml @@ -20,6 +20,7 @@ type t = | Failed_to_load_foreign_blob of string | Failed_to_parse_foreign_blob of string | Failed_to_add_edge of Vertex.t * Vertex.t + | Failed_to_add_vertex of Range.t option * URI.t | Unknown_error of string and latex_error = {range: Grace.Range.t; msg: string} @@ -39,6 +40,7 @@ let broken_transclusion t = Broken_transclusion t let broken_link t = Broken_link t let duplicate_tree ~uri = Duplicate_tree uri let failed_to_add_edge v w = Failed_to_add_edge (v, w) +let failed_to_add_vertex ~range v = Failed_to_add_vertex (range, v) let cant_eval_anonymous_tree = Cant_eval_anonymous_tree let unknown_error str = Unknown_error str let failed_to_load_foreign_blob str = Failed_to_load_foreign_blob str @@ -237,6 +239,13 @@ let render = function | Failed_to_load_foreign_blob _ -> failwith "failed to load foreign blob" | Failed_to_parse_foreign_blob _ -> failwith "failed to parse foreign bob" | Failed_to_add_edge (_, _) -> failwith "failed to add edge" + | Failed_to_add_vertex (range, uri) -> + let name = Option.get @@ URI.(name uri) in + let labels = + fold_range ~range + Grace.Diagnostic.Message.(createf "No file %s.tree found." name) + in + Grace.Diagnostic.createf ~labels Error "Unresolved import" | Unknown_error _ -> failwith "unknown error" (* @@ -268,7 +277,7 @@ let is_fatal = function | Cant_eval_anonymous_tree | Duplicate_tree _ | Failed_to_load_foreign_blob _ | Failed_to_parse_foreign_blob _ | Failed_to_add_edge (_, _) - | Unknown_error _ -> + | Failed_to_add_vertex _ | Unknown_error _ -> true let print_config_error error = print @@ config_error error diff --git a/lib/compiler/Error.mli b/lib/compiler/Error.mli index b9984e9..1eec875 100644 --- a/lib/compiler/Error.mli +++ b/lib/compiler/Error.mli @@ -28,6 +28,7 @@ val duplicate_tree : uri:URI.t -> t val of_tex_error : latex_error -> t val failed_to_add_edge : Vertex.t -> Vertex.t -> t +val failed_to_add_vertex : range:Grace.Range.t option -> URI.t -> t val collect : (unit -> unit) -> t Seq.t val yield : t -> unit diff --git a/lib/compiler/Imports.ml b/lib/compiler/Imports.ml index 088b6d5..cc9ebd3 100644 --- a/lib/compiler/Imports.ml +++ b/lib/compiler/Imports.ml @@ -5,7 +5,6 @@ *) open Forester_core -open Forester_parser open struct module T = Types @@ -18,20 +17,6 @@ type analysis_env = { mutable errors: Error.t list; } -let load_tree path : Tree.(loaded tree) = - let content = Eio.Path.load path in - let path_str = Eio.Path.native_exn path in - assert (not @@ Filename.is_relative path_str); - let uri = Lsp.Uri.of_path path_str in - let doc = - Lsp.Text_document.make ~position_encoding:`UTF8 - { - textDocument = - {languageId = "forester"; text = content; uri; version = 1}; - } - in - Tree.Loaded.create ~source:(`File path_str) doc - (* Only add edge if both vertices are already present*) let add_edge g v w = try @@ -40,6 +25,13 @@ let add_edge g v w = ok @@ Forest_graph.add_edge g v w with Assert_failure _ -> error @@ Error.failed_to_add_edge v w +let add_vertex ~env ~range v = + let uri = Option.get @@ Vertex.uri_of_vertex v in + try + assert (Forest.mem env.forest.index uri); + ok @@ Forest_graph.add_vertex env.graph v + with Assert_failure _ -> error @@ Error.failed_to_add_vertex ~range uri + let rec analyse_tree ~env ~uri code = let@ root = Option.iter @~ uri in Forest_graph.add_vertex env.graph (T.Uri_vertex root); @@ -55,8 +47,14 @@ and analyse_node ~env ~root (node : Code.node Range.located) : unit = let dep_uri = URI.named_uri ~base:config.url dep in let dependency = T.Uri_vertex dep_uri in let target = T.Uri_vertex root in - Forest_graph.add_vertex env.graph dependency; - assert (Result.is_ok @@ add_edge env.graph dependency target); + begin match add_vertex ~env ~range:node.range dependency with + | Ok () -> begin + match add_edge env.graph dependency target with + | Ok () -> () + | Error e -> env.errors <- e :: env.errors + end + | Error e -> env.errors <- e :: env.errors + end; if env.follow then begin match State.get_code ~forest:env.forest dep_uri with | Some code -> diff --git a/lib/compiler/Imports.mli b/lib/compiler/Imports.mli index 4fd71ec..94c9020 100644 --- a/lib/compiler/Imports.mli +++ b/lib/compiler/Imports.mli @@ -13,7 +13,6 @@ type analysis_env = { mutable errors: Error.t list; } -val load_tree : Eio.Fs.dir_ty Eio.Path.t -> Tree.(loaded tree) val build : State.t -> Error.t list * Forest_graph.t val dependencies : uri:URI.t option -> Code.t -> State.t -> Forest_graph.t val fixup : uri:URI.t -> Tree.(parsed tree) -> State.t -> unit diff --git a/lib/compiler/Phases.ml b/lib/compiler/Phases.ml index a50d45e..3a54fc1 100644 --- a/lib/compiler/Phases.ml +++ b/lib/compiler/Phases.ml @@ -20,8 +20,22 @@ let guess_uri (d : Range.t) = | `Reader _ -> assert false | `String {name; _} -> Option.map Lsp.Uri.of_path name +let load_tree path : Tree.(loaded tree) = + let content = Eio.Path.load path in + let path_str = Eio.Path.native_exn path in + assert (not @@ Filename.is_relative path_str); + let uri = Lsp.Uri.of_path path_str in + let doc = + Lsp.Text_document.make ~position_encoding:`UTF8 + { + textDocument = + {languageId = "forester"; text = content; uri; version = 1}; + } + in + Tree.Loaded.create ~source:(`File path_str) doc + let load (tree_dir : Eio.Fs.dir_ty Eio.Path.t) = - Dir_scanner.scan_directory tree_dir |> Seq.map Imports.load_tree + Dir_scanner.scan_directory tree_dir |> Seq.map load_tree let load_configured_dirs ~(forest : State.t) = let env = State.env forest in @@ -85,7 +99,8 @@ let reparse (doc : Lsp.Text_document.t) (forest : State.t) = | Error d -> forest.?{uri} <- [Error.parse_error d] end -let build_import_graph ~(forest : State.t) : _ * _ = Imports.build forest +let build_import_graph ~(forest : State.t) : Error.t list * Forest_graph.t = + Imports.build forest let expand (forest : State.t) = Expand.expand_tree ~forest diff --git a/lib/compiler/test/Test_compiler.ml b/lib/compiler/test/Test_compiler.ml deleted file mode 100644 index 43e91da..0000000 --- a/lib/compiler/test/Test_compiler.ml +++ /dev/null @@ -1,165 +0,0 @@ -(* - * SPDX-FileCopyrightText: 2024 The Forester Project Contributors - * - * SPDX-License-Identifier: GPL-3.0-or-later - *) - -open Forester_core -open Forester_compiler -open Forester_test -open Testables -open State.Syntax - -open struct - module T = Types -end - -let config = Config.default () - -let raw_trees = - let t1 = {path = "t1.tree"; content = {||}} in - let t2 = {path = "t2.tree"; content = {||}} in - let t3 = {path = "t3.tree"; content = {||}} in - let t4 = {path = "t4.tree"; content = {||}} in - let t5 = {path = "t5.tree"; content = {||}} in - let t6 = {path = "t6.tree"; content = {||}} in - let t7 = {path = "t7.tree"; content = {||}} in - let t8 = {path = "t8.tree"; content = {||}} in - [t1; t2; t3; t4; t5; t6; t7; t8] - -let test_batch_run ~env () = - let forest, history = - let@ path = with_test_forest ~raw_trees ~env ~config in - Sys.chdir (Eio.Path.native_exn path); - let forest = State.make ~env ~config ~dev:false () in - Driver.run_with_history Load_configured_dirs forest - in - Alcotest.(check @@ list action) - "all actions have run" - [ - Load_configured_dirs; - Parse_all; - Build_import_graph; - Expand_all; - Eval_all; - Run_jobs []; - Done; - ] - history; - Alcotest.(check @@ int) - "no tree is unparsed" 0 - (List.length (State.get_all_unparsed ~forest)); - Alcotest.(check @@ int) - "no tree is unexpanded" 0 - (List.length (State.get_all_unexpanded ~forest)); - Alcotest.(check @@ int) - "no tree is unevaluated" 0 - (List.length (State.get_all_unevaluated ~forest)); - Alcotest.(check @@ int) - "has correct number of articles" 8 - (List.length (State.get_all_articles ~forest)) - -let test_includes_paths ~env () = - let config = Config.default () in - with_test_forest ~raw_trees ~env ~config (fun path -> - Sys.chdir (Eio.Path.native_exn path); - let forest, history = - State.make ~env ~config ~dev:true () - |> Driver.run_with_history Load_configured_dirs - in - Alcotest.(check int) - "number of parsed trees" 8 - (List.length @@ State.get_all_uris ~forest); - Alcotest.(check @@ list action) - "evaluation succeeded" - [ - Load_configured_dirs; - Parse_all; - Build_import_graph; - Expand_all; - Eval_all; - Run_jobs []; - Done; - ] - history; - let uri = URI.of_string_exn "http://forest.local/t8/" in - let path = - match forest.@{uri} with - | Some (Article {frontmatter = {source_path; _}; _}) -> source_path - | Some _ -> Alcotest.fail "not an article" - | None -> - URI.Tbl.iter - (fun uri _ -> Logs.debug (fun m -> m "%a" URI.pp uri)) - forest.index; - Alcotest.fail "not found" - in - Alcotest.(check bool) "path is some" true (Option.is_some path)) - -let test_reparsing ~env () = - let config = Config.default () in - let@ tmp_path = with_test_forest ~raw_trees ~env ~config in - Logs.app (fun m -> - m "In temp dir %s" (Unix.realpath @@ Eio.Path.native_exn tmp_path)); - let forest = - State.make ~env ~config ~dev:false () - |> Driver.run_until_done Load_configured_dirs - in - let reparse_addr = "t8.tree" in - let reparse_uri = URI.path_to_uri ~base:config.url reparse_addr in - let vtx = T.Uri_vertex reparse_uri in - Alcotest.(check int) - "Number of vertices before reparsing" 8 - (Forest_graph.nb_vertex State.(imports forest)); - Alcotest.(check int) - "old vertex has no import" 0 - (Forest_graph.in_degree State.(imports forest) vtx); - let _, path = - State.get_all_paths ~forest - |> List.find_map (fun (uri, path) -> - if String.ends_with ~suffix:"t8.tree" path then begin - Logs.debug (fun m -> m "%s" path); - Some (uri, Eio.Path.(env#fs / path)) - end - else None) - |> Option.get - in - Eio.Path.save ~create:(`Or_truncate 0o644) path {|\import{t1}|}; - let reparsed = Driver.run_until_done (Load_tree path) forest in - Alcotest.(check bool) - "vertex has an import" true - (Forest_graph.in_degree State.(imports reparsed) vtx > 0) - -let test_omits_paths ~env () = - let forest = Driver.batch_run ~env ~config ~dev:false in - let path = - match forest.@{URI.of_string_exn "http://forest.local/t8/"} with - | Some (Article {frontmatter = {source_path; _}; _}) -> source_path - | Some _ -> Alcotest.fail "not an article" - | None -> - URI.Tbl.iter - (fun uri _ -> Logs.debug (fun m -> m "%a" URI.pp uri)) - forest.index; - Alcotest.fail "not found" - in - Alcotest.(check bool) "" true @@ Option.is_none path - -let () = - let@ env = Eio_main.run in - Logs.set_level (Some Debug); - Logs.set_reporter (Logs.format_reporter ()); - let open Alcotest in - run "Test_driver" - [ - ( "Steps", - [ - test_case "Batch compilation steps" `Quick (test_batch_run ~env); - test_case "reparsing" `Quick (test_reparsing ~env); - ] ); - ( "dev mode", - [ - test_case "includes paths in dev mode" `Quick - (test_includes_paths ~env); - test_case "omits paths outside dev mode" `Quick - (test_omits_paths ~env); - ] ); - ] diff --git a/lib/compiler/test/Test_import_graph.ml b/lib/compiler/test/Test_import_graph.ml index 1363dc6..fa322b6 100644 --- a/lib/compiler/test/Test_import_graph.ml +++ b/lib/compiler/test/Test_import_graph.ml @@ -7,7 +7,6 @@ open Forester_core open Forester_compiler open Forester_test -open Testables open struct module T = Types @@ -17,10 +16,6 @@ let config = {(Config.default ()) with trees = ["imports"]} let mk_vertex v = T.Uri_vertex (URI.named_uri ~base:config.url v) let has_edge g v w = Forest_graph.mem_edge g (mk_vertex v) (mk_vertex w) -(* - ┌─1 │ ┌─4 │ ├─5 ├─2─┬─3─┼─6 index─┤ │ └─7 │ └─8 ├─9 └─10 -*) - let raw_trees = [ { @@ -62,26 +57,10 @@ let raw_trees = let test_import_graph ~env () = let@ tmp_dir = with_test_forest ~env ~config ~raw_trees in Sys.chdir (Eio.Path.native_exn tmp_dir); - let forest, history = + let forest = State.make ~env ~config ~dev:false () - |> Driver.run_with_history Load_configured_dirs + |> Driver.run_until_done Load_configured_dirs in - Alcotest.(check @@ list action) - "evaluation succeeded" - [ - Load_configured_dirs; - Parse_all; - Build_import_graph; - Expand_all; - Eval_all; - Run_jobs []; - Done; - ] - history; - (* Alcotest.(check int) *) - (* "graph has as many vertices as loaded documents" *) - (* (Hashtbl.length forest.documents) *) - (* (Forest.length forest.parsed); *) Alcotest.(check bool) "has some edges" true (List.for_all Fun.id diff --git a/lib/compiler/test/dune b/lib/compiler/test/dune index b9e9765..9c0e924 100644 --- a/lib/compiler/test/dune +++ b/lib/compiler/test/dune @@ -5,7 +5,6 @@ (tests (names Test_expansion - Test_compiler Test_diagnostic_store Test_graph_database Test_import_graph diff --git a/lib/core/Tree.ml b/lib/core/Tree.ml index 12ec3e5..11b6fdd 100644 --- a/lib/core/Tree.ml +++ b/lib/core/Tree.ml @@ -60,8 +60,8 @@ end module Evaluated = struct type t = evaluated tree - let create ~route_locally ~include_in_manifest ?expanded ?source - (resource : _ T.resource) = + let create ?(route_locally = true) ?(include_in_manifest = true) ?expanded + ?source (resource : _ T.resource) = let tree = let expanded = match expanded with Some expanded -> Some expanded.tree | None -> None diff --git a/lib/language_server/Did_create_files.ml b/lib/language_server/Did_create_files.ml index 07e7eba..aed9fe0 100644 --- a/lib/language_server/Did_create_files.ml +++ b/lib/language_server/Did_create_files.ml @@ -22,7 +22,7 @@ let compute ({files} : L.CreateFilesParams.t) = let lsp_uri = L.DocumentUri.of_string uri in let uri = URI.of_lsp_uri ~base:forest.config.url lsp_uri in let path = Eio.Path.(env#fs / L.DocumentUri.to_path lsp_uri) in - let doc = Imports.load_tree path in + let doc = Phases.load_tree path in forest.={uri} <- Tree doc end; let new_forest = Driver.run_until_done Parse_all forest in -- 2.51.2