Merge pull request #69 from OlivierNicole/converge-jsoo-merge-05

Sourcemap API changes from js_of_ocaml

compiler/bin-js_of_ocaml/cmd_arg.ml

@@ -324,16 +324,6 @@ let options =
             } )
       else None
     in
-    let source_map =
-      if Option.is_some source_map && not Source_map_io.enabled
-      then (
-        warn
-          "Warning: '--source-map' flag ignored because js_of_ocaml was compiled without \
-           sourcemap support (install yojson to enable support)\n\
-           %!";
-        None)
-      else source_map
-    in
     let params : (string * string) list = List.flatten set_param in
     let static_env : (string * string) list = List.flatten set_env in
     let include_dirs = normalize_include_dirs include_dirs in
@@ -563,16 +553,6 @@ let options_runtime_only =
             } )
       else None
     in
-    let source_map =
-      if Option.is_some source_map && not Source_map_io.enabled
-      then (
-        warn
-          "Warning: '--source-map' flag ignored because js_of_ocaml was compiled without \
-           sourcemap support (install yojson to enable support)\n\
-           %!";
-        None)
-      else source_map
-    in
     let params : (string * string) list = List.flatten set_param in
     let static_env : (string * string) list = List.flatten set_env in
     let include_dirs = normalize_include_dirs include_dirs in

compiler/bin-js_of_ocaml/compile.ml

@@ -50,10 +50,10 @@ let output_gen ~standalone ~custom_header ~build_info ~source_map output_file f
         let urlData =
           match output_file with
           | None ->
-              let data = Source_map_io.to_string sm in
+              let data = Source_map.to_string sm in
               "data:application/json;base64," ^ Base64.encode_exn data
           | Some output_file ->
-              Source_map_io.to_file sm ~file:output_file;
+              Source_map.to_file sm ~file:output_file;
               Filename.basename output_file
         in
         Pretty_print.newline fmt;

compiler/bin-wasm_of_ocaml/compile.ml

@@ -30,7 +30,7 @@ let update_sourcemap ~sourcemap_root ~sourcemap_don't_inline_content sourcemap_f
   if Option.is_some sourcemap_root || not sourcemap_don't_inline_content
   then (
     let open Source_map in
-    let source_map, mappings = Source_map_io.of_file_no_mappings sourcemap_file in
+    let source_map, mappings = Source_map.of_file_no_mappings sourcemap_file in
     assert (List.is_empty (Option.value source_map.sources_content ~default:[]));
     (* Add source file contents to source map *)
     let sources_content =
@@ -40,7 +40,7 @@ let update_sourcemap ~sourcemap_root ~sourcemap_don't_inline_content sourcemap_f
         Some
           (List.map source_map.sources ~f:(fun file ->
                if Sys.file_exists file && not (Sys.is_directory file)
-               then Some (Fs.read_file file)
+               then Some (Source_map.Source_content.create (Fs.read_file file))
                else None))
     in
     let source_map =
@@ -50,7 +50,7 @@ let update_sourcemap ~sourcemap_root ~sourcemap_don't_inline_content sourcemap_f
           (if Option.is_some sourcemap_root then sourcemap_root else source_map.sourceroot)
       }
     in
-    Source_map_io.to_file ?mappings source_map ~file:sourcemap_file)
+    Source_map.to_file ?mappings source_map ~file:sourcemap_file)
 
 let opt_with action x f =
   match x with

compiler/lib/dune

@@ -7,11 +7,7 @@
   compiler-libs.bytecomp
   menhirLib
   sedlex
