Pure OCaml Yaml 1.2 reader and writer using Bytesrw
anil.recoil.org
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6(** Generic test suite loader - parameterized by file I/O operations *)
7
8(** Test case representation *)
9type test_case = {
10 id : string;
11 name : string;
12 yaml : string;
13 tree : string option;
14 json : string option;
15 fail : bool;
16}
17
18(** Module type for file I/O operations *)
19module type FILE_IO = sig
20 (** Context type for file operations (unit for sync, ~fs for Eio) *)
21 type ctx
22
23 (** Read a file, returning None if it doesn't exist or can't be read *)
24 val read_file : ctx -> string -> string option
25
26 (** Check if a path exists and is a regular file *)
27 val file_exists : ctx -> string -> bool
28
29 (** Check if a path exists and is a directory *)
30 val is_directory : ctx -> string -> bool
31
32 (** List directory entries *)
33 val read_dir : ctx -> string -> string list
34end
35
36(** Create a test loader from file I/O operations *)
37module Make (IO : FILE_IO) = struct
38 type test_case = {
39 id : string;
40 name : string;
41 yaml : string;
42 tree : string option;
43 json : string option;
44 fail : bool;
45 }
46
47 let read_file_required ctx path =
48 match IO.read_file ctx path with
49 | Some s -> s
50 | None -> ""
51
52 (** Load a single test from a directory *)
53 let load_test_dir ctx base_id dir_path =
54 let name_file = Filename.concat dir_path "===" in
55 let yaml_file = Filename.concat dir_path "in.yaml" in
56 let tree_file = Filename.concat dir_path "test.event" in
57 let json_file = Filename.concat dir_path "in.json" in
58 let error_file = Filename.concat dir_path "error" in
59
60 (* Must have in.yaml to be a valid test *)
61 if not (IO.file_exists ctx yaml_file) then None
62 else
63 let name = match IO.read_file ctx name_file with
64 | Some s -> String.trim s
65 | None -> base_id
66 in
67 let yaml = read_file_required ctx yaml_file in
68 let tree = IO.read_file ctx tree_file in
69 let json = IO.read_file ctx json_file in
70 let fail = IO.file_exists ctx error_file in
71 Some { id = base_id; name; yaml; tree; json; fail }
72
73 (** Load tests from a test ID directory (may have subdirectories for variants) *)
74 let load_test_id ctx test_suite_path test_id =
75 let dir_path = Filename.concat test_suite_path test_id in
76 if not (IO.is_directory ctx dir_path) then []
77 else
78 let entries = IO.read_dir ctx dir_path in
79 (* Check if this directory has variant subdirectories (00, 01, etc.) *)
80 let has_variants = List.exists (fun e ->
81 let subdir = Filename.concat dir_path e in
82 IO.is_directory ctx subdir &&
83 String.length e >= 2 &&
84 e.[0] >= '0' && e.[0] <= '9'
85 ) entries in
86
87 if has_variants then
88 (* Load each variant subdirectory *)
89 let variants = entries
90 |> List.filter (fun e ->
91 let subdir = Filename.concat dir_path e in
92 IO.is_directory ctx subdir &&
93 String.length e >= 2 &&
94 e.[0] >= '0' && e.[0] <= '9')
95 |> List.sort String.compare
96 in
97 List.filter_map (fun variant ->
98 let variant_path = Filename.concat dir_path variant in
99 let variant_id = Printf.sprintf "%s:%s" test_id variant in
100 load_test_dir ctx variant_id variant_path
101 ) variants
102 else
103 (* Single test in this directory *)
104 match load_test_dir ctx test_id dir_path with
105 | Some t -> [t]
106 | None -> []
107
108 (** Load all tests from a test suite directory *)
109 let load_directory ctx test_suite_path =
110 if not (IO.is_directory ctx test_suite_path) then []
111 else
112 let entries = IO.read_dir ctx test_suite_path in
113 let test_ids = entries
114 |> List.filter (fun e ->
115 IO.is_directory ctx (Filename.concat test_suite_path e) &&
116 String.length e >= 4 &&
117 e.[0] >= '0' && e.[0] <= 'Z')
118 |> List.sort String.compare
119 in
120 List.concat_map (load_test_id ctx test_suite_path) test_ids
121end