Source file link_js.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
(* Js_of_ocaml compiler
 * http://www.ocsigen.org/js_of_ocaml/
 * Copyright (C) 2017 Hugo Heuzard
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU Lesser General Public License as published by
 * the Free Software Foundation, with linking exception;
 * either version 2.1 of the License, or (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 *)
open! Stdlib

let sourceMappingURL = "//# sourceMappingURL="

let sourceMappingURL_base64 = "//# sourceMappingURL=data:application/json;base64,"

type action =
  | Keep
  | Drop
  | Build_info of Build_info.t
  | Source_map of Source_map.t

let action ~resolve_sourcemap_url ~drop_source_map file line =
  let prefix_kind =
    match String.is_prefix ~prefix:sourceMappingURL line with
    | false -> (
        match Build_info.parse line with
        | Some bi -> `Build_info bi
        | None -> `Other)
    | true -> (
        match String.is_prefix ~prefix:sourceMappingURL_base64 line with
        | true -> `Json_base64 (String.length sourceMappingURL_base64)
        | false -> `Url (String.length sourceMappingURL))
  in
  match prefix_kind, drop_source_map with
  | `Other, (true | false) -> Keep
  | `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))
  | `Url _, false when not resolve_sourcemap_url -> Drop
  | `Url offset, false ->
      let url = String.sub line ~pos:offset ~len:(String.length line - offset) in
      let base = Filename.dirname file in
      let ic = open_in (Filename.concat base url) in
      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)

let link ~output ~files ~resolve_sourcemap_url ~source_map =
  let sm = ref [] in
  let line_offset = ref 0 in
  let build_info = ref None in
  let new_line () =
    output_string output "\n";
    incr line_offset
  in
  try
    List.iter
      ~f:(fun file ->
        let build_info_for_file = ref None in
        let ic = open_in file in
        (try
           output_string output (Printf.sprintf "//# 1 %S" file);
           new_line ();
           let start_line = !line_offset in
           while true do
             let line = input_line ic in
             match
               action
                 ~resolve_sourcemap_url
                 ~drop_source_map:Poly.(source_map = None)
                 file
                 line
             with
             | Keep ->
                 output_string output line;
                 new_line ()
             | Build_info bi -> (
                 match !build_info_for_file with
                 | None -> build_info_for_file := Some bi
                 | Some bi' ->
                     build_info_for_file := Some (Build_info.merge file bi' file bi))
             | Drop -> ()
             | Source_map x -> sm := (start_line, x) :: !sm
           done
         with End_of_file -> ());
        close_in ic;
        new_line ();
        match !build_info, !build_info_for_file with
        | None, None -> ()
        | Some _, None -> ()
        | None, Some build_info_for_file -> build_info := Some (file, build_info_for_file)
        | Some (first_file, bi), Some build_info_for_file ->
            build_info :=
              Some (first_file, Build_info.merge first_file bi file build_info_for_file))
      files;
    match source_map with
    | None -> ()
    | Some (file, init_sm) -> (
        match Source_map.merge ((0, init_sm) :: List.rev !sm) with
        | None -> ()
        | Some sm -> (
            (* preserve some info from [init_sm] *)
            let sm =
              { sm with
                version = init_sm.version
              ; file = init_sm.file
              ; sourceroot = init_sm.sourceroot
              }
            in
            match file with
            | None ->
                let data = Source_map_io.to_string sm in
                let s = sourceMappingURL_base64 ^ Base64.encode_exn data in
                output_string output s
            | Some file ->
                Source_map_io.to_file sm file;
                let s = sourceMappingURL ^ Filename.basename file in
                output_string output s))
  with Build_info.Incompatible_build_info { key; first = f1, v1; second = f2, v2 } ->
    let string_of_v = function
      | None -> "<empty>"
      | Some v -> v
    in
    failwith
      (Printf.sprintf
         "Incompatible build info detected while linking.\n - %s: %s=%s\n - %s: %s=%s"
         f1
         key
         (string_of_v v1)
         f2
         key
         (string_of_v v2))