open Json

exception Prebuild_error of string

type parsed_warning = {
	w_name : string;
	w_doc : string;
	w_parent : string option;
	w_generic : bool;
	w_enabled : bool;
}

type parsed_meta = {
	m_name : string;
	m_meta : string;
	m_doc : string;
	m_params : string list;
	m_platforms : string list;
	m_targets : string list;
	m_internal : bool;
	m_links : string list;
}

let as_string = function
	| JString s -> Some s
	| _ -> None

let as_int = function
	| JInt i -> Some i
	| _ -> None

let as_params = function
	| JArray s -> Some (List.map (function
			| JString s -> s
			| _ -> raise (Prebuild_error "parameter description should be a string")
		) s)
	| _ -> None

let as_platforms = function
	| JArray s -> Some (List.map (function
			| JString "cross" -> "Cross"
			| JString "js" -> "Js"
			| JString "lua" -> "Lua"
			| JString "neko" -> "Neko"
			| JString "flash" -> "Flash"
			| JString "php" -> "Php"
			| JString "cpp" -> "Cpp"
			| JString "jvm" -> "Jvm"
			| JString "python" -> "Python"
			| JString "hl" -> "Hl"
			| JString "eval" -> "Eval"
			| _ -> raise (Prebuild_error "invalid platform")
		) s)
	| _ -> None

let as_targets = function
	| JArray s -> Some (List.map (function
			| JString "TClass" -> "TClass"
			| JString "TClassField" -> "TClassField"
			| JString "TAbstract" -> "TAbstract"
			| JString "TAbstractField" -> "TAbstractField"
			| JString "TEnum" -> "TEnum"
			| JString "TTypedef" -> "TTypedef"
			| JString "TAnyField" -> "TAnyField"
			| JString "TExpr" -> "TExpr"
			| JString "TTypeParameter" -> "TTypeParameter"
			| _ -> raise (Prebuild_error "invalid metadata target")
		) s)
	| _ -> None

let as_bool = function
	| JBool b -> Some b
	| _ -> None

let as_links = function
	| JArray s -> Some (List.map (function
			| JString s -> s
			| _ -> raise (Prebuild_error "link should be a string")
		) s)
	| _ -> None

let get_optional_field name map default fields =
	try
		let field = List.find (fun (n, _) -> n = name) fields in
		let value = map (snd field) in
		match value with
		| None -> raise (Prebuild_error ("field `" ^ name ^ "` has invalid data"))
		| Some v -> v
	with Not_found -> default

let get_optional_field2 name map fields =
	try
		let field = List.find (fun (n, _) -> n = name) fields in
		let value = map (snd field) in
		match value with
		| None -> raise (Prebuild_error ("field `" ^ name ^ "` has invalid data"))
		| Some v -> Some v
	with Not_found ->
		None

let get_field name map fields =
	let field = try List.find (fun (n, _) -> n = name) fields with Not_found -> raise (Prebuild_error ("no `" ^ name ^ "` field")) in
	let value = map (snd field) in
	match value with
	| None -> raise (Prebuild_error ("field `" ^ name ^ "` has invalid data"))
	| Some v -> v

type parsed_define = {
	d_name : string;
	d_define : string;
	d_doc : string;
	d_params : string list;
	d_platforms : string list;
	d_links: string list;
	d_deprecated : string option;
	d_deprecated_define : string option;
	d_default : string option;
	d_signature_neutral : bool option;
	d_reserved : bool option;
}
let parse_define json =
	let fields = match json with
		| JObject fl -> fl
		| _ -> raise (Prebuild_error "not an object")
	in
	{
		d_name = get_field "name" as_string fields;
		d_define = get_field "define" as_string fields;
		d_doc = get_field "doc" as_string fields;
		d_params = get_optional_field "params" as_params [] fields;
		d_platforms = get_optional_field "platforms" as_platforms [] fields;
		d_links = get_optional_field "links" as_links [] fields;
		d_deprecated = get_optional_field2 "deprecated" as_string fields;
		d_deprecated_define = get_optional_field2 "deprecatedDefine" as_string fields;
		d_default = get_optional_field2 "default" as_string fields;
		d_signature_neutral = get_optional_field2 "signatureNeutral" as_bool fields;
		d_reserved = get_optional_field2 "reserved" as_bool fields;
	}

let parse_meta json =
	let fields = match json with
		| JObject fl -> fl
		| _ -> raise (Prebuild_error "not an object")
	in
	{
		m_name = get_field "name" as_string fields;
		m_meta = get_field "metadata" as_string fields;
		m_doc = get_field "doc" as_string fields;
		m_params = get_optional_field "params" as_params [] fields;
		m_platforms = get_optional_field "platforms" as_platforms [] fields;
		m_targets = get_optional_field "targets" as_targets [] fields;
		m_internal = get_optional_field "internal" as_bool false fields;
		m_links = get_optional_field "links" as_links [] fields
	}

let parse_warning json =
	let fields = match json with
		| JObject fl -> fl
		| _ -> raise (Prebuild_error "not an object")
	in
	{
		w_name = get_field "name" as_string fields;
		w_doc = get_field "doc" as_string fields;
		w_parent = get_optional_field2 "parent" as_string fields;
		w_generic = get_optional_field "generic" as_bool false fields;
		w_enabled = get_optional_field "enabled" as_bool true fields;
	}

let parse_file_array path map =
	let file = open_in path in
	let data = Std.input_all file in
	let open Json.Reader in
	let lexbuf = Sedlexing.Utf8.from_string data in
	let json = read_json lexbuf in
	match json with
	| JArray s -> List.map map s
	| _ -> raise (Prebuild_error "not an array")

let s_escape ?(hex=true) s =
	let b = Buffer.create (String.length s) in
	for i = 0 to (String.length s) - 1 do
		match s.[i] with
		| '\n' -> Buffer.add_string b "\\n"
		| '\t' -> Buffer.add_string b "\\t"
		| '\r' -> Buffer.add_string b "\\r"
		| '"' -> Buffer.add_string b "\\\""
		| '\\' -> Buffer.add_string b "\\\\"
		| c when int_of_char c < 32 && hex -> Buffer.add_string b (Printf.sprintf "\\x%.2X" (int_of_char c))
		| c -> Buffer.add_char b c
	done;
	Buffer.contents b

let gen_platforms = function
	| [] -> []
	| platforms -> ["Platforms [" ^ (String.concat ";" platforms) ^ "]"]

let gen_params = List.map (function param -> "HasParam \"" ^ param ^ "\"" )

let gen_links = List.map (function link -> "Link \"" ^ link ^ "\"" )

let gen_define_type defines =
	String.concat "\n" (List.map (function def -> "\t| " ^ def.d_name) defines)

let gen_option f = function
	| None -> "None"
	| Some x -> Printf.sprintf "Some(%s)" (f x)

let gen_define_info defines =
	let deprecations = DynArray.create() in
	let default_values = DynArray.create() in
	let sig_neutral = DynArray.create() in
	let define_str = List.map (function
		def ->
			let platforms_str = gen_platforms def.d_platforms in
			let params_str = gen_params def.d_params in
			let links_str = gen_links def.d_links in
			let convert_define s = String.concat "_" (ExtString.String.nsplit s "-") in
			let define = convert_define def.d_define in
			let deprecated = match def.d_deprecated with
				| None ->
					begin match def.d_deprecated_define with
					| None ->
						()
					| Some s ->
						DynArray.add deprecations (Printf.sprintf "\t(%S,InFavorOf(%S));" (convert_define s) define)
					end;
					[]
				| Some x ->
					let quoted = Printf.sprintf "%S" x in
					DynArray.add deprecations (Printf.sprintf "\t(%S,DueTo(%S));" define x);
					[Printf.sprintf "Deprecated(%s)" quoted]
			in
			let default = match def.d_default with
				| None ->
					[]
				| Some x ->
					let quoted = Printf.sprintf "%S" x in
					DynArray.add default_values (Printf.sprintf "\t(%S,%S)" define x);
					[Printf.sprintf "DefaultValue(%s)" quoted]
			in
			let reserved = match def.d_reserved with
				| None ->
					[]
				| Some b ->
					[Printf.sprintf "Reserved(%b)" b]
			in
			(match def.d_signature_neutral with
				| Some true ->
					DynArray.add sig_neutral (Printf.sprintf "| %S" (convert_define define));
					begin match def.d_deprecated_define with
					| None -> ()
					| Some s -> DynArray.add sig_neutral (Printf.sprintf "| %S" (convert_define s))
					end
				| _ -> ());
			"\t| " ^ def.d_name ^ " -> \"" ^ define ^ "\",(" ^ (Printf.sprintf "%S" def.d_doc) ^ ",[" ^ (String.concat "; " (platforms_str @ params_str @ links_str @ deprecated @ default @ reserved )) ^ "])"
	) defines in
	(
		String.concat "\n" define_str,
		String.concat "\n" (DynArray.to_list deprecations),
		String.concat ";\n" (DynArray.to_list default_values),
		String.concat " " (DynArray.to_list sig_neutral)
	)

