refactor, hunt

lib/commands/look.ml

@@ -0,0 +1,114 @@
+let run () =
+  print_string Common.header;
+  Common.meat_print "LOOKING FOR FRESHER MEATS..";
+  let lockfile = Http.read_file (Unix.getenv "MEATS" ^ "/flake.lock") in
+  let json = Json.parse_json lockfile in
+  let nodes =
+    match Json.jfield "nodes" json with Some n -> n | None -> failwith "no nodes"
+  in
+  let root_node =
+    match Json.jfield "root" nodes with Some n -> n | None -> failwith "no root"
+  in
+  let root_inputs =
+    match Json.jfield "inputs" root_node with
+    | Some n -> n
+    | None -> failwith "no root inputs"
+  in
+  let input_pairs =
+    match Json.jassoc root_inputs with
+    | Some p -> p
+    | None -> failwith "root inputs not object"
+  in
+  let any_stale = ref false in
+  List.iter
+    (fun (name, node_ref) ->
+      let node_name =
+        match Json.jstring node_ref with Some s -> s | None -> name
+      in
+      let node =
+        match Json.jfield node_name nodes with
+        | Some n -> n
+        | None -> failwith ("no node: " ^ node_name)
+      in
+      let locked =
+        match Json.jfield "locked" node with
+        | Some n -> n
+        | None -> failwith "no locked"
+      in
+      let original =
+        match Json.jfield "original" node with
+        | Some n -> n
+        | None -> failwith "no original"
+      in
+      let locked_rev =
+        match Option.bind (Json.jfield "rev" locked) Json.jstring with
+        | Some s -> s
+        | None -> failwith "no rev"
+      in
+      let locked_type =
+        match Option.bind (Json.jfield "type" locked) Json.jstring with
+        | Some s -> s
+        | None -> failwith "no type"
+      in
+      let original_ref = Option.bind (Json.jfield "ref" original) Json.jstring in
+      let host, path =
+        match locked_type with
+        | "github" ->
+            let owner =
+              match Option.bind (Json.jfield "owner" locked) Json.jstring with
+              | Some s -> s
+              | None -> failwith "no owner"
+            in
+            let repo =
+              match Option.bind (Json.jfield "repo" locked) Json.jstring with
+              | Some s -> s
+              | None -> failwith "no repo"
+            in
+            ( "github.com",
+              "/" ^ owner ^ "/" ^ repo
+              ^ ".git/info/refs?service=git-upload-pack" )
+        | "git" ->
+            let url =
+              match Option.bind (Json.jfield "url" original) Json.jstring with
+              | Some s -> s
+              | None -> failwith "no url"
+            in
+            let prefix = "https://" in
+            let plen = String.length prefix in
+            if String.length url > plen && String.sub url 0 plen = prefix then
+              let after =
+                String.sub url plen (String.length url - plen)
+              in
+              let slash =
+                match String.index_opt after '/' with
+                | Some i -> i
+                | None -> failwith "no path in url"
+              in
+              let h = String.sub after 0 slash in
+              let p =
+                String.sub after slash (String.length after - slash)
+              in
+              (h, p ^ "/info/refs?service=git-upload-pack")
+            else failwith ("unsupported url: " ^ url)
+        | t -> failwith ("unsupported type: " ^ t)
+      in
+      try
+        let body = Http.https_get ~host ~path in
+        let refs = Http.parse_pktline body in
+        let target_ref =
+          match original_ref with
+          | Some r -> "refs/heads/" ^ r
+          | None -> "HEAD"
+        in
+        let latest_rev =
+          match List.assoc_opt target_ref refs with
+          | Some rev -> rev
+          | None -> failwith ("ref not found: " ^ target_ref)
+        in
+        if latest_rev <> locked_rev then (
+          any_stale := true;
+          Common.meat_print (Common.all_caps name ^ " HAS FRESHER MEAT!"))
+      with _ -> Common.meat_print ("COULD NOT REACH " ^ Common.all_caps name ^ ".."))
+    input_pairs;
+  if not !any_stale then Common.meat_print "ALL MEATS ARE FRESH!";
+  print_string Common.footer