diff --git a/src/satysfi/dependency.ml b/src/satysfi/dependency.ml index cc695af..0c93ab9 100644 --- a/src/satysfi/dependency.ml +++ b/src/satysfi/dependency.ml @@ -5,6 +5,7 @@ module Location = Satyrographos.Location type directive = | Import of string | Require of string + | MdDepends of string [@@deriving sexp, compare, hash, equal] type t = { @@ -16,6 +17,7 @@ type t = { let render_directive = function | Import f -> sprintf "@import: %s" f | Require p -> sprintf "@require: %s" p + | MdDepends p -> sprintf "md depends %s" p let parse_directives = (* TODO Rewrite when multi-line comment is added to SATySFi *) @@ -274,12 +276,67 @@ let%expect_test "parse_string_saty: directives followed by declarations" = ((rstart ((lnum 0) (cnum 0))) (rend ((lnum 0) (cnum 8)))))))) (Import file))))) |}] +let parse_satysfi_md_yojson ~path (json: Yojson.Safe.t) = + begin match json with + | `Assoc lvs -> + List.find_map lvs ~f:(function + | "depends", `List ds -> + List.filter_map ds ~f:(function + | `String s -> Some s + | _ -> + failwithf + "%s:\nDependency must be a list of strings but got %s@." + path + (Yojson.Safe.to_string (`List ds)) + () + ) + |> Option.some + | _ -> None + ) + |> Option.map ~f:(fun ps -> + { + path = path; + directives = + let loc = { + Location.path; + range = None; + } + in + List.map ~f:(fun p -> loc, MdDepends p) ps + }) + | _ -> + None + end + |> Option.value_exn ~message:(sprintf "File %s does not have depends field" path) + +let parse_satysfi_md_str ~path str = + Yojson.Safe.from_string str + |> parse_satysfi_md_yojson ~path + +let parse_satysfi_md_file ~path = + Yojson.Safe.from_file path + |> parse_satysfi_md_yojson ~path + +let%expect_test "parse_satysfi_md_str: valid" = + let path = "test.saty" in + parse_satysfi_md_str ~path {|{"depends":["mdja"]}|} + |> [%sexp_of: t] + |> Sexp.output_hum Out_channel.stdout; + [%expect{| + ((path test.saty) + (directives ((((path test.saty) (range ())) (MdDepends mdja))))) |}] + let parse_file_result path = - Result.try_with (fun () -> - In_channel.read_all path - ) - |> Result.map ~f:(match FilePath.get_extension path with - | _ -> parse_string_saty ~path) + match FilePath.get_extension path with + | "satysfi-md" -> + Result.try_with (fun () -> + parse_satysfi_md_file ~path) + | _ -> + Result.try_with (fun () -> + In_channel.read_all path + ) + |> Result.map ~f:(match FilePath.get_extension path with + | _ -> parse_string_saty ~path) let referred_file_basenames ~package_root_dirs { path; directives; }= let basedir = FilePath.dirname path in @@ -287,6 +344,7 @@ let referred_file_basenames ~package_root_dirs { path; directives; }= match d with | Import f -> loc, d, [FilePath.concat basedir f] - | Require p -> + | Require p + | MdDepends p -> loc, d, List.map package_root_dirs ~f:(fun rd -> FilePath.concat rd p) ) diff --git a/src/satysfi/dependencyGraph.ml b/src/satysfi/dependencyGraph.ml index 4531842..ffbb44c 100644 --- a/src/satysfi/dependencyGraph.ml +++ b/src/satysfi/dependencyGraph.ml @@ -106,6 +106,15 @@ module G = struct let hash_fold = hash_fold_edge let equal = equal_edge end + + let sexp_of_t g = + let edges = + GOrig.fold_edges_e (fun e acc -> e :: acc) g [] + in + let vertices = + GOrig.fold_vertex (fun v acc -> v :: acc) g [] + in + [%sexp_of: Vertex.t list * E.t list] (vertices, edges) end module Oper = @@ -127,7 +136,9 @@ module Dot = | Edge.Directive (_, d) -> let label = Dependency.render_directive d in let color = match d with - | Require _ -> 0x117722 + | Require _ + | MdDepends _ -> + 0x117722 | Import _ -> 0x002288 in [`Label label; `Fontcolor color; `Color color] @@ -169,17 +180,22 @@ let dependency_graph ~outf ?(follow_required=false) ~package_root_dirs ~satysfi_ match directive, bs with | Import _, [b] -> Vertex.Basename b - | Require p, _ -> + | Require p, _ + | MdDepends p, _ -> Package p - | directive, bs -> + | Import _, bs -> failwithf !"BUG: Directive %{sexp:Dependency.directive} has wrong number of candidate basenames %{sexp: string list}" directive bs () in let e1 : Edge.t = Some (Directive (off, directive)) in G.add_edge_e g (vf, e1, vm); let recursion_enabled = match directive, follow_required with - | Require _, false -> false - | _ -> true + | _, true -> + true + | Require _, false + | MdDepends _, false -> + false + | Import _, _ -> true in if recursion_enabled then diff --git a/test/testcases/command_debug_depgraph__satysfi_md.t b/test/testcases/command_debug_depgraph__satysfi_md.t new file mode 100644 index 0000000..84a899b --- /dev/null +++ b/test/testcases/command_debug_depgraph__satysfi_md.t @@ -0,0 +1,21 @@ +Prepare SATySFi source + $ cat >mdja.satysfi-md < { + > "depends":["mdja"], + > "document":["Test.document"], + > "header-default":["(| title = {}; author = {}; |)"] + > } + > EOF + +Generate dependency graphs + $ SATYROGRAPHOS_EXPERIMENTAL=1 satyrographos debug depgraph -S 0.0.5 mdja.satysfi-md + Compatibility warning: You have opted in to use experimental features. + digraph G { + "mdja" [shape=ellipse, ]; + "mdja.satysfi-md" [shape=box, ]; + + + "mdja.satysfi-md" -> "mdja" [color="#117722", fontcolor="#117722", + label="md depends mdja", ]; + + }