let gen_meta_type metas =
	String.concat "\n" (List.map (function
		| {m_name = "InlineConstructorArgument"} -> "\t| InlineConstructorArgument of int * int"
		| {m_name = name} -> "\t| " ^ name
	) metas)

let gen_meta_info metas =
	let meta_str = List.map (function meta ->
			let platforms_str = gen_platforms meta.m_platforms in
			let params_str = gen_params meta.m_params in
			let targets_str = (match meta.m_targets with
				| [] -> []
				| targets -> ["UsedOn [" ^ (String.concat ";" targets) ^ "]"]
			) in
			let internal_str = if meta.m_internal then ["UsedInternally"] else [] in
			let links_str = gen_links meta.m_links in
			let name = (match meta.m_name with
				(* this is a hacky, I know *)
				| "InlineConstructorArgument" -> "InlineConstructorArgument _"
				| _ -> meta.m_name
			) in
			"\t| " ^ name ^ " -> \"" ^ meta.m_meta ^ "\",(" ^ (Printf.sprintf "%S" meta.m_doc) ^ ",[" ^ (String.concat "; " (platforms_str @ params_str @ targets_str @ internal_str @ links_str)) ^ "])"
	) metas in
	String.concat "\n" meta_str

let gen_warning_type warnings =
	let warning_str = List.map (function
		w ->
			Printf.sprintf "\t| %s" w.w_name
	) warnings in
	String.concat "\n" warning_str

let gen_warning_parse warnings =
	let warning_str = List.map (function
		w ->
			Printf.sprintf "\t| \"%s\" -> %s" w.w_name w.w_name
	) warnings in
	let warning_str = warning_str @ ["\t| _ -> raise Exit"] in
	String.concat "\n" warning_str


let gen_warning_obj warnings =
	let warning_str = List.map (fun w ->
		let w_parent = match w.w_parent with
			| None -> if w.w_name = "WAll" then "None" else "Some WAll"
			| Some w -> Printf.sprintf "Some %s" w
		in
		Printf.sprintf "\t| %s -> {w_name = \"%s\"; w_doc = \"%s\"; w_generic = %b; w_parent = %s}" w.w_name w.w_name (s_escape w.w_doc) w.w_generic w_parent
	) warnings in
	String.concat "\n" warning_str

let gen_disabled_warnings warnings =
	let warning_str = ExtList.List.filter_map (fun w ->
		if w.w_enabled then
			None
		else
			Some w.w_name
	) warnings in
	String.concat ";" warning_str

let autogen_header = "(* This file is auto-generated using prebuild from files in src-json *)
(* Do not edit manually! *)
"

let define_header = autogen_header ^ "
open Globals

type define_parameter =
	| HasParam of string
	| Platforms of platform list
	| Link of string
	| Deprecated of string
	| DefaultValue of string
	| Reserved of bool

type define_deprecation =
	| DueTo of string
	| InFavorOf of string

"

let meta_header = autogen_header ^ "
open Globals

type meta_usage =
	| TClass
	| TClassField
	| TAbstract
	| TAbstractField
	| TEnum
	| TTypedef
	| TAnyField
	| TExpr
	| TTypeParameter
	| TVariable

let parse_meta_usage = function
	| \"TClass\" -> TClass
	| \"TClassField\" -> TClassField
	| \"TAbstract\" -> TAbstract
	| \"TAbstractField\" -> TAbstractField
	| \"TEnum\" -> TEnum
	| \"TTypedef\" -> TTypedef
	| \"TAnyField\" -> TAnyField
	| \"TExpr\" -> TExpr
	| \"TTypeParameter\" -> TTypeParameter
	| \"TVariable\" -> TVariable
	| t -> raise (failwith (\"invalid metadata target \" ^ t))

let print_meta_usage = function
	| TClass -> \"TClass\"
	| TClassField -> \"TClassField\"
	| TAbstract -> \"TAbstract\"
	| TAbstractField -> \"TAbstractField\"
	| TEnum -> \"TEnum\"
	| TTypedef -> \"TTypedef\"
	| TAnyField -> \"TAnyField\"
	| TExpr -> \"TExpr\"
	| TTypeParameter -> \"TTypeParameter\"
	| TVariable -> \"TVariable\"

type meta_parameter =
	| HasParam of string
	| Platforms of platform list
	| UsedOn of meta_usage list
	| UsedInternally
	| Link of string

"

;;

match Array.to_list (Sys.argv) with
	| [_; "define"; define_path]->
		let defines = parse_file_array define_path parse_define in
		Printf.printf "%s" define_header;
		Printf.printf "type strict_defined =\n";
		Printf.printf "%s" (gen_define_type defines);
		Printf.printf "\n\t| Last\n\t| Custom of string\n\n";
		let infos,deprecations,default_values,sig_neutral = gen_define_info defines in
		Printf.printf "let infos = function\n";
		Printf.printf "%s" infos;
		Printf.printf "\n\t| Last -> die \"\" __LOC__\n\t| Custom s -> s,(\"\",[])\n";
		if sig_neutral = "" then
			Printf.printf "let is_signature_neutral _ = false\n"
		else begin
			Printf.printf "let is_signature_neutral = function\n";
			Printf.printf "\t%s -> true\n\t| _ -> false\n" sig_neutral;
		end;
		Printf.printf "\nlet deprecated_defines = [\n%s\n]\n" deprecations;
		Printf.printf "\nlet default_values = [\n%s\n]\n" default_values;
	| [_; "meta"; meta_path]->
		let metas = parse_file_array meta_path parse_meta in
		Printf.printf "%s" meta_header;
		Printf.printf "type strict_meta =\n";
		Printf.printf "%s" (gen_meta_type metas);
		Printf.printf "\n\t| Last\n\t| Dollar of string\n\t| Custom of string\n\n";
		Printf.printf "let get_info = function\n";
		Printf.printf "%s" (gen_meta_info metas);
		Printf.printf "\n\t| Last -> die \"\" __LOC__\n\t| Dollar s -> \"$\" ^ s,(\"\",[])\n\t| Custom s -> s,(\"\",[])\n"
	| [_; "warning"; warning_path]->
		let warnings = parse_file_array warning_path parse_warning in
		print_endline "type warning =";
		print_endline (gen_warning_type warnings);
		print_endline "";
		print_endline "type warning_obj = {";
		print_endline "\tw_name : string;";
		print_endline "\tw_doc : string;";
		print_endline "\tw_generic : bool;";
		print_endline "\tw_parent : warning option;";
		print_endline "}";
		print_endline "";
		print_endline "let warning_obj = function";
		print_endline (gen_warning_obj warnings);
		print_endline ";;";
		print_endline "let disabled_warnings = [";
		print_endline (gen_disabled_warnings warnings);
		print_endline "];;";
		print_endline "";
		print_endline "let from_string = function";
		print_endline (gen_warning_parse warnings);
	| [_; "libparams"; os] ->
		Printf.printf "(";
		(begin match Sys.getenv_opt "LIB_PARAMS" with
		| Some params ->
			Printf.printf "%s" params;
		| None ->
			if Sys.win32 then
				Printf.printf "-cclib -lpcre2-8 -cclib -lz -cclib -lcrypt32 -cclib -lmbedtls -cclib -lmbedcrypto -cclib -lmbedx509"
			else
				if Option.is_some (Sys.getenv_opt "STATICLINK") && os <> "macosx" then
					Printf.printf "-cclib \"-Wl,-Bstatic -lpcre2-8 -lz -lmbedtls -lmbedx509 -lmbedcrypto -Wl,-Bdynamic \""
				else
					Printf.printf "-cclib -lpcre2-8 -cclib -lz -cclib -lmbedtls -cclib -lmbedx509 -cclib -lmbedcrypto";
		end);
		if os = "macosx" then Printf.printf " -cclib \"-framework Security -framework CoreFoundation\"";
		Printf.printf ")";
	| [_ ;"version";] ->
		begin match Sys.getenv_opt "ADD_REVISION" with
		| Some "0" | Some "" | None ->
			print_endline "let version_extra = None"
		| _ ->
			let branch = Stdlib.input_line (Unix.open_process_in "git rev-parse --abbrev-ref HEAD") in
			let sha = Stdlib.input_line (Unix.open_process_in "git rev-parse --short HEAD") in
			Printf.printf "let version_extra = Some (\"git build %s\",\"%s\")" branch sha
		end
	| args ->
		print_endline (String.concat ", " args)
