meat/lib/meat.ml

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
   ..-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" ^ "#nixosConfigurations." ^ Unix.gethostname () ^ ".config.system.build.toplevel" in
   do_cmd @@ "nix build --out-link " ^ tmpdir ^ "/build " ^ build_target >>=
   fun () -> do_cmd @@ "sudo " ^ tmpdir ^ "/build/bin/switch-to-configuration switch" >|=
   fun () -> Unix.unlink @@ tmpdir ^ "/build"

let yum () =
  print_string header;
  meat_print "CONSUMING DELICIOUS MEATS..";
  do_build () |> function | Error _ -> print_string "FAILED TO CONSUME MEATS"; print_string footer | _ -> 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")