(*─────────────────────────────────────────────────────────────────────────────┐
│ 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 = {
		to_kdl = (fun git ->
			let open KDL in
			let repository =
				node "repository" ~args: [Template.to_arg git.repository] []
			and nodes =
				if git.lfs then [node "lfs" []] else []
			in
			let nodes =
				if git.submodules then node "submodules" [] :: nodes else nodes
			in
			let nodes =
				match git.reference with
				| `Branch b -> node "branch" ~args: [arg (`String b)] [] :: nodes
				| `Ref r -> node "ref" ~args: [arg (`String r)] [] :: nodes
			in
			let nodes =
				if List.is_empty git.mirrors then
					nodes
				else
					node "mirrors" ~args: (List.map Template.to_arg git.mirrors) [] :: nodes
			in
			let nodes = repository :: nodes in
				[node "git" nodes]
		);
		of_kdl = (fun kdl ->
			let open KDL.L in
			let open KDL.Valid in
			let* git = ll @@ kdl.@(node "git") in
			let+ repository = Template.of_child ~name: "repository" git
			and+ mirrors = Template.of_mirrors git
			and+ reference = Reference.codec.of_kdl git.children
			and+ submodules =
				ll @@
					match git.@(child "submodules") with
					| Ok sms ->
						begin
							match sms.@(arg 0 // bool_value) with
							| Ok smb -> Ok smb
							| Error (`Missing_index 0) -> Ok true
							| Error err -> Error err
						end
					| Error (`Not_found ("submodules", _)) -> Ok false
					| Error err -> Error err
			and+ lfs =
				ll @@
					match git.@(child "lfs") with
					| Ok sms ->
						begin
							match sms.@(arg 0 // bool_value) with
							| Ok smb -> Ok smb
							| Error (`Missing_index 0) -> Ok true
							| Error err -> Error err
						end
					| Error (`Not_found ("lfs", _)) -> Ok false
					| Error err -> Error err
			in
				{repository; mirrors; reference; submodules; lfs}
		);
	}
end

module Darcs = struct
	module Reference = struct
		type context_grounds = [
			| `Assumed of UTF8.t option
			| `Stated of UTF8.t
		]
		[@@deriving show, eq]

		let gen_context_grounds =
			let open QCheck.Gen in
			oneof [
				return (`Assumed None);
				map (fun s -> `Stated s) UTF8.gen;
			]

		type t = [
			| `Context of context_grounds
			| `Tag of UTF8.t
		]
		[@@deriving show, eq, qcheck]

		let codec : t KDL.codec = {
			to_kdl = (fun ref ->
				let open KDL in
				match ref with
				| `Context (`Stated sc) -> [KDL.node "context" ~args: [arg (`String sc)] []]
				| `Context (`Assumed _) -> []
				| `Tag t -> [KDL.node "tag" ~args: [arg (`String t)] []]
			);
			of_kdl = (fun kdl ->
				let open KDL.L in
				let open KDL.Valid in
				let node_names = ["tag"; "context"]
				and context = ll @@ kdl.@(node "context" // arg 0 // string_value)
				and tag = ll @@ kdl.@(node "tag" // arg 0 // string_value)
				in
				match context, tag with
				| Ok c, Error _ -> Ok (`Context (`Stated c))
				| Error _, Ok t -> Ok (`Tag t)
				| Error _, Error _ -> Ok (`Context (`Assumed None))
				| _, _ -> Error [`OnlyOneOf node_names]
			);
		}
	end

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

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

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

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

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

		let codec : t KDL.codec = {
			to_kdl = (fun ref ->
				let open KDL in
				match ref with
				| `Channel c -> [KDL.node "channel" ~args: [arg (`String c)] []]
				| `State s -> [KDL.node "state" ~args: [arg (`String s)] []]
				| `Change c -> [KDL.node "change" ~args: [arg (`String c)] []]
			);
			of_kdl = (fun kdl ->
				let open KDL.L in
				let open KDL.Valid in
				let node_names = ["channel"; "state"; "change"]
				and channel = ll @@ kdl.@(node "channel" // arg 0 // string_value)
				and state = ll @@ kdl.@(node "state" // arg 0 // string_value)
				and change = ll @@ kdl.@(node "change" // arg 0 // string_value)
				in
				match channel, state, change with
				| Ok c, Error _, Error _ -> Ok (`Channel c)
				| Error _, Ok s, Error _ -> Ok (`State s)
				| Error _, Error _, Ok c -> Ok (`Change c)
				| Error _, Error _, Error _ -> Error [`OneRequired node_names]
				| _, _, _ -> Error [`OnlyOneOf node_names]
			);
		}
	end

	type t = {
		remote: Template.t;
		mirrors: Template.t list;
		reference: Reference.t;
	}
	[@@deriving show, eq, make, qcheck]

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

	let [@inline]of_manifest ({remote; mirrors; reference}: t) : Input.Pijul.t =
		Input.Pijul.make ~remote ~mirrors ~reference ()

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

module Nilla = struct
	module Reference = struct
		type t = Input.Nilla.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;
		path: Template.t;
	}
	[@@deriving show, eq, make, qcheck]

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

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

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

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

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

	type t = {
		repository: Template.t;
		reference: Reference.t;
	}
	[@@deriving show, eq, make, qcheck]

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

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

	let codec : t KDL.codec = {
		to_kdl = (fun fossil ->
			let open KDL in
			let repository =
				node "repository" ~args: [Template.to_arg fossil.repository] []
			and nodes =
				Reference.codec.to_kdl fossil.reference
			in
			let nodes = repository :: nodes in
				[node "fossil" nodes]
		);
		of_kdl = (fun kdl ->
			let open KDL.L in
			let open KDL.Valid in
			let* fossil = ll @@ kdl.@(node "fossil") in
			let+ repository = Template.of_child ~name: "repository" fossil
			and+ reference = Reference.codec.of_kdl fossil.children
			in
				{repository; reference}
		);
	}
end

module Kind = struct
	type t = [
		| `File of File.t
		| `Archive of Archive.t
		| `Git of Git.t
		| `Darcs of Darcs.t
		| `Pijul of Pijul.t
		| `Nilla of Nilla.t
		| `Fossil of Fossil.t
	]
	[@@deriving show, eq, qcheck]

	let to_manifest : Input.Kind.t -> t = function
		| `File f -> `File (File.to_manifest f)
		| `Archive a -> `Archive (Archive.to_manifest a)
		| `Git g -> `Git (Git.to_manifest g)
		| `Darcs d -> `Darcs (Darcs.to_manifest d)
		| `Pijul p -> `Pijul (Pijul.to_manifest p)
		| `Nilla n -> `Nilla (Nilla.to_manifest n)
		| `Fossil f -> `Fossil (Fossil.to_manifest f)

	let of_manifest : t -> Input.Kind.t = function
		| `File f -> `File (File.of_manifest f)
		| `Archive a -> `Archive (Archive.of_manifest a)
		| `Git g -> `Git (Git.of_manifest g)
		| `Darcs d -> `Darcs (Darcs.of_manifest d)
		| `Pijul p -> `Pijul (Pijul.of_manifest p)
		| `Nilla n -> `Nilla (Nilla.of_manifest n)
		| `Fossil f -> `Fossil (Fossil.of_manifest f)

	let codec : t KDL.codec = {
		to_kdl = (function
			| `File f -> File.codec.to_kdl f
			| `Archive a -> Archive.codec.to_kdl a
			| `Git g -> Git.codec.to_kdl g
			| `Darcs d -> Darcs.codec.to_kdl d
			| `Pijul p -> Pijul.codec.to_kdl p
			| `Nilla n -> Nilla.codec.to_kdl n
			| `Fossil f -> Fossil.codec.to_kdl f
		);
		of_kdl = (fun kdl ->
			let kind_names = ["file"; "archive"; "git"; "darcs"; "pijul"; "nilla"; "fossil"] in
			match File.codec.of_kdl kdl,
			Archive.codec.of_kdl kdl,
			Git.codec.of_kdl kdl,
			Darcs.codec.of_kdl kdl,
			Pijul.codec.of_kdl kdl,
			Nilla.codec.of_kdl kdl,
			Fossil.codec.of_kdl kdl with
			| Ok file, Error _, Error _, Error _, Error _, Error _, Error _ ->
				Ok (`File file)
			| Error _, Ok archive, Error _, Error _, Error _, Error _, Error _ ->
				Ok (`Archive archive)
			| Error _, Error _, Ok git, Error _, Error _, Error _, Error _ ->
				Ok (`Git git)
			| Error _, Error _, Error _, Ok darcs, Error _, Error _, Error _ ->
				Ok (`Darcs darcs)
			| Error _, Error _, Error _, Error _, Ok pijul, Error _, Error _ ->
				Ok (`Pijul pijul)
			| Error _, Error _, Error _, Error _, Error _, Ok nilla, Error _ ->
				Ok (`Nilla nilla)
			| Error _, Error _, Error _, Error _, Error _, Error _, Ok fossil ->
				Ok (`Fossil fossil)
			| Error _, Error _, Error _, Error _, Error _, Error _, Error _ ->
				Error [`OneRequired kind_names]
			| _, _, _, _, _, _, _ ->
				Error [`OnlyOneOf kind_names]
		);
	}
end

module Hash = struct
	type t = {
		algorithm: Input.Hash.algorithm; [@default Input.Hash.default_algorithm]
		expected: UTF8.t option;
	}
	[@@deriving show, eq, make, qcheck]

	let [@inline]to_manifest ({algorithm; expected; _}: Input.Hash.t) : t =
		make ~algorithm ?expected ()

	let [@inline]of_manifest ({algorithm; expected}: t) : Input.Hash.t =
		Input.Hash.make ~algorithm ?expected ()

	let codec : t KDL.codec = {
		to_kdl = (fun hash ->
			let open KDL in
			let props =
				match hash.expected with
				| None -> []
				| Some exp_hash ->
					["expected", (None, `String exp_hash)]
			in
			let props =
				let algo_str = Input.Hash.algorithm_to_string hash.algorithm in
				("algorithm", (None, `String algo_str)) :: props
			in
				[node "hash" ~props []]
		);
		of_kdl = (fun kdl ->
			let open KDL.L in
			let open KDL.Valid in
			let* hash = ll @@ kdl.@(node "hash") in
			let+ algorithm : Input.Hash.algorithm option =
				match hash.@(prop "algorithm") with
				| Ok algo ->
					begin
						let* algo_val = ll @@ algo.@(string_value) in
						match Input.Hash.algorithm_of_string algo_val with
						| Some av -> Ok (Some av)
						| None ->
							let len : int = Input.Hash.max_algorithm - Input.Hash.min_algorithm + 1
							and algo_str (i : int) : UTF8.t =
								i + Input.Hash.min_algorithm
								|> Input.Hash.algorithm_of_enum
								|> Option.get
								|> Input.Hash.algorithm_to_string
							in
							let algo_str_list : UTF8.t list = List.init len algo_str in
							Logs.err (fun m ->
								m
									"Got hash algorithm “%s”, but exepected one of %a"
									algo_val
									Fmt.(brackets (list ~sep: semi string))
									algo_str_list
							);
							Error [`OneRequired algo_str_list]
					end
				| Error (`Missing_prop "algorithm") -> ll @@ Ok !default_hash_algorithm
				| Error err -> ll @@ Error err

			and+ expected : UTF8.t option =
				ll @@
					match hash.@(prop "expected") with
					| Ok exp -> map Option.some @@ exp.@(string_value)
					| Error (`Missing_prop "expected") -> Ok None
					| Error err -> Error err
			in
			make ?algorithm ?expected ()
		);
	}
end

module Latest_cmd = struct
	type t = Input.Latest.Cmd.t option
	[@@deriving show, eq, qcheck]

	let [@inline]to_manifest (latest : Input.Latest.t) : t =
		latest.cmd

	let [@inline]of_manifest (cmd : t) : Input.Latest.t =
		Input.Latest.make ?cmd ()

	let codec : t KDL.codec = {
		to_kdl = (function
			| None -> []
			| Some (exec, pipes) ->
				let open KDL in
				let cmd_args ({prog; args}: Input.Latest.Cmd.cmd) =
					List.map (Template.to_arg) (prog :: args)
				in
				let nodes =
					List.map (fun pcmd -> node "|" ~args: (cmd_args pcmd) []) pipes
				in
				let nodes =
					node "$" ~args: (cmd_args exec) [] :: nodes
				in
					[node "latest-cmd" nodes]
		);
		of_kdl = (fun kdl ->
			let open KDL.L in
			let open KDL.Valid in
			let extract_cmd (node : KDL.node) : Input.Latest.Cmd.cmd KDL.Valid.t =
				if List.is_empty node.props then
					match Util.Non_empty_list.of_list node.args with
					| Some (arg_prog, arg_args) ->
						begin
							match arg_prog.@(string_value), arg_args.@(each string_value) with
							| Error _err, _ -> Error [`InvalidLatestCmd "Bad program specified for command"]
							| _, Error _err -> Error [`InvalidLatestCmd "Bad arguments specified for command"]
							| Ok prog, Ok args ->
								Ok {
									prog = Template.make prog;
									args = List.map Template.make args;
								}
						end
					| None -> Error [`InvalidLatestCmd "Empty command"]
				else
					Error [`InvalidLatestCmd "Props aren’t supported (yet?); you probably meant to add straight quotation marks (for example “\"--foo=bar\"”)."]
			in
			let rec extract_all_cmds acc = function
				| [] -> acc
				| cmd_list :: cmds_list ->
					let acc' =
						match acc, extract_cmd cmd_list with
						| Error errs, Ok _ -> Error errs
						| Ok _, Error errs -> Error errs
						| Ok ok_acc, Ok cmd -> Ok (ok_acc @ [cmd])
						| Error errs, Error errs' -> Error (errs @ errs')
					in
					extract_all_cmds acc' cmds_list
			in
			match ll @@ kdl.@(node "latest-cmd") with
			| Error [`Not_found ("latest-cmd", _)] -> Ok None
			| Error err -> Error err
			| Ok latest_cmd ->
				let+ exec : Input.Latest.Cmd.cmd =
					let* exec' = ll @@ latest_cmd.@(child ~nth: 0 "$") in
					extract_cmd exec'
				and+ pipes : Input.Latest.Cmd.cmd list =
					match ll @@ latest_cmd.@(child_many "|") with
					| Ok ps -> extract_all_cmds (Ok []) ps
					| Error [`Not_found ("|", _)] -> Ok []
					| Error err -> Error err
				in
				let cmd : Input.Latest.Cmd.t = (exec, pipes) in
				Some cmd
		);
	}
end

module Input' = struct
	type t = {
		name: Name.t;
		kind: Kind.t;
		latest_cmd: Latest_cmd.t;
		hash: Hash.t;
		frozen: bool; [@default false]
	}
	[@@deriving show, eq, make, qcheck]

	let [@inline]to_manifest (input : Input.t) : t = {
		name = input.name;
		kind = Kind.to_manifest input.kind;
		latest_cmd = Latest_cmd.to_manifest input.latest;
		hash = Hash.to_manifest input.hash;
		frozen = input.frozen;
	}

	let [@inline]of_manifest (mnfst : t) : Input.t = {
		name = mnfst.name;
		kind = Kind.of_manifest mnfst.kind;
		latest = Latest_cmd.of_manifest mnfst.latest_cmd;
		hash = Hash.of_manifest mnfst.hash;
		frozen = mnfst.frozen;
	}

	let codec : t KDL.node_codec = {
		to_node = (fun input ->
			let open KDL in
			let props =
				if input.frozen then
						[("frozen", arg (`Bool true))]
				else
						[]
			and kind = Kind.codec.to_kdl input.kind
			and hash = Hash.codec.to_kdl input.hash
			and latest_cmd = Latest_cmd.codec.to_kdl input.latest_cmd
			in
			let nodes = kind @ hash @ latest_cmd in
			node (Name.take input.name) ~props nodes
		);
		of_node = (fun input ->
			let open KDL.L in
			let open KDL.Valid in
			let+ name =
				ll @@ input.@(node_name)
				|> Result.map Name.make
			and+ latest_cmd =
				Latest_cmd.codec.of_kdl input.children
			and+ hash =
				match Hash.codec.of_kdl input.children with
				| Ok h ->
					Ok h
				| Error [`Not_found ("hash", _)] ->
					Ok (Hash.make ?algorithm: !default_hash_algorithm ())
				| Error errs ->
					Error errs
			and+ kind =
				Kind.codec.of_kdl input.children
			and+ frozen =
				ll @@
					match input.@(prop "frozen") with
					| Ok f -> f.@(bool_value)
					| Error`Missing_prop "frozen" -> Ok false
					| Error err -> Error err
			in
				{name; kind; latest_cmd; hash; frozen}
		);
	}
end

type t = {
	version: UTF8.t;
	inputs: Input'.t list;
}
[@@deriving show, eq, make, qcheck]

let document_to_t (doc : KDL.t) : t KDL.Valid.t =
	let open KDL.L in
	let open KDL.Valid in
	let* manifest_default_hash_algorithm : Input.Hash.algorithm option =
		match ll @@ doc.@(node "default_hash_algorithm" // arg 0 // string_value) with
		| Ok dha ->
			begin
				match Input.Hash.algorithm_of_string dha with
				| Some ha -> Ok (Some ha)
				| None -> Error [`InvalidHashAlgorithm dha]
			end
		| Error (`Not_found ("default_hash_algorithm", _) :: []) ->
			Ok None
		| Error errs ->
			Error errs
	in
	let () = default_hash_algorithm := manifest_default_hash_algorithm in
	let+ version : UTF8.t =
		ll @@ doc.@(node "version" // arg 0 // string_value)
	and+ inputs : Input'.t list =
		(* TODO: a lens would mean this could use `each` *)
		let rec get_inputs acc = function
			| [] -> acc
			| (input : KDL.node) :: inputs_tail ->
				let acc' =
					match acc, Input'.codec.of_node input with
					| Error errs, Ok _ -> Error errs
					| Ok _, Error errs -> Error errs
					| Ok ok_acc, Ok src -> Ok (ok_acc @ [src])
					| Error errs, Error errs' -> Error (errs @ errs')
				in
				get_inputs acc' inputs_tail
		in
		Result.bind
			(ll @@ doc.@(node "inputs" // children))
			(get_inputs (Ok []))
	in
	make ~version ~inputs ()

let manifest : KDL.t option ref = ref None

let exists () : bool =
	let working_dir = Working_directory.get () in
	let filepath = Eio.Path.(working_dir / filename) in
	Eio.Path.is_file filepath

let read () =
	let working_dir = Working_directory.get () in
	let filepath = Eio.Path.(working_dir / filename) in
	Logs.info (fun m -> m "Reading manifest @@ %a …" Eio.Path.pp filepath);
	match Eio.Path.with_open_in filepath KDL.of_flow with
	| Error (`ParseError msg) -> Error (`Parsing [`ParseError msg])
	| Ok kdl ->
		let () = manifest := Some kdl in
		Ok kdl

let make ?(version = "0.1.1") () =
	Logs.app (fun m -> m "Making manifest file @@ version:%s" version);
	let open KDL in
	let doc = [
		node "version" ~args: [arg (`String version)] [];
		node "inputs" (
			Input_foreman.to_manifest (fun s ->
				let open Input' in
					[codec.to_node (to_manifest s)]
			)
		);
	]
	in
	Logs.debug (fun m -> m "New KDL doc:@;%a@." KDL.pp doc);
	manifest := Some doc

let write () : (unit, error) result =
	let (let*) = Result.bind in
	let working_dir = Working_directory.get () in
	let filepath = Eio.Path.(working_dir / filename) in
	let* mnfst =
		match !manifest with
		| Some m -> Ok m
		| None -> Error `Not_set_up
	in
	Logs.info (fun m -> m "Writing manifest @@ %s …" filename);
	let result =
		Eio.Path.with_open_out ~create: (`Exclusive 0o644) filepath @@ fun flow ->
		let banner = [
			Cstruct.of_string "// ┏┓╻+╻ ╱┏┳┓┏┓┏┳┓┏┓╻\n";
			Cstruct.of_string "// ┃┃┃┃┗━┓╹┃╹┣┫┃┃┃┣┫┃   Read the manpage:\n";
			Cstruct.of_string "// ╹┗┛╹╱ ╹ ╹ ╹╹╹ ╹╹╹┗┛  $ man nixtamal-manifest\n";
		]
		in
		Eio.Flow.write flow banner;
		KDL.to_flow flow mnfst;
		Eio.Flow.write flow ([Cstruct.of_string "\n"])
	in
	Logs.info (fun m -> m "Manifest written.");
	Ok result