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 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212
|
open Filepath
open Helper
open Gconf
exception GeneratorFailed of string
exception GeneratorNotFound of string
(** Internal generator representation for build system integration *)
type t = {
suffix : string;
modname : (Modname.t -> Modname.t);
commands : (filepath -> filepath -> string -> string list list);
generated_files : (filename -> string -> filename);
}
(** Custom generator definition from .obuild file *)
type custom = {
custom_name : string; (** Generator name for reference *)
custom_suffix : string option; (** File extension for automatic detection *)
custom_command : string; (** Command template with variables *)
custom_outputs : string list; (** Output file patterns *)
custom_module_name : string option; (** Module name pattern if different from base *)
}
(** Custom generators registered from project file *)
let custom_generators : custom list ref = ref []
(** Find substring in string, returns index or raises Not_found *)
let find_substring str sub =
let len = String.length str in
let sublen = String.length sub in
if sublen = 0 then 0
else if sublen > len then raise Not_found
else
let rec search i =
if i + sublen > len then raise Not_found
else if String.sub str i sublen = sub then i
else search (i + 1)
in
search 0
(** Substitute variables in a string
Variables supported:
- ${src} : Full path to source file
- ${dest} : Destination path without extension
- ${base} : Base filename without extension
- ${srcdir} : Source directory
- ${destdir} : Destination directory
- ${sources} : Space-separated list of all input files (for multi-input)
*)
let substitute_variables ~src ~dest ~sources str =
let src_str = fp_to_string src in
let dest_str = fp_to_string dest in
let base = fn_to_string (chop_extension (path_basename src)) in
let srcdir = fp_to_string (path_dirname src) in
let destdir = fp_to_string (path_dirname dest) in
let sources_str = String.concat " " (List.map fp_to_string sources) in
let replacements = [
("${src}", src_str);
("${dest}", dest_str);
("${base}", base);
("${srcdir}", srcdir);
("${destdir}", destdir);
("${sources}", sources_str);
] in
List.fold_left (fun s (var, value) ->
let rec replace_all str =
try
let i = find_substring str var in
let before = String.sub str 0 i in
let after = String.sub str (i + String.length var) (String.length str - i - String.length var) in
replace_all (before ^ value ^ after)
with Not_found -> str
in
replace_all s
) str replacements
(** Substitute variables in output pattern *)
let substitute_output_pattern ~src pattern =
let base = fn_to_string (chop_extension (path_basename src)) in
let replacements = [
("${base}", base);
] in
List.fold_left (fun s (var, value) ->
let rec replace_all str =
try
let i = find_substring str var in
let before = String.sub str 0 i in
let after = String.sub str (i + String.length var) (String.length str - i - String.length var) in
replace_all (before ^ value ^ after)
with Not_found -> str
in
replace_all s
) pattern replacements
(** Convert custom generator to internal type for build system *)
let custom_to_builtin (custom : custom) : t =
let suffix = match custom.custom_suffix with
| Some s -> s
| None -> "" (* No suffix means generate-block-only *)
in
let modname = match custom.custom_module_name with
| None -> (fun m -> m)
| Some pattern ->
(fun m ->
let base = Compat.string_lowercase (Modname.to_string m) in
let name = substitute_output_pattern ~src:(fp base) pattern in
Modname.of_string (Compat.string_capitalize name))
in
let commands = fun src dest _moduleName ->
let cmd = substitute_variables ~src ~dest ~sources:[src] custom.custom_command in
(* Run command through shell to support shell features like &&, |, etc. *)
[["sh"; "-c"; cmd]]
in
let generated_files = fun f _moduleName ->
match custom.custom_outputs with
| [] -> chop_extension f <.> "ml" (* default to .ml *)
| output :: _ ->
let pattern = substitute_output_pattern ~src:(fp (fn_to_string f)) output in
fn pattern
in
{ suffix; modname; commands; generated_files }
(** Register a custom generator from project file *)
let register_custom (gen : custom) =
custom_generators := gen :: !custom_generators
(** Register multiple custom generators *)
let register_customs (gens : custom list) =
List.iter register_custom gens
(** Clear all custom generators (useful for testing) *)
let clear_custom_generators () =
custom_generators := []
(** Get all generators with suffixes (for automatic detection) *)
let get_all () =
let custom_as_builtin = List.map custom_to_builtin !custom_generators in
(* Only include generators with non-empty suffix for automatic detection *)
List.filter (fun gen -> gen.suffix <> "") custom_as_builtin
(** Check if a file extension has a registered generator *)
let is_generator_ext ext =
let ext_with_dot = "." ^ ext in
List.exists (fun gen -> gen.suffix = ext || gen.suffix = ext_with_dot) (get_all ())
(** Get ALL generators for filepath based on extension *)
let get_generators fp =
let ext = Filetype.of_filepath fp in
match ext with
| Filetype.FileOther s ->
let s_with_dot = "." ^ s in
List.filter (fun gen -> gen.suffix = s || gen.suffix = s_with_dot) (get_all ())
| _ -> []
(** Get single generator for filepath (for backward compatibility) *)
let get_generator fp =
match get_generators fp with
| [] -> raise (GeneratorNotFound (fp_to_string fp))
| gen :: _ -> gen
(** Run ALL generators for source file *)
let run dest src modName =
log Debug " generator dest = %s src = %s\n%!" (fp_to_string dest) (fp_to_string src);
let gens = get_generators src in
if gens = [] then raise (GeneratorNotFound (fp_to_string src));
List.iter (fun gen ->
let args = gen.commands src dest modName in
List.iter (fun arg ->
match Process.run arg with
| Process.Success (_, warnings,_) -> print_warnings warnings
| Process.Failure er -> raise (GeneratorFailed er)
) args
) gens
(** Find a custom generator by name *)
let find_generator_by_name name =
try Some (List.find (fun (g : custom) -> g.custom_name = name) !custom_generators)
with Not_found -> None
(** Run a generator with multiple inputs (for generate blocks) *)
let run_custom_multi ~generator_name ~dest ~sources ~extra_args =
(* Find the custom generator by name *)
let custom =
match find_generator_by_name generator_name with
| Some g -> g
| None -> raise (GeneratorNotFound generator_name)
in
let src = match sources with
| [] -> raise (GeneratorFailed "No source files provided")
| s :: _ -> s
in
let cmd_base = substitute_variables ~src ~dest ~sources custom.custom_command in
let cmd = match extra_args with
| None -> cmd_base
| Some args -> cmd_base ^ " " ^ args
in
log Debug " custom generator: %s\n%!" cmd;
(* Run command through shell to support shell features *)
let args = ["sh"; "-c"; cmd] in
match Process.run args with
| Process.Success (_, warnings, _) -> print_warnings warnings
| Process.Failure er -> raise (GeneratorFailed er)
(** Get the output files for a custom generator *)
let get_custom_outputs (custom : custom) ~src =
List.map (fun pattern ->
fn (substitute_output_pattern ~src pattern)
) custom.custom_outputs
|