Commit fcf63e2c authored by Seb Mondet's avatar Seb Mondet

Improve Makefile generation (help, killing, …)

A simple `make help` (or just `make`) outputs:

```
Help
====

This a Habust-generated Makefile:

* `make help`: Display this help message
* `make start`: Start the Qemu VM (this grabs the terminal).
* `make setup`: Do the preliminary setup of the Qemu VM (requires the VM started in another terminal).
* `make kill`: Kill the Qemu VM.

```
parent 57c5faba
......@@ -15,22 +15,28 @@ module Shell_script = struct
let sayl fmt l =
call (string "printf" :: (sprintf "Habust: %s\\n" fmt |> string) :: l)
let output_markdown_code tag f =
seq [
exec ["printf"; sprintf "``````````%s\\n" tag];
f;
exec ["printf"; sprintf "\\n``````````\\n"];
]
let cat_markdown file tag =
output_markdown_code tag @@ call [string "cat"; file]
let sanitize_name =
String.map begin function
| '0' .. '9' | 'a' .. 'z' | 'A' .. 'Z' | '-' as c -> c
| other -> '_'
end
let seq_and l =
List.fold l ~init:(bool true) ~f:(fun u v -> u &&& succeeds v)
let return_false = exec ["sh"; "-c"; "exit 42"]
let seq_succeeds_or ?(silent = true) ~name ?(clean_up = [fail]) cmds =
let content =
let stdout i =
......@@ -65,8 +71,11 @@ module Shell_script = struct
[
"# Script %s";
"# Generated by Habust";
sprintf "echo 'Habust: %s (%s)'" name filename;
Genspio.Language.to_many_lines content;
])
],
sprintf "sh %s" (Filename.quote filename)
)
end
......@@ -145,44 +154,80 @@ module Prepare_environment = struct
]
]
let kill_qemu_vm (Qemu_ssh _) =
let open Shell_script in
let open Genspio.EDSL in
let pid = output_as_string (exec ["cat"; "qemu.pid"]) in
seq_succeeds_or ~name:(sprintf "Killing Qemu VM") ~clean_up:[fail] [
if_seq (file_exists (string "qemu.pid"))
~t:[
if_seq (call [string "kill"; pid] |> succeeds)
~t:[
exec ["rm"; "qemu.pid"];
]
~e:[
sayl "PID file here (PID: %s) but Kill failed, \
deleting `qemu.pid`" [pid];
exec ["rm"; "qemu.pid"];
return_false
]
]
~e:[
sayl "No PID file" [];
return_false
]
]
let setup_dir_content (Qemu_ssh {ssh_port; kernel; sd_card; _} as qssh) =
let other_files = ref [] in
let dependencies = make_files [kernel; sd_card] in
let start_deps = List.map dependencies ~f:(fun (base, _, _) -> base) in
let make_entry ?(phony = false) ?(deps = []) target action =
let help_entries = ref [] in
let make_entry ?doc ?(phony = false) ?(deps = []) target action =
help_entries := (target, doc) :: !help_entries;
(if phony then [sprintf ".PHONY: %s" target] else [])
@ [
sprintf "# %s: %s" target (Option.value doc ~default:"NOT DOCUMENTED");
sprintf "%s: %s" target (String.concat ~sep:" " deps);
sprintf "\t%s" action;
sprintf "\t@%s" action;
] in
let make_script_entry ?doc ?phony ?deps target script =
let (filename, content, call) = Shell_script.to_script script in
other_files := (filename, content) :: !other_files;
make_entry ?doc ?phony ?deps target call in
let makefile =
[
"# Makefile genrated by Habust";
]
@ List.concat_map dependencies ~f:begin fun (base, deps, cmd) ->
let (filename, content) = Shell_script.to_script cmd in
other_files := (filename, content) :: !other_files;
make_entry ~deps base (sprintf "sh %s" (Filename.quote filename))
end
@ begin
let fname, content = start_qemu_vm qssh |> Shell_script.to_script in
other_files := (fname, content) :: !other_files;
make_entry ~deps:start_deps ~phony:true
"start" (sprintf "sh %s" (Filename.quote fname))
end
@ begin
let fname, content = setup_qemu_vm qssh |> Shell_script.to_script in
other_files := (fname, content) :: !other_files;
make_entry ~phony:true
"setup" (sprintf "sh %s" (Filename.quote fname))
end
@ begin
make_entry ~phony:true
"kill" (sprintf "kill `cat qemu.pid`")
make_script_entry ~deps base cmd
end
@ [""]
@ make_script_entry ~deps:start_deps ~phony:true "start"
~doc:"Start the Qemu VM (this grabs the terminal)."
(start_qemu_vm qssh)
@ make_script_entry ~phony:true "setup" (setup_qemu_vm qssh)
~doc:"Do the preliminary setup of the Qemu VM (requires the VM \
started in another terminal)."
@ make_script_entry ~phony:true "kill" (kill_qemu_vm qssh)
~doc:"Kill the Qemu VM."
in
("Makefile", makefile) :: !other_files
let help =
make_script_entry ~phony:true "help" Shell_script.(
make "Display help message" Genspio.EDSL.(
exec ["printf"; "\\nHelp\\n====\\n\\n\
This a Habust-generated Makefile:\\n\\n%s\\n";
List.map
(("help", Some "Display this help message")
:: !help_entries)
~f:begin function
| target, None -> ""
| (target, Some doc) ->
sprintf "* `make %s`: %s\n" target doc
end |> String.concat ~sep:""]
)
) in
("Makefile", "all: help" :: makefile @ help @ [""]) :: !other_files
let start =
function
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment