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
|
module List = ListLabels
let read_file path = try Some (In_channel.with_open_bin path In_channel.input_all) with _ -> None
type manifest_item =
| Client_component of { original_path : string; compiled_js_path : string; module_name : string list option }
| Server_function of {
id : string;
compiled_js_path : string;
module_name : string list option;
function_name : string;
}
let parse_module_name str = String.split_on_char '.' str
let print_module_name str = String.concat "." str
let parse_client_component_line line =
try
Scanf.sscanf line "// extract-client %s %s" (fun filename module_name ->
Ok (filename, if module_name = "" then None else Some (parse_module_name module_name)))
with End_of_file | Scanf.Scan_failure _ -> Error "Invalid `extract-client` command format"
let parse_server_function_line line =
try
Scanf.sscanf line "// extract-server-function %s %s %s" (fun id function_name module_name ->
Ok ((if module_name = "" then None else Some (parse_module_name module_name)), function_name, id))
with End_of_file | Scanf.Scan_failure _ -> Error "Invalid `extract-server-function` command format"
let parse_manifest_item ~path line =
match (parse_client_component_line (String.trim line), parse_server_function_line (String.trim line)) with
| Ok (original_path, module_name), _ ->
Some (Client_component { compiled_js_path = path; original_path; module_name })
| _, Ok (module_name, function_name, id) ->
Some (Server_function { compiled_js_path = path; module_name; function_name; id })
| Error _, Error _ -> None
let parse_manifest_data ~path content : manifest_item list =
content |> String.split_on_char '\n' |> List.filter_map ~f:(parse_manifest_item ~path)
let render_manifest manifest =
let register_client_modules =
List.map manifest ~f:(function
| Client_component { original_path; compiled_js_path; module_name } ->
let original_path_with_submodule =
match module_name with
| Some name -> Printf.sprintf "%s#%s" original_path (print_module_name name)
| None -> original_path
in
let export =
match module_name with
| Some name -> Printf.sprintf "%s.make_client" (print_module_name name)
| None -> "make_client"
in
Printf.sprintf
"window.__client_manifest_map[\"%s\"] = React.lazy(() => import(\"%s\").then(module => {\n\
\ return { default: module.%s }\n\
}).catch(err => { console.error(err); return { default: null }; }))"
original_path_with_submodule compiled_js_path export
| Server_function { compiled_js_path; module_name; function_name; id } ->
let export =
match module_name with
| Some name -> Printf.sprintf "%s.%s" (print_module_name name) function_name
| None -> function_name
in
Printf.sprintf "window.__server_functions_manifest_map[\"%s\"] = require(\"%s\").%s" id compiled_js_path
export)
in
Printf.sprintf
{|import React from "react";
window.__client_manifest_map = window.__client_manifest_map || {};
window.__server_functions_manifest_map = window.__server_functions_manifest_map || {};
%s|}
(String.concat "\n" register_client_modules)
(* TODO: Add parameter to allow users to configure the extension of the files *)
let is_js_file path =
let ext = Filename.extension path in
ext = ".js" || ext = ".bs.js" || ext = ".jsx"
(* TODO: refactor path to be a Filepath, not a string *)
let capture_all_client_modules_files_in_target path =
let rec traverse_fs path =
try
match Sys.is_directory path with
| true ->
let contents = Sys.readdir path in
Array.fold_left
(fun acc entry ->
let full_path = Filename.concat path entry in
match acc with
| Ok files -> (
match traverse_fs full_path with Ok new_files -> Ok (files @ new_files) | Error err -> Error err)
| Error err -> Error err)
(Ok []) contents
| false ->
if is_js_file path then
match read_file path with
| Some content -> Ok (parse_manifest_data ~path content)
| None -> Error (Printf.sprintf "Failed to read file: %s" path)
else Ok []
with
| Sys_error msg -> Error (Printf.sprintf "System error: %s" msg)
| Unix.Unix_error (err, _, _) -> Error (Printf.sprintf "Unix error: %s" (Unix.error_message err))
| e -> Error (Printf.sprintf "Unexpected error: %s" (Printexc.to_string e))
in
traverse_fs path
let melange_target =
let doc = "Path to the melange target directory (melange.emit (target xxx))" in
Cmdliner.Arg.(required & pos 0 (some string) None & info [] ~docv:"MELANGE_TARGET" ~doc)
let extract_modules target =
let current_dir = Sys.getcwd () in
let melange_target = Filename.concat current_dir target in
match capture_all_client_modules_files_in_target melange_target with
| Ok manifest ->
print_endline (render_manifest manifest);
Ok ()
| Error msg -> Error (`Msg msg)
let extract_cmd =
let open Cmdliner in
let doc = "Extract all client modules from a Melange target folder" in
let sdocs = Manpage.s_common_options in
let info = Cmd.info "extract-client-components" ~version:"1.0.0" ~doc ~sdocs in
let term = Term.(term_result (const extract_modules $ melange_target)) in
Cmd.v info term
let () = exit (Cmdliner.Cmd.eval extract_cmd)
|