-  (select
-   source_map_io.ml
-   from
-   (yojson -> source_map_io.yojson.ml)
-   (-> source_map_io.unsupported.ml)))
+  yojson)
  (flags
   (:standard -w -7-37 -safe-string))
  (preprocess

compiler/lib/js_output.ml

@@ -1534,7 +1534,7 @@ let program ?(accept_unnamed_var = false) f ?source_map p =
   let temp_mappings = ref [] in
   let files = Hashtbl.create 17 in
   let names = Hashtbl.create 17 in
-  let contents : string option list ref option =
+  let contents : Source_map.Source_content.t option list ref option =
     match source_map with
     | None | Some { Source_map.sources_content = None; _ } -> None
     | Some { Source_map.sources_content = Some _; _ } -> Some (ref [])
@@ -1577,7 +1577,13 @@ let program ?(accept_unnamed_var = false) f ?source_map p =
         with Not_found ->
           let pos = Hashtbl.length files in
           Hashtbl.add files file pos;
-          Option.iter contents ~f:(fun r -> r := find_source file :: !r);
+          Option.iter contents ~f:(fun r ->
+              let source_contents =
+                match find_source file with
+                | None -> None
+                | Some s -> Some (Source_map.Source_content.create s)
+              in
+              r := source_contents :: !r);
           pos)
     , (fun name ->
         try Hashtbl.find names name

compiler/lib/link_js.ml

@@ -177,7 +177,7 @@ let action ~resolve_sourcemap_url ~drop_source_map file line =
   | `Build_info bi, _ -> Build_info bi
   | (`Json_base64 _ | `Url _), true -> Drop
   | `Json_base64 offset, false ->
-      Source_map (Source_map_io.of_string (Base64.decode_exn ~off:offset line))
+      Source_map (Source_map.of_string (Base64.decode_exn ~off:offset line))
   | `Url _, false when not resolve_sourcemap_url -> Drop
   | `Url offset, false ->
       let url = String.sub line ~pos:offset ~len:(String.length line - offset) in
@@ -186,7 +186,7 @@ let action ~resolve_sourcemap_url ~drop_source_map file line =
       let l = in_channel_length ic in
       let content = really_input_string ic l in
       close_in ic;
-      Source_map (Source_map_io.of_string content)
+      Source_map (Source_map.of_string content)
 
 module Units : sig
   val read : Line_reader.t -> Unit_info.t -> Unit_info.t
@@ -465,11 +465,11 @@ let link ~output ~linkall ~mklib ~toplevel ~files ~resolve_sourcemap_url ~source
           in
           match file with
           | None ->
-              let data = Source_map_io.to_string sm in
+              let data = Source_map.to_string sm in
               let s = sourceMappingURL_base64 ^ Base64.encode_exn data in
               Line_writer.write oc s
           | Some file ->
-              Source_map_io.to_file sm ~file;
+              Source_map.to_file sm ~file;
               let s = sourceMappingURL ^ Filename.basename file in
               Line_writer.write oc s));
       if times () then Format.eprintf "  sourcemap: %a@." Timer.print t

compiler/lib/source_map.ml

@@ -19,6 +19,16 @@
 
 open! Stdlib
 
+module Source_content = struct
+  type t = Sc_as_Stringlit of string
+
+  let create s = Sc_as_Stringlit (Yojson.Safe.to_string (`String s))
+
+  let of_stringlit (`Stringlit s) = Sc_as_Stringlit s
+
+  let to_json (Sc_as_Stringlit s) = `Stringlit s
+end
+
 type map =
   | Gen of
       { gen_line : int
@@ -47,7 +57,7 @@ type t =
   ; file : string
   ; sourceroot : string option
   ; sources : string list
-  ; sources_content : string option list option
+  ; sources_content : Source_content.t option list option
   ; names : string list
   ; mappings : mapping
   }
@@ -298,3 +308,135 @@ let merge = function
         ; names = List.rev acc_rev.names
         ; sources_content = Option.map ~f:List.rev acc_rev.sources_content
         }
+
+(* IO *)
+
+let json ?replace_mappings t =
+  let rewrite_path path =
+    if Filename.is_relative path
+    then path
+    else
+      match Build_path_prefix_map.get_build_path_prefix_map () with
+      | Some map -> Build_path_prefix_map.rewrite map path
+      | None -> path
+  in
+  let stringlit s = `Stringlit (Yojson.Safe.to_string (`String s)) in
+  `Assoc
+    [ "version", `Intlit (string_of_int t.version)
+    ; "file", stringlit (rewrite_path t.file)
+    ; ( "sourceRoot"
+      , stringlit
+          (match t.sourceroot with
+          | None -> ""
+          | Some s -> rewrite_path s) )
+    ; "names", `List (List.map t.names ~f:(fun s -> stringlit s))
+    ; "sources", `List (List.map t.sources ~f:(fun s -> stringlit (rewrite_path s)))
+    ; ( "mappings"
+      , stringlit (match replace_mappings with
+        | None -> string_of_mapping t.mappings
+        | Some m -> m) )
+    ; ( "sourcesContent"
+      , `List
+          (match t.sources_content with
+          | None -> []
+          | Some l ->
+              List.map l ~f:(function
+                  | None -> `Null
+                  | Some x -> Source_content.to_json x)) )
+    ]
+
+let invalid () = invalid_arg "Source_map.of_json"
+
+let string_of_stringlit (`Stringlit s) =
+  match Yojson.Safe.from_string s with
+  | `String s -> s
+  | _ -> invalid ()
+
+let stringlit name rest : [ `Stringlit of string ] option =
+  try
+    match List.assoc name rest with
+    | `Stringlit _ as s -> Some s
+    | `Null -> None
+    | _ -> invalid ()
+  with Not_found -> None
+
+let list_stringlit name rest =
+  try
+    match List.assoc name rest with
+    | `List l ->
+        Some
+          (List.map l ~f:(function
+              | `Stringlit _ as s -> s
+              | _ -> invalid ()))
+    | _ -> invalid ()
+  with Not_found -> None
+
+let list_stringlit_opt name rest =
+  try
+    match List.assoc name rest with
+    | `List l ->
+        Some
+          (List.map l ~f:(function
+              | `Stringlit _ as s -> Some s
+              | `Null -> None
+              | _ -> invalid ()))
+    | _ -> invalid ()
+  with Not_found -> None
+
+let of_json ~parse_mappings (json : Yojson.Raw.t) =
+  match json with
+  | `Assoc (("version", `Intlit version) :: rest) when int_of_string version = 3 ->
+      let string name json = Option.map ~f:string_of_stringlit (stringlit name json) in
+      let file =
+        match string "file" rest with
+        | None -> ""
+        | Some s -> s
+      in
+      let sourceroot = string "sourceRoot" rest in
+      let names =
+        match list_stringlit "names" rest with
+        | None -> []
+        | Some l -> List.map ~f:string_of_stringlit l
+      in
+      let sources =
+        match list_stringlit "sources" rest with
+        | None -> []
+        | Some l -> List.map ~f:string_of_stringlit l
+      in
+      let sources_content =
+        match list_stringlit_opt "sourcesContent" rest with
+        | None -> None
+        | Some l ->
+            Some
+              (List.map l ~f:(function
+                  | None -> None
+                  | Some s -> Some (Source_content.of_stringlit s)))
+      in
+      let mappings_str = string "mappings" rest in
+      let mappings =
+        match parse_mappings, mappings_str with
+        | false, _ -> mapping_of_string ""
+        | true, None -> mapping_of_string ""
+        | true, Some s -> mapping_of_string s
+      in
+      ( { version = int_of_float (float_of_string version)
+        ; file
+        ; sourceroot
+        ; names
+        ; sources_content
+        ; sources
+        ; mappings
+        }
+      , if parse_mappings then None else mappings_str )
+  | _ -> invalid ()
+
+let of_string s = of_json ~parse_mappings:true (Yojson.Raw.from_string s) |> fst
+
+let to_string m = Yojson.Raw.to_string (json m)
+
+let to_file ?mappings m ~file =
+  let replace_mappings = mappings in
+  Yojson.Raw.to_file file (json ?replace_mappings m)
+
+let of_file_no_mappings filename =
+  of_json ~parse_mappings:false (Yojson.Raw.from_file filename)

compiler/lib/source_map.mli

@@ -17,6 +17,12 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  *)
 
+module Source_content : sig
+  type t
+
+  val create : string -> t
+end
+
 type map =
   | Gen of
       { gen_line : int
@@ -45,7 +51,7 @@ type t =
   ; file : string
   ; sourceroot : string option
   ; sources : string list
-  ; sources_content : string option list option
+  ; sources_content : Source_content.t option list option
   ; names : string list
   ; mappings : mapping
   }
@@ -59,3 +65,16 @@ val mapping_of_string : string -> mapping
 val string_of_mapping : mapping -> string
 
 val empty : filename:string -> t
+
+val to_string : t -> string
+
+val of_string : string -> t
+
+val of_file_no_mappings : string -> t * string option
+(** Read source map from a file without parsing the mappings (which can be costly). The
+    [mappings] field is returned empty and the raw string is returned alongside the map.
+ *)
+
+val to_file : ?mappings:string -> t -> file:string -> unit
+(** Write to a file. If a string is supplied as [mappings], use it instead of the
+    sourcemap's [mappings]. *)