@@ -4,7 +4,7 @@ open Compile;
44open Grain_typed ;
55open Grain_utils ;
66open Grain_diagnostics ;
7- open Filename ;
7+ open Grain_utils . Filepath . Args ;
88
99let () =
1010 Printexc . register_printer(exc =>
@@ -28,13 +28,17 @@ let () =
2828 );
2929
3030[@ deriving cmdliner]
31- type params = {
31+ type io_params = {
3232 /** Grain source file for which to extract documentation */
3333 [@pos 0] [@docv "FILE"]
34- input: Filepath . Args . ExistingFile . t ,
34+ input: ExistingFileOrDirectory . t ,
3535 /** Output filename */
3636 [@name "o"] [@docv "FILE"]
37- output: option (Filepath . Args . MaybeExistingFile . t ),
37+ output: option (MaybeExistingFileOrDirectory . t ),
38+ };
39+
40+ [@ deriving cmdliner]
41+ type params = {
3842 /**
3943 The version to use as current when generating markdown for `@since` and `@history` attributes.
4044 Any future versions will be replace with `next` in the output.
@@ -43,10 +47,10 @@ type params = {
4347 current_version: option (string ),
4448};
4549
46- let compile_typed = (opts : params ) => {
47- let input = Filepath . to_string(opts . input) ;
48-
49- switch ( Compile . compile_file(~hook = stop_after_typed , input) ) {
50+ let compile_typed = (input : Fp . t ( Fp . absolute ) ) => {
51+ switch (
52+ Compile . compile_file(~hook = stop_after_typed , Filepath . to_string(input))
53+ ) {
5054 | exception exn =>
5155 let bt =
5256 if (Printexc . backtrace_status() ) {
@@ -71,7 +75,7 @@ let compile_typed = (opts: params) => {
7175};
7276
7377let generate_docs =
74- ({ current_version, output} : params , program: Typedtree . typed_program ) => {
78+ (~ current_version, ~ output=? , program: Typedtree . typed_program ) => {
7579 let comments = Comments . to_ordered(program. comments);
7680
7781 let env = program. env;
@@ -205,15 +209,12 @@ let generate_docs =
205209
206210 let contents = Buffer . to_bytes(buf);
207211 switch (output) {
208- | Some (NotExists (outfile )) =>
209- Fs_access . ensure_parent_directory_exists(Filepath . to_string(outfile))
210- | _ => ()
211- };
212-
213- switch (output) {
214- | Some (Exists (outfile ))
215- | Some (NotExists (outfile )) =>
216- let oc = Fs_access . open_file_for_writing(Filepath . to_string(outfile));
212+ | Some (outfile ) =>
213+ let outfile = Filepath . to_string(outfile);
214+ // TODO: This crashes if you do something weird like `-o stdout/map.gr/foo`
215+ // because `foo` doesn't exist so it tries to mkdir it and raises
216+ Fs_access . ensure_parent_directory_exists(outfile);
217+ let oc = Fs_access . open_file_for_writing(outfile);
217218 output_bytes(oc, contents);
218219 close_out(oc);
219220 | None => print_bytes(contents)
@@ -222,13 +223,87 @@ let generate_docs =
222223 () ;
223224};
224225
225- let graindoc = opts => {
226- let program = compile_typed(opts);
227- try (generate_docs(opts, program)) {
228- | exn =>
229- Format . eprintf("@ [% s @ ] @ . " , Printexc . to_string(exn));
230- exit(2 );
226+ type run = {
227+ input_path: Fp . t (Fp . absolute ),
228+ output_path: option (Fp . t (Fp . absolute )),
229+ };
230+
231+ let enumerate_directory = (input_dir_path, output_dir_path) => {
232+ let all_files = Array . to_list(Fs_access . readdir(input_dir_path));
233+ let grain_files =
234+ List . filter(
235+ filepath => Filename . extension(Fp . toString(filepath)) == ".gr" ,
236+ all_files,
237+ );
238+ List . map(
239+ filepath => {
240+ // We relativize between the input directory and the full filepath
241+ // such that we can reconstruct the directory structure of the input directory
242+ let relative_path =
243+ Fp . relativizeExn(~source= input_dir_path, ~dest= filepath);
244+ let gr_basename = Option . get(Fp . baseName(relative_path));
245+ let md_basename =
246+ Filepath . String . remove_extension(gr_basename) ++ ".md" ;
247+ let dirname = Fp . dirName(relative_path);
248+ let md_relative_path = Fp . join(dirname, Fp . relativeExn(md_basename));
249+ let output_path = Fp . join(output_dir_path, md_relative_path);
250+ {input_path: filepath, output_path: Some (output_path)};
251+ },
252+ grain_files,
253+ );
254+ };
255+
256+ let enumerate_runs = opts =>
257+ switch (opts. input, opts. output) {
258+ | (File (input_file_path ), None ) =>
259+ ` Ok ([ {input_path: input_file_path, output_path: None }] )
260+ | (File (input_file_path ), Some (Exists (File (output_file_path )))) =>
261+ ` Ok ([
262+ {input_path: input_file_path, output_path: Some (output_file_path)},
263+ ] )
264+ | (File (input_file_path ), Some (NotExists (output_file_path ))) =>
265+ ` Ok ([
266+ {input_path: input_file_path, output_path: Some (output_file_path)},
267+ ] )
268+ | (Directory (_ ), None ) =>
269+ ` Error ((
270+ false ,
271+ "Directory input must be used with `-o` flag to specify output directory" ,
272+ ))
273+ | (Directory (input_dir_path ), Some (Exists (Directory (output_dir_path )))) =>
274+ ` Ok (enumerate_directory(input_dir_path, output_dir_path))
275+ | (Directory (input_dir_path ), Some (NotExists (output_dir_path ))) =>
276+ ` Ok (enumerate_directory(input_dir_path, output_dir_path))
277+ | (File (input_file_path ), Some (Exists (Directory (output_dir_path )))) =>
278+ ` Error ((
279+ false ,
280+ "Using a file as input cannot be combined with directory output" ,
281+ ))
282+ | (Directory (_ ), Some (Exists (File (_ )))) =>
283+ ` Error ((
284+ false ,
285+ "Using a directory as input cannot be written as a single file output" ,
286+ ))
231287 };
288+
289+ let graindoc = (opts, runs) => {
290+ List . iter(
291+ ({input_path, output_path}) => {
292+ let program = compile_typed(input_path);
293+ try (
294+ generate_docs(
295+ ~current_version= opts. current_version,
296+ ~output=? output_path,
297+ program,
298+ )
299+ ) {
300+ | exn =>
301+ Format . eprintf("@ [% s @ ] @ . " , Printexc . to_string(exn));
302+ exit(2 );
303+ };
304+ },
305+ runs,
306+ );
232307};
233308
234309let cmd = {
@@ -243,7 +318,9 @@ let cmd = {
243318
244319 Cmd . v(
245320 Cmd . info(Sys . argv[ 0 ] , ~version, ~doc),
246- Grain_utils . Config . with_cli_options(graindoc) $ params_cmdliner_term() ,
321+ Grain_utils . Config . with_cli_options(graindoc)
322+ $ params_cmdliner_term()
323+ $ ret(const(enumerate_runs) $ io_params_cmdliner_term() ),
247324 );
248325};
249326
0 commit comments