Automatically convert src-dist field into src field (#269)

bin/commandOpam.ml

@@ -20,22 +20,23 @@ let opam_with_build_module_command f =
       let prefix = long_flag_optional "prefix" string ~doc_arg:"PREFIX" ~doc:"Install destination"
       and script = long_flag_optional "script" string ~doc_arg:"SCRIPT" ~doc:"Install script"
       and name = long_flag_optional "name" string ~doc_arg:"MODULE_NAME" ~doc:"MODULE_NAME Module name"
+      and satysfi_version = Satyrographos_satysfi.Version.flag
       and verbose = long_flag_bool  "verbose" no_arg ~doc:"Make verbose"
       in
         let buildscript_path = Option.value ~default:(default_script_path ()) script in
         let env = Setup.read_environment () in
         (fun () ->
-          Satyrographos_command.Opam.with_build_script f ~outf ~prefix ~buildscript_path ~name ~verbose ~env ();
+          Satyrographos_command.Opam.with_build_script f ~outf ~prefix ~satysfi_version ~buildscript_path ~name ~verbose ~env ();
           reprint_err_warn ())
     ]
 
 let opam_build_command =
   opam_with_build_module_command Satyrographos_command.Opam.build_opam
 
 let opam_install_command =
-  opam_with_build_module_command (fun ~outf ~verbose ~prefix ~build_module ~buildscript_path ~env ->
+  opam_with_build_module_command (fun ~outf ~verbose ~prefix ~satysfi_version ~script_version ~build_module ~buildscript_path ~env ->
     match prefix with
-    | Some prefix -> Satyrographos_command.Opam.install_opam ~outf ~verbose ~prefix ~build_module ~buildscript_path ~env
+      | Some prefix -> Satyrographos_command.Opam.install_opam ~outf ~verbose ~prefix ~satysfi_version ~script_version ~build_module ~buildscript_path ~env
     | None -> Format.fprintf Format.err_formatter
         "Please specify “--prefix <dir>̣” option")
 

src/command/opam.ml

@@ -7,7 +7,7 @@ let library_dir prefix (buildscript: BuildScript.m) =
   let libdir = Filename.concat prefix "share/satysfi" in
   Filename.concat libdir (BuildScript.get_name buildscript)
 
-let build_opam ~outf ~verbose ~prefix:_ ~build_module ~buildscript_path ~env =
+let build_opam ~outf ~verbose ~prefix:_ ~satysfi_version:_ ~script_version:_ ~build_module ~buildscript_path ~env =
   let system_font_prefix = None in
   Build.build
     ~outf
@@ -18,10 +18,18 @@ let build_opam ~outf ~verbose ~prefix:_ ~build_module ~buildscript_path ~env =
     ~system_font_prefix
     ~env
 
-let install_opam ~outf ~verbose ~prefix ~build_module ~buildscript_path ~env:_ =
+let install_opam ~outf ~verbose ~prefix ~satysfi_version ~script_version ~build_module ~buildscript_path ~env:_ =
   let _, p = Build.read_module ~outf ~verbose ~build_module ~buildscript_path in
   let dir = library_dir prefix build_module in
-  Library.write_dir ~outf ~verbose ~symlink:false dir p
+  let migrate build_module =
+    Satyrographos_satysfi.Migration.migrate ~outf
+      script_version
+      satysfi_version
+      build_module
+  in
+  p
+  |> migrate
+  |> Library.write_dir ~outf ~verbose ~symlink:false dir
 
 let uninstall_opam ~outf:_ ~verbose:_ ~prefix ~build_module ~buildscript_path:_ ~env:_ =
   let dir = library_dir prefix build_module in
@@ -48,19 +56,20 @@ let export f () =
   BuildScript.get_module_map s
   |> BuildScript.export_opam
 
-let with_build_script f ~outf ~prefix ~buildscript_path ~name ~verbose ~env () =
+let with_build_script f ~outf ~prefix ?(satysfi_version=Satyrographos_satysfi.Version.latest_version) ~buildscript_path ~name ~verbose ~env () =
   let buildscript = BuildScript.load buildscript_path in
+  let script_version = BuildScript.buildscript_version buildscript in
   let module_map = BuildScript.get_module_map buildscript in
   match name with
   | None -> begin
     if StringMap.length module_map = 1
     then let build_module = StringMap.nth_exn module_map 0 |> snd in
-      f ~outf ~verbose ~prefix ~build_module ~buildscript_path ~env
+      f ~outf ~verbose ~prefix ~satysfi_version ~script_version ~build_module ~buildscript_path ~env
     else failwith "Please specify module name with -name option"
   end
   | Some name ->
     match StringMap.find module_map name with
       | Some build_module ->
-        f ~outf ~verbose ~prefix ~build_module ~buildscript_path ~env
+        f ~outf ~verbose ~prefix ~satysfi_version ~script_version ~build_module ~buildscript_path ~env
       | _ ->
         failwithf "Build file does not contains library %s" name ()

src/satysfi/migration.ml

@@ -0,0 +1,95 @@
+open Core
+
+module Json = Json_derivers.Yojson
+module Library = Satyrographos.Library
+
+let migrate_font_src ~outf (l: Library.t) =
+  let migrate_font_hash_variant_entry ~outf names = function
+    | ("src-dist", `String src_dist) ->
+      "src", `String ("dist/fonts/" ^ src_dist)
+    | ("src-dist", j) ->
+      Format.fprintf outf "Invalid value in hash %s: %s. Ignored.@."
+        ([%sexp_of: string list] names |> Sexp.to_string_hum)
+        (Library.Json.to_string j);
+      "src-dist", j
+    | e ->
+      e
+  in
+  let migrate_font_hash_variant_entry names = function
+    | `Variant (font_type, Some (`Assoc xs)) ->
+      let xs =
+        List.map xs ~f:(migrate_font_hash_variant_entry ~outf names)
+      in
+      `Variant (font_type, Some(`Assoc xs))
+    | j -> j
+  in
+  let migrate_font_hash names (j: Json.t) = match j with
+    | `Assoc xs ->
+      `Assoc (List.map xs ~f:(fun (font_name, variant) ->
+          font_name, migrate_font_hash_variant_entry names variant))
+    | j -> j
+  in
+  let hashes =
+    Library.LibraryFiles.mapi l.hashes ~f:(fun ~key ~data -> match key with
+        | "hash/fonts.satysfi-hash"
+        | "hash/mathfonts.satysfi-hash" ->
+          let names, j = data in
+          names, migrate_font_hash names j
+        | _ ->
+          data
+      )
+  in
+  { l with hashes }
+
+let%expect_test "migrate_font_src: valid" =
+  { name = Some "fonts-l";
+    version = Some "0.1";
+    files = Library.LibraryFiles.empty;
+    hashes =
+      ["hash/fonts.satysfi-hash", (["name1"], `Assoc [
+           "font1", `Variant ("Single", Some (`Assoc [
+               "src-dist", `String "fonts-l/font1.otf";
+             ]))
+         ]);
+       "hash/mathfonts.satysfi-hash", (["name1"], `Assoc [
+           "font2", `Variant ("Single", Some (`Assoc [
+               "src-dist", `String "fonts-l/font2.otf";
+             ]))
+         ]);
+       "hash/default-font.satysfi-hash", (["name1"], `Assoc [
+           "han-ideographic", `Assoc [
+               "ratio", `Float 0.8;
+             ];
+         ]);
+      ]
+      |> Library.LibraryFiles.of_alist_exn;
+    compatibility = Library.Compatibility.empty;
+    dependencies = Library.Dependency.empty;
+    autogen = Library.Dependency.empty;
+  }
+  |> migrate_font_src ~outf:Format.std_formatter
+  |> printf !"%{sexp: Library.t}";
+  [%expect {|
+    ((name (fonts-l)) (version (0.1))
+     (hashes
+      ((hash/default-font.satysfi-hash
+        ((name1) (Assoc ((han-ideographic (Assoc ((ratio (Float 0.8)))))))))
+       (hash/fonts.satysfi-hash
+        ((name1)
+         (Assoc
+          ((font1
+            (Variant
+             (Single ((Assoc ((src (String dist/fonts/fonts-l/font1.otf))))))))))))
+       (hash/mathfonts.satysfi-hash
+        ((name1)
+         (Assoc
+          ((font2
+            (Variant
+             (Single ((Assoc ((src (String dist/fonts/fonts-l/font2.otf))))))))))))))) |}]
+
+let migrate ~outf (buildscript_version: Satyrographos.BuildScript.version) satysfi_version l =
+  match buildscript_version with
+  | Lang_0_0_2 when Version.is_hash_font_src_dist_deprecated satysfi_version ->
+    l |> migrate_font_src ~outf
+  | _ ->
+    l

src/satysfi/version.ml

@@ -7,6 +7,8 @@ type t =
   | Satysfi_0_0_6
 [@@deriving sexp, compare, equal]
 
+let latest_version = Satysfi_0_0_6
+
 let alist = [
   "0.0.3", Satysfi_0_0_3;
   "v0.0.3", Satysfi_0_0_3;
@@ -118,15 +120,21 @@ let get_current_version () =
       Shexp_process.eval get_current_version_cmd)
 
 let flag =
+  let outf = Format.err_formatter in
   let open Command.Let_syntax in
   [%map_open
     let satysfi_version = flag "--satysfi-version" (optional (Arg_type.of_alist_exn alist)) ~aliases:["S"] ~doc:"VERSION SATySFi version"
     in
     match satysfi_version with
     | Some x -> x
     | None ->
-      get_current_version ()
-      |> Option.value_exn ~message:"Cannot detect SATySFi Version.  Please specify with --satysfi-version"
+      match get_current_version () with
+      | Some x -> x
+      | None ->
+        Format.fprintf outf
+          "Cannot detect SATySFi Version.  Please specify with --satysfi-version.  Assuming %s"
+          (to_string latest_version);
+        latest_version
   ]
 
 let is_hash_font_src_dist_deprecated = function

test/testcases/command_opam_install__library.expected

@@ -49,7 +49,7 @@ diff -Nr @@empty_dir@@/dest/share/satysfi/grcnum/fonts/grcnum/grcnum-font.ttf @@
 > @@font.ttf@@
 diff -Nr @@empty_dir@@/dest/share/satysfi/grcnum/hash/fonts.satysfi-hash @@dest_dir@@/dest/share/satysfi/grcnum/hash/fonts.satysfi-hash
 0a1
-> {"grcnum:grcnum-font":<"Single":{"src-dist":"grcnum/grcnum-font.ttf"}>}
+> {"grcnum:grcnum-font":<"Single":{"src":"dist/fonts/grcnum/grcnum-font.ttf"}>}
 \ No newline at end of file
 diff -Nr @@empty_dir@@/dest/share/satysfi/grcnum/md/grcnum/mdja.satysfi-md @@dest_dir@@/dest/share/satysfi/grcnum/md/grcnum/mdja.satysfi-md
 0a1

test/testcases/command_opam_install__library_recursive.expected

@@ -106,7 +106,7 @@ diff -Nr @@empty_dir@@/dest/share/satysfi/grcnum/fonts/grcnum/grcnum-font.ttf @@
 > @@font.ttf@@
 diff -Nr @@empty_dir@@/dest/share/satysfi/grcnum/hash/fonts.satysfi-hash @@dest_dir@@/dest/share/satysfi/grcnum/hash/fonts.satysfi-hash
 0a1
-> {"grcnum:grcnum-font":<"Single":{"src-dist":"grcnum/grcnum-font.ttf"}>}
+> {"grcnum:grcnum-font":<"Single":{"src":"dist/fonts/grcnum/grcnum-font.ttf"}>}
 \ No newline at end of file
 diff -Nr @@empty_dir@@/dest/share/satysfi/grcnum/metadata @@dest_dir@@/dest/share/satysfi/grcnum/metadata
 0a1,2