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
8type test_case = {
9 id : string;
10 name : string;
11 yaml : string;
12 tree : string option;
13 json : string option;
14 fail : bool;
15}
16(** Test case representation *)
17
18(** Module type for file I/O operations *)
19module type FILE_IO = sig
20 type ctx
21 (** Context type for file operations (unit for sync, ~fs for Eio) *)
22
23 val read_file : ctx -> string -> string option
24 (** Read a file, returning None if it doesn't exist or can't be read *)
25
26 val file_exists : ctx -> string -> bool
27 (** Check if a path exists and is a regular file *)
28
29 val is_directory : ctx -> string -> bool
30 (** Check if a path exists and is a directory *)
31
32 val read_dir : ctx -> string -> string list
33 (** List directory entries *)
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 Some s -> s | None -> ""
49
50 (** Load a single test from a directory *)
51 let load_test_dir ctx base_id dir_path =
52 let name_file = Filename.concat dir_path "===" in
53 let yaml_file = Filename.concat dir_path "in.yaml" in
54 let tree_file = Filename.concat dir_path "test.event" in
55 let json_file = Filename.concat dir_path "in.json" in
56 let error_file = Filename.concat dir_path "error" in
57
58 (* Must have in.yaml to be a valid test *)
59 if not (IO.file_exists ctx yaml_file) then None
60 else
61 let name =
62 match IO.read_file ctx name_file with
63 | Some s -> String.trim s
64 | None -> base_id
65 in
66 let yaml = read_file_required ctx yaml_file in
67 let tree = IO.read_file ctx tree_file in
68 let json = IO.read_file ctx json_file in
69 let fail = IO.file_exists ctx error_file in
70 Some { id = base_id; name; yaml; tree; json; fail }
71
72 (** Load tests from a test ID directory (may have subdirectories for variants)
73 *)
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 =
81 List.exists
82 (fun e ->
83 let subdir = Filename.concat dir_path e in
84 IO.is_directory ctx subdir
85 && String.length e >= 2
86 && e.[0] >= '0'
87 && e.[0] <= '9')
88 entries
89 in
90
91 if has_variants then
92 (* Load each variant subdirectory *)
93 let variants =
94 entries
95 |> List.filter (fun e ->
96 let subdir = Filename.concat dir_path e in
97 IO.is_directory ctx subdir
98 && String.length e >= 2
99 && e.[0] >= '0'
100 && e.[0] <= '9')
101 |> List.sort String.compare
102 in
103 List.filter_map
104 (fun variant ->
105 let variant_path = Filename.concat dir_path variant in
106 let variant_id = Printf.sprintf "%s:%s" test_id variant in
107 load_test_dir ctx variant_id variant_path)
108 variants
109 else
110 (* Single test in this directory *)
111 match load_test_dir ctx test_id dir_path with
112 | Some t -> [ t ]
113 | None -> []
114
115 (** Load all tests from a test suite directory *)
116 let load_directory ctx test_suite_path =
117 if not (IO.is_directory ctx test_suite_path) then []
118 else
119 let entries = IO.read_dir ctx test_suite_path in
120 let test_ids =
121 entries
122 |> List.filter (fun e ->
123 IO.is_directory ctx (Filename.concat test_suite_path e)
124 && String.length e >= 4
125 && e.[0] >= '0'
126 && e.[0] <= 'Z')
127 |> List.sort String.compare
128 in
129 List.concat_map (load_test_id ctx test_suite_path) test_ids
130end