Commit 84f54ed0 authored by Andre Maroneze's avatar Andre Maroneze 💬 Committed by Virgile Prevosto
Browse files

[Markdown-report] pretty-print paths and add baseUris

parent b876bf4e
......@@ -98,10 +98,8 @@ module ArtifactLocation = struct
let default = create ~uri:"" ()
let of_loc loc =
let open Filepath in
(* by construction, we have an absolute path here, no need for uriBase *)
let uri = ((fst loc).pos_path :> string) in
create ~uri ()
let uriBaseId, uri = Filepath.(Normalized.to_base_uri (fst loc).pos_path) in
create ~uri ?uriBaseId ()
end
module ArtifactLocationDictionary = Json_dictionary(ArtifactLocation)
......
......@@ -159,7 +159,7 @@ let gen_statuses () =
let gen_artifacts () =
let add_src_file f =
let uri = (f:Filepath.Normalized.t :> string) in
let uri = Filepath.Normalized.to_pretty_string f in
let location = ArtifactLocation.create ~uri () in
let roles = [ Role.analysisTarget ] in
let mimeType = "text/x-csrc" in
......@@ -192,7 +192,19 @@ let gen_run remarks =
let taxonomies = [ToolComponent.create ~name ~rules ()] in
let results = results @ user_annot_results in
let artifacts = gen_artifacts () in
Run.create ~tool ~invocations ~results ~taxonomies ~artifacts ()
let uriBases = ("PWD", Sys.getcwd ()) :: Filepath.all_symbolic_dirs () in
let uriBasesJson =
List.fold_left (fun acc (name, dir) ->
(name, `Assoc [("uri", `String dir)]) :: acc
) [] uriBases
in
let originalUriBaseIds =
match ArtifactLocationDictionary.of_yojson (`Assoc uriBasesJson) with
| Ok x -> x
| Error s -> failwith s
in
Run.create ~tool ~invocations ~results ~taxonomies ~artifacts
~originalUriBaseIds ()
let generate () =
let remarks = get_remarks () in
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment