gh-205: Support .satysfi-md as a source type of dependency graphs

This commits adds .satysfi-md file as one source of dependency graphs.
Meanwhile, lint subcommand still does not check dependencies of .satysfi-md files.
See #247.

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,19 +276,75 @@ 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
   List.map directives ~f:(fun (loc, d) ->
       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)
     )

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

test/testcases/command_debug_depgraph__satysfi_md.t

@@ -0,0 +1,21 @@
+Prepare SATySFi source
+  $ cat >mdja.satysfi-md <<EOF
+  > {
+  >   "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", ];
+
+    }