path: root/lib/manifest.ml

(*─────────────────────────────────────────────────────────────────────────────┐
│ SPDX-FileCopyrightText: 2025 toastal <https://toast.al/contact/>             │
│ SPDX-License-Identifier: LGPL-2.1-or-later WITH OCaml-LGPL-linking-exception │
└─────────────────────────────────────────────────────────────────────────────*)
open Name

type error = Error.manifest_error

(* TODO: modify the KDL tree in-place to preserve comments… this is probably a
	hefty refactor since I would possibly need to drop the codec type for
	Kdl.lens (tho the concepts of “lens” & “codec” are similar) *)
let filename = "manifest.kdl"

let default_hash_algorithm : Input.Hash.algorithm option ref = ref None

module Template = struct
	include Input.Template

	let to_arg ?annot tpl =
		KDL.arg ?annot (`String (take tpl))

	let of_child ~name kdl =
		let open KDL.L in
		let open KDL.Valid in
		ll @@ Result.map make (kdl.@(child name // arg 0 // string_value))

	let of_mirrors kdl =
		let open KDL.L in
		let open KDL.Valid in
		ll @@
			match kdl.@(child "mirrors" // args // each string_value) with
			| Ok ms -> Ok (List.map make ms)
			| Error (`Not_found ("mirrors", _)) -> Ok []
			| Error err -> Error err
end

module File = struct
	type t = {
		url: Template.t;
		mirrors: Template.t list;
	}
	[@@deriving show, eq, make, qcheck]

	let [@inline]to_manifest ({url; mirrors; _}: Input.File.t) : t =
		make ~url ~mirrors ()

	let [@inline]of_manifest ({url; mirrors}: t) : Input.File.t =
		Input.File.make ~url ~mirrors ()

	let codec : t KDL.codec = {
		to_kdl = (fun file ->
			let open KDL in
			let nodes =
				if List.is_empty file.mirrors then
						[]
				else
						[node "mirrors" ~args: (List.map Template.to_arg file.mirrors) []]
			in
			let nodes =
				node "url" ~args: [Template.to_arg file.url] [] :: nodes
			in
				[node "file" nodes]
		);
		of_kdl = (fun kdl ->
			let open KDL.L in
			let open KDL.Valid in
			let* file = ll @@ kdl.@(node "file") in
			let+ url = Template.of_child ~name: "url" file
			and+ mirrors = Template.of_mirrors file
			in
				{url; mirrors}
		);
	}
end

module Archive = struct
	type t = {
		url: Template.t;
		mirrors: Template.t list;
	}
	[@@deriving show, eq, make, qcheck]

	let [@inline]to_manifest ({url; mirrors; _}: Input.Archive.t) : t =
		make ~url ~mirrors ()

	let [@inline]of_manifest ({url; mirrors}: t) : Input.Archive.t =
		Input.Archive.make ~url ~mirrors ()

	let codec : t KDL.codec = {
		to_kdl = (fun archive ->
			let open KDL in
			let url =
				node "url" ~args: [Template.to_arg archive.url] [];
			and nodes =
				if List.is_empty archive.mirrors then
						[]
				else
						[node "mirrors" ~args: (List.map Template.to_arg archive.mirrors) []]
			in
			let nodes = url :: nodes in
				[node "archive" nodes]
		);
		of_kdl = (fun kdl ->
			let open KDL.L in
			let open KDL.Valid in
			let* archive = ll @@ kdl.@(node "archive") in
			let+ url = Template.of_child ~name: "url" archive
			and+ mirrors = Template.of_mirrors archive
			in
				{url; mirrors}
		);
	}
end

module Git = struct
	module Reference = struct
		type t = Input.Git.Reference.t
		[@@deriving show, eq, qcheck]

		let codec : t KDL.codec = {
			to_kdl = (fun ref ->
				let open KDL in
				match ref with
				| `Branch b -> [KDL.node "branch" ~args: [arg (`String b)] []]
				| `Ref r -> [KDL.node "ref" ~args: [arg (`String r)] []]
			);
			of_kdl = (fun kdl ->
				let open KDL.L in
				let open KDL.Valid in
				let node_names = ["branch"; "ref"]
				and branch = ll @@ kdl.@(node "branch" // arg 0 // string_value)
				and ref = ll @@ kdl.@(node "ref" // arg 0 // string_value)
				in
				match branch, ref with
				| Ok b, Error _ -> Ok (`Branch b)
				| Error _, Ok r -> Ok (`Ref r)
				| Error _, Error _ -> Error [`OneRequired node_names]
				| _, _ -> Error [`OnlyOneOf node_names]
			);
		}
	end

	type t = {
		repository: Template.t;
		mirrors: Template.t list;
		reference: Reference.t;
		submodules: bool; [@default false]
		lfs: bool; [@default false]
	}
	[@@deriving show, eq, make, qcheck]

	let [@inline]to_manifest ({repository; mirrors; reference; submodules; lfs; _}: Input.Git.t) : t =
		make ~repository ~mirrors ~reference ~submodules ~lfs ()

	let [@inline]of_manifest ({repository; mirrors; reference; submodules; lfs}: t) : Input.Git.t =
		Input.Git.make ~repository ~mirrors ~reference ~submodules ~lfs ()

	let codec : t KDL.codec<