This commit is contained in:
atagen
parent
0fc93545ce
commit
703ac28f52
16 changed files with 548 additions and 215 deletions
223
lib/meat.ml
223
lib/meat.ml
|
|
@ -1,213 +1,10 @@
|
|||
let header = "\n ----- MEAT ----------------------------------------\n"
|
||||
let footer = "\n ---------------------------------------------------\n"
|
||||
|
||||
let help =
|
||||
{|
|
||||
YUM - CONSUME DELICIOUS MEATS
|
||||
COOK - ONLY PREPARE MEATS
|
||||
POKE - TASTE SUSPICIOUS MEATS
|
||||
GUT - CLEAN MEAT STORES
|
||||
FRESH - HUNT FRESH MEATS
|
||||
TRADE - SEND MEATS FAR AWAY
|
||||
..-A - ..ALL MEATS|}
|
||||
|
||||
(* \tLOOK - LOOK FOR FRESHER MEATS *)
|
||||
open Sys
|
||||
|
||||
(* TODO rewrite all of this to use its own build and activation routines *)
|
||||
(* pipe into nom for user output, then use dix at the end *)
|
||||
let pass_args () =
|
||||
let len = Array.length argv and sconcat acc el = acc ^ " " ^ el in
|
||||
match len with
|
||||
| 3 -> argv.(2)
|
||||
| n when n > 3 ->
|
||||
print_int (n - 1);
|
||||
Array.fold_left sconcat " " (Array.sub argv 2 (n - 2))
|
||||
| _ -> ""
|
||||
|
||||
let do_cmd ?(args = true) cmd =
|
||||
match command (if args then cmd ^ " " ^ pass_args () else cmd) with
|
||||
| 0 -> Ok ()
|
||||
| e -> Error e
|
||||
|
||||
let meat_print text = print_endline ("\n \t" ^ text ^ "\n")
|
||||
|
||||
let do_build () =
|
||||
let ( >>= ) = Result.bind in
|
||||
let ( >|= ) = Fun.flip Result.map in
|
||||
let tmpdir = Filename.temp_dir "meat-build" "" in
|
||||
let build_target =
|
||||
Unix.getenv "MEATS" ^ "/entry.nix -A nixosConfigurations."
|
||||
^ Unix.gethostname () ^ ".config.system.build.toplevel"
|
||||
in
|
||||
do_cmd @@ "nix-build --log-format internal-json -v --out-link " ^ tmpdir
|
||||
^ "/build " ^ build_target ^ " |& nom --json"
|
||||
>>= fun () -> do_cmd @@ "dix /nix/var/nix/profiles/system " ^ tmpdir ^ "/build"
|
||||
>>= fun () ->
|
||||
do_cmd @@ "sudo nix-env --set -p /nix/var/nix/profiles/system " ^ tmpdir
|
||||
^ "/build"
|
||||
>>= fun () ->
|
||||
do_cmd @@ "sudo " ^ tmpdir ^ "/build/bin/switch-to-configuration switch"
|
||||
>|= fun () -> Unix.unlink @@ tmpdir ^ "/build"
|
||||
|
||||
let do_remote () =
|
||||
meat_print "tbd";
|
||||
Ok ()
|
||||
|
||||
let trade () =
|
||||
print_string header;
|
||||
meat_print "TRADING FOREIGN MEATS..";
|
||||
do_remote () |> function
|
||||
| Error _ -> print_string "FAILED TO TRADE MEATS."
|
||||
| _ ->
|
||||
();
|
||||
print_string footer
|
||||
|
||||
let yum () =
|
||||
print_string header;
|
||||
meat_print "CONSUMING DELICIOUS MEATS..";
|
||||
( do_build () |> function
|
||||
| Error _ -> print_string "FAILED TO CONSUME MEATS."
|
||||
| _ -> () );
|
||||
print_string footer
|
||||
|
||||
let cook () =
|
||||
print_string header;
|
||||
meat_print "PREPARING DELICIOUS MEATS..";
|
||||
let build_target =
|
||||
Unix.getenv "MEATS" ^ "#nixosConfigurations." ^ Unix.gethostname ()
|
||||
^ ".config.system.build.toplevel"
|
||||
in
|
||||
do_cmd @@ "nix build --no-link" ^ build_target |> ignore;
|
||||
print_string footer
|
||||
|
||||
let poke () =
|
||||
print_string header;
|
||||
meat_print "PREPARING SUSPICIOUS MEATS..";
|
||||
let build_target =
|
||||
Unix.getenv "MEATS" ^ "#nixosConfigurations." ^ Unix.gethostname ()
|
||||
^ ".config.system.build.toplevel"
|
||||
in
|
||||
do_cmd @@ "nix build --no-link " ^ build_target ^ " --show-trace" |> ignore;
|
||||
print_string footer
|
||||
|
||||
let gut () =
|
||||
print_string header;
|
||||
meat_print "CLEANING MEAT STORES..";
|
||||
do_cmd "nh clean all" |> ignore;
|
||||
print_string footer
|
||||
|
||||
(* TODO pending fuiska lib.. *)
|
||||
(* let look () = *)
|
||||
(* print_string header; *)
|
||||
(* meat_print "INSPECTING MEAT.."; *)
|
||||
(* meat_print "CONSUMING MEATS:"; *)
|
||||
(* let meats = Unix.getenv "MEATS" in *)
|
||||
(* do_cmd @@ "nix flake metadata" ^ meats |> ignore; *)
|
||||
(* meat_print "PRODUCING MEATS:"; *)
|
||||
(* do_cmd "nix flake show $MEATS"; *)
|
||||
(* print_string footer; *)
|
||||
|
||||
(* let all_flag () = Array.mem "-a" argv || Array.mem "--all" argv
|
||||
let sub_flag () = Array.mem "-s" argv || Array.mem "--subflake" argv *)
|
||||
let all_flag () =
|
||||
if Array.length argv >= 3 then
|
||||
match Array.get argv 2 with "-a" | "--all" -> true | _ -> false
|
||||
else false
|
||||
|
||||
let sub_flag () =
|
||||
if Array.length argv >= 3 then
|
||||
match Array.get argv 2 with "-s" | "--sub" -> true | _ -> false
|
||||
else false
|
||||
|
||||
let derelativise base = List.map (fun a -> base ^ "/" ^ a)
|
||||
|
||||
let filter_dirs fullpath dirs =
|
||||
dirs |> derelativise fullpath
|
||||
|> List.filter (fun d -> (Unix.stat d).st_kind = S_DIR)
|
||||
|
||||
let readdir d = try Sys.readdir d with Sys_error _ -> [||]
|
||||
|
||||
let walk entry =
|
||||
let open List in
|
||||
let rec loop dir : string list =
|
||||
let contents = readdir dir |> Array.to_list in
|
||||
let is_flake = mem "flake.nix" contents in
|
||||
if dir = entry then
|
||||
let subdirs = contents |> filter_dirs dir in
|
||||
flatten (map loop subdirs)
|
||||
else if is_flake then
|
||||
let subdirs = contents |> filter_dirs dir in
|
||||
let children = flatten (map loop subdirs) in
|
||||
[ dir ] @ children
|
||||
else []
|
||||
in
|
||||
loop entry
|
||||
|
||||
let countdepth s =
|
||||
s |> String.fold_left (fun acc el -> acc + if el = '/' then 1 else 0) 0
|
||||
|
||||
let compdepth a b =
|
||||
let ad = countdepth a and bd = countdepth b in
|
||||
let dif = ad - bd in
|
||||
match dif with 0 -> 0 | _ -> dif / abs dif
|
||||
|
||||
let all_caps s = s |> String.map (fun c -> Char.uppercase_ascii c)
|
||||
let all_low s = s |> String.map (fun c -> Char.lowercase_ascii c)
|
||||
let fmt_dir d = String.split_on_char '/' d |> List.rev |> List.hd |> all_caps
|
||||
|
||||
let submeats s =
|
||||
s
|
||||
|> List.iter (fun d ->
|
||||
meat_print ("PROCESSING SUBMEAT " ^ fmt_dir d ^ "..");
|
||||
do_cmd ~args:false @@ "nix flake update --flake " ^ d |> ignore)
|
||||
|
||||
let fresh () =
|
||||
print_string header;
|
||||
meat_print "HUNTING FRESH MEATS..";
|
||||
let argv_len = Array.length argv in
|
||||
let root = Sys.getenv "MEATS" in
|
||||
let base_dir = root ^ "/flakes" in
|
||||
(match (sub_flag (), all_flag ()) with
|
||||
| false, false ->
|
||||
(* no flags, plain flake inputs *)
|
||||
if argv_len >= 3 then
|
||||
let open Array in
|
||||
let flakes = sub argv 2 (argv_len - 2) in
|
||||
flakes
|
||||
|> iter (fun f ->
|
||||
if all_low f = "meat" then meat_print "PROCESSING REAL MEAT.."
|
||||
else meat_print ("PROCESSING FRESH MEAT " ^ all_caps f ^ "..");
|
||||
do_cmd ~args:false @@ "nix flake update " ^ f ^ " --flake "
|
||||
^ root
|
||||
|> ignore)
|
||||
else do_cmd @@ "nix flake update --flake " ^ root |> ignore
|
||||
| _, true ->
|
||||
(* all flag, update all subflakes and main flake inputs *)
|
||||
walk base_dir |> List.sort compdepth |> List.rev |> submeats;
|
||||
print_string footer;
|
||||
meat_print "PROCESSING FRESH MEATS..";
|
||||
do_cmd ~args:false @@ "nix flake update --flake " ^ root |> ignore
|
||||
| true, _ when argv_len >= 4 ->
|
||||
(* sub flag, update inputs as subflakes *)
|
||||
let subflakes =
|
||||
match argv_len with
|
||||
| 4 -> [ argv.(3) ]
|
||||
| _ -> Array.sub argv 4 (argv_len - 4) |> Array.to_list
|
||||
in
|
||||
let open List in
|
||||
let sf_full = subflakes |> derelativise base_dir in
|
||||
sf_full |> map walk |> flatten |> sort compdepth |> rev |> append sf_full
|
||||
|> submeats;
|
||||
print_string footer;
|
||||
meat_print "PROCESSING FRESH MEATS..";
|
||||
subflakes
|
||||
|> iter (fun f ->
|
||||
do_cmd ~args:false @@ "nix flake update " ^ all_low f
|
||||
^ " --flake $MEATS"
|
||||
|> ignore)
|
||||
| _ -> print_string help);
|
||||
print_string footer;
|
||||
print_newline ()
|
||||
|
||||
let help () = print_string (header ^ help ^ footer ^ "\n")
|
||||
let yum = Commands.Yum.run
|
||||
let cook = Commands.Cook.run
|
||||
let poke = Commands.Poke.run
|
||||
let gut = Commands.Gut.run
|
||||
let trade = Commands.Trade.run
|
||||
let look = Commands.Look.run
|
||||
let fresh = Commands.Fresh.run
|
||||
let hunt = Commands.Hunt.run
|
||||
let help = Commands.Help.run
|
||||
let meat_print = Common.meat_print
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue