summaryrefslogtreecommitdiff
path: root/test/test_input.ml
blob: ccfd595c3d9c21c88276e9c528be499a79ade09c (plain)
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
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
(*─────────────────────────────────────────────────────────────────────────────┐
│ SPDX-FileCopyrightText: 2025 toastal <https://toast.al/contact/>             │
│ SPDX-License-Identifier: LGPL-2.1-or-later WITH OCaml-LGPL-linking-exception │
└─────────────────────────────────────────────────────────────────────────────*)
open Alcotest
open Nixtamal

let suite =
	[test_case "Manifest latest-cmd to KDL" `Quick (fun () ->
		let kdl = testable KDL.pp KDL.equal in
		let open Nixtamal.Input.Latest.Cmd in
		let t = Input.Template.make in
		let in_kdl =
			~${prog = t "curl"; args = [t "https://toast.al"]}
			|: {prog = t "head"; args = [t "-n1"]}
			|> Option.some
			|> Manifest.Latest_cmd.codec.to_kdl
		in
		let out_kdl =
			{|
				latest-cmd {
					$ curl "https://toast.al"
					| head -n1
				}
			|}
			|> KDL.of_string
			|> Result.get_ok
		in
		check kdl "KDL latest-cmd with pipe" out_kdl in_kdl
	);
	test_case "Manifest latest-cmd of KDL" `Quick (fun () ->
		let latest_cmd = testable Manifest.Latest_cmd.pp Manifest.Latest_cmd.equal in
		let open Nixtamal.Input.Latest.Cmd in
		let t = Input.Template.make in
		let in_latest_cmd =
			let kdl =
				{|
					latest-cmd {
						$ curl "https://toast.al"
						| head -n1
					}
				|}
				|> KDL.of_string
				|> Result.get_ok
			in
			match Manifest.Latest_cmd.codec.of_kdl kdl with
			| Ok lc -> lc
			| Error err -> failwith Fmt.(str "%a from %a" (list ~sep: semi KDL.Valid.pp_err) err KDL.pp kdl)
		in
		let out_latest_cmd =
			~${prog = t "curl"; args = [t "https://toast.al"]}
			|: {prog = t "head"; args = [t "-n1"]}
			|> Option.some
		in
		check latest_cmd "latest-cmd with pipe from KDL" out_latest_cmd in_latest_cmd
	);
	test_case "Manifest frozen Pijul to KDL" `Quick (fun () ->
		let kdl = testable KDL.pp KDL.equal in
		let t = Input.Template.make in
		let in_kdl =
			let name = Name.Name.make "pijul"
			and kind = `Pijul (Manifest.Pijul.make ~remote: (t "https://nest.pijul.com/pijul/pijul") ~reference: (`Channel "main") ())
			and hash = Manifest.Hash.make ()
			in
			Manifest.Input'.make ~name ~kind ~hash ~latest_cmd: None ~frozen: true ()
			|> Manifest.Input'.codec.to_node
		in
		let out_kdl =
			{|
				pijul frozen=#true {
					pijul {
						remote "https://nest.pijul.com/pijul/pijul"
						channel main
					}
				}
			|}
			|> KDL.of_string
			|> Result.get_ok
		in
		check kdl "KDL frozen Pijul" out_kdl [in_kdl]
	);
	test_case "Manifest frozen Pijul of KDL" `Quick (fun () ->
		let input = testable Manifest.Input'.pp Manifest.Input'.equal in
		let open KDL.L in
		let open KDL.Valid in
		let t = Input.Template.make in
		let in_input =
			let kdl =
				{|
					pijul frozen=#true {
						pijul {
							remote "https://nest.pijul.com/pijul/pijul"
							channel main
						}
					}
				|}
				|> KDL.of_string
				|> Result.get_ok
			in
			let node = ll @@ kdl.@(node "pijul" ~nth: 0) in
			match Result.bind node Manifest.Input'.codec.of_node with
			| Ok lc -> lc
			| Error err -> failwith Fmt.(str "%a from %a" (list ~sep: semi KDL.Valid.pp_err) err KDL.pp kdl)
		in
		let out_input =
			let name = Name.Name.make "pijul"
			and kind = `Pijul (Manifest.Pijul.make ~remote: (t "https://nest.pijul.com/pijul/pijul") ~reference: (`Channel "main") ())
			and hash = Manifest.Hash.make ()
			in
			Manifest.Input'.make ~name ~kind ~hash ~latest_cmd: None ~frozen: true ()
		in
		check input "frozen Pijul from KDL" out_input in_input
	);
	test_case "Manifest frozen Pijul sameshape" `Quick (fun () ->
		let input = testable Manifest.Input'.pp Manifest.Input'.equal in
		let t = Input.Template.make in
		let in_input =
			let name = Name.Name.make "pijul"
			and kind = `Pijul (Manifest.Pijul.make ~remote: (t "https://nest.pijul.com/pijul/pijul") ~reference: (`Channel "main") ())
			and hash = Manifest.Hash.make ()
			in
			Manifest.Input'.make ~name ~kind ~hash ~frozen: true ~latest_cmd: None ()
		in
		let out_input =
			in_input
			|> Manifest.Input'.codec.to_node
			|> Manifest.Input'.codec.of_node
			|> Result.get_ok
		in
		check input "Frozen Pijul KDL roundrip" out_input in_input
	);
	] @
		List.map QCheck_alcotest.to_alcotest [
			QCheck.Test.make
				~name: "Manifest input codec sameshape"
				(QCheck.make ~print: (Fmt.str "%a" Manifest.Input'.pp) Manifest.Input'.gen)
				(fun input ->
					let back_and_forth =
						input
						|> Manifest.Input'.codec.to_node
						|> Manifest.Input'.codec.of_node
					in
					match back_and_forth with
					| Ok input' when input' = input ->
						true
					| Ok input' ->
						QCheck.Test.fail_reportf
							"Aimed for:@,%a@.@.But got:@,%a@."
							Manifest.Input'.pp
							input
							Manifest.Input'.pp
							input'
					| Error err ->
						QCheck.Test.fail_reportf "%a" Fmt.(list ~sep: semi KDL.Valid.pp_err) err;
				);
			QCheck.Test.make
				~name: "Input sameshape"
				(QCheck.make ~print: (Fmt.str "%a" Input.pp) Input.gen)
				(fun input ->
					let manifest_input =
						Manifest.Input'.to_manifest input
					and lockfile_input =
						let models = Input.jg_models2 input in
						Lockfile.Input'.to_lock ~models input
					in
					let melded =
						meld_input_with_lock
							(Manifest.Input'.of_manifest manifest_input)
							lockfile_input
					in
					if melded = input then
						true
					else
						QCheck.Test.fail_reportf
							"Aimed for:@,%a@.@.But got:@,%a@."
							Input.pp
							input
							Input.pp
							melded
				);
		]