Fix tests/formatting

quantifyearth · May 28, 2024 · b3b5964 · b3b5964
1 parent c4c2b5b
commit b3b5964
Show file tree

Hide file tree

Showing 11 changed files with 286 additions and 248 deletions.
diff --git a/src/bin/main.ml b/src/bin/main.ml
@@ -124,23 +124,26 @@ let edit ~proc ~net ~fs () file port =
 
 let md ~fs ~net ~domain_mgr ~proc () no_run store conf file port fetcher jobs
     src_dir env_override input_override =
-
-  let import_map = List.map (fun (k, v) -> 
-    match Fpath.of_string v with
-    | Ok p -> (k, p)
-    | Error (`Msg msg) -> Fmt.failwith "Not a valid path %s: %s" v msg
-  ) input_override in
+  let import_map =
+    List.map
+      (fun (k, v) ->
+        match Fpath.of_string v with
+        | Ok p -> (k, p)
+        | Error (`Msg msg) -> Fmt.failwith "Not a valid path %s: %s" v msg)
+      input_override
+  in
 
   run_eventloop @@ fun () ->
   let ((_, store) as s) = store_or_default store in
   let (Builder ((module Builder), _builder) as obuilder) =
     create_builder ~fs ~net ~domain_mgr fetcher s conf
   in
   Fun.protect ~finally:(fun () -> ()) @@ fun () ->
-
   let file_path = Eio.Path.(fs / file) in
   let template_markdown = Eio.Path.load file_path in
-  let ast, markdown = Shark.Ast.of_sharkdown ~concrete_paths:import_map template_markdown in
+  let ast, markdown =
+    Shark.Ast.of_sharkdown ~concrete_paths:import_map template_markdown
+  in
 
   let doc = Cmarkit.Doc.of_string markdown in
 
@@ -156,10 +159,11 @@ let md ~fs ~net ~domain_mgr ~proc () no_run store conf file port fetcher jobs
           (* First we translate the import statement to a build block *)
           let uid = string_of_int !import_uid in
           incr import_uid;
-          let (cb, blk), src_dir_opt = Shark.Md.translate_import_block ~uid block in
-          let import_src_dir = match src_dir_opt with
-          | Some x -> x
-          | None -> src_dir
+          let (cb, blk), src_dir_opt =
+            Shark.Md.translate_import_block ~uid block
+          in
+          let import_src_dir =
+            match src_dir_opt with Some x -> x | None -> src_dir
           in
           (* Now we build the block *)
           (* Import block digests need to be mapped to this build hash *)
@@ -175,7 +179,8 @@ let md ~fs ~net ~domain_mgr ~proc () no_run store conf file port fetcher jobs
           let _alias, _id, cb =
             Shark.Build_cache.with_build build_cache @@ fun _build_cache ->
             let cb, blk =
-              Shark.Md.process_build_block ~src_dir:import_src_dir ~hb obuilder ast (cb, blk)
+              Shark.Md.process_build_block ~src_dir:import_src_dir ~hb obuilder
+                ast (cb, blk)
             in
             ( Shark.Block.alias blk,
               option_get ~msg:"Block hash for import" (Shark.Block.hash blk),
@@ -349,11 +354,7 @@ let env_override =
 let input_override =
   Arg.value
   @@ Arg.(opt_all (pair ~sep:'=' string string)) []
-  @@ Arg.info
-       ~doc:
-         "Provide input file names \
-          KEY=VALUE."
-       ~docv:"INPUT" [ "i" ]
+  @@ Arg.info ~doc:"Provide input file names KEY=VALUE." ~docv:"INPUT" [ "i" ]
 
 let build ~fs ~net ~domain_mgr ~clock =
   let doc = "Build a spec file." in
@@ -379,7 +380,8 @@ let md ~fs ~net ~domain_mgr ~proc ~clock =
     Term.(
       const (md ~fs ~net ~domain_mgr ~proc ~clock)
       $ setup_log $ no_run $ store $ Obuilder.Native_sandbox.cmdliner
-      $ markdown_file $ port $ fetcher $ jobs $ src_dir $ env_override $ input_override)
+      $ markdown_file $ port $ fetcher $ jobs $ src_dir $ env_override
+      $ input_override)
 
 let editor ~proc ~net ~fs ~clock =
   let doc = "Run the editor for a markdown file" in

diff --git a/src/lib/ast/ast.ml b/src/lib/ast/ast.ml
@@ -217,22 +217,32 @@ let pass_one_on_list inputs section_list =
 let to_list ast = List.map snd ast.nodes
 
 let synthesize_import_block input_map input_override_map =
-  let imports = List.map (fun (k, p) -> 
-    let dest = List.assoc k input_map in
-    (p, dest)
-  ) input_override_map in
-  let codeblock = List.fold_left (fun acc (src, dst) ->
-    acc ^ (Printf.sprintf "%s %s\n" (Fpath.to_string src) (Fpath.to_string dst))
-  ) "" imports in
-  let block = Block.import codeblock in 
-  ("imports", [block_to_superblock block])
-
-let synthesize_unmapped_import_block input_map =   
-let codeblock = List.fold_left (fun acc (src, dst) ->
-  acc ^ (Printf.sprintf "%s %s\n" src (Fpath.to_string dst))
-) "" input_map in
-let block = Block.import codeblock in 
-("imports", [block_to_superblock block])
+  let imports =
+    List.map
+      (fun (k, p) ->
+        let dest = List.assoc k input_map in
+        (p, dest))
+      input_override_map
+  in
+  let codeblock =
+    List.fold_left
+      (fun acc (src, dst) ->
+        acc
+        ^ Printf.sprintf "%s %s\n" (Fpath.to_string src) (Fpath.to_string dst))
+      "" imports
+  in
+  let block = Block.import codeblock in
+  ("imports", [ block_to_superblock block ])
+
+let synthesize_unmapped_import_block input_map =
+  let codeblock =
+    List.fold_left
+      (fun acc (src, dst) ->
+        acc ^ Printf.sprintf "%s %s\n" src (Fpath.to_string dst))
+      "" input_map
+  in
+  let block = Block.import codeblock in
+  ("imports", [ block_to_superblock block ])
 
 let of_sharkdown ?concrete_paths template_markdown =
   let metadata, sections, markdown =
@@ -258,34 +268,39 @@ let of_sharkdown ?concrete_paths template_markdown =
   in
 
   let input_map = Frontmatter.input_map metadata in
-  let synthesized_sections = match List.length input_map with
-  | 0 -> []
-  | _ -> (match concrete_paths with 
-    | Some concrete_paths -> [synthesize_import_block input_map concrete_paths]
-    | None -> [synthesize_unmapped_import_block input_map]
-  ) in
-
-  let expanded_markdown = List.fold_left (fun acc (name, bs) ->
-
-    let title = Printf.sprintf "# %s\n\n" name in
-    let body = List.fold_left (fun acc b -> 
-      (
-        Printf.sprintf "```%s\n%s\n```\n\n" 
-        (Block.to_info_string b.block)
-        (Block.body b.block)
-      ) ^ acc
-    ) "\n" bs in
-
-    (title ^ body) ^ acc
-  ) markdown synthesized_sections in
-
-  let expanded_sections =  synthesized_sections @ detailed_sections in
+  let synthesized_sections =
+    match List.length input_map with
+    | 0 -> []
+    | _ -> (
+        match concrete_paths with
+        | Some concrete_paths ->
+            [ synthesize_import_block input_map concrete_paths ]
+        | None -> [ synthesize_unmapped_import_block input_map ])
+  in
+
+  let expanded_markdown =
+    List.fold_left
+      (fun acc (name, bs) ->
+        let title = Printf.sprintf "# %s\n\n" name in
+        let body =
+          List.fold_left
+            (fun acc b ->
+              Printf.sprintf "```%s\n%s\n```\n\n"
+                (Block.to_info_string b.block)
+                (Block.body b.block)
+              ^ acc)
+            "\n" bs
+        in
+
+        (title ^ body) ^ acc)
+      markdown synthesized_sections
+  in
+
+  let expanded_sections = synthesized_sections @ detailed_sections in
 
   (* we can only infer the dependancy graph globally, so we need to do this at the top level before
      then working out the DAG. *)
-  let pass1 =
-    pass_one_on_list [] expanded_sections
-  in
+  let pass1 = pass_one_on_list [] expanded_sections in
 
   (* Now I have the global graph implicitly, turn the list into a graph of blocks *)
   let all_hyperblocks = List.concat_map Section.blocks pass1 in
@@ -315,7 +330,7 @@ let of_sharkdown ?concrete_paths template_markdown =
          id_all_hyperblocks)
   in
 
-  { nodes = id_all_hyperblocks; edges }, expanded_markdown
+  ({ nodes = id_all_hyperblocks; edges }, expanded_markdown)
 
 let find_id_of_block ast ib =
   let d = Block.digest ib in

diff --git a/src/lib/ast/ast.mli b/src/lib/ast/ast.mli
@@ -30,7 +30,10 @@ type t [@@deriving sexp]
 (** An AST instance *)
 
 val pp : t Fmt.t
-val of_sharkdown : ?concrete_paths:(string * Fpath.t) list -> string -> t * string
+
+val of_sharkdown :
+  ?concrete_paths:(string * Fpath.t) list -> string -> t * string
+
 val find_id_of_block : t -> Block.t -> block_id option
 val block_by_id : t -> block_id -> Hyperblock.t option
 val find_hyperblock_from_block : t -> Block.t -> Hyperblock.t option

diff --git a/src/lib/block.ml b/src/lib/block.ml
@@ -145,8 +145,7 @@ let imports = function
                 Fmt.failwith "Error parsing path %s: %s" path msg)
         | None -> Fmt.failwith "Invalid import statement '%s'" s
       in
-      String.cuts ~sep:"\n" (String.trim body)
-      |> List.map cut_import
+      String.cuts ~sep:"\n" (String.trim body) |> List.map cut_import
 
 let digest : t -> string = function
   | Import { body; _ }
@@ -162,38 +161,44 @@ let import_spec b =
   match Uri.scheme url with
   | None | Some "file" ->
       (* Choose better image, just need tools to import? *)
-      let fpath = match Fpath.of_string (Uri.path url) with 
-      | Ok p -> p 
-      | Error (`Msg msg) -> Fmt.failwith "Failed to parse path %s: %s" (Uri.path url) msg
+      let fpath =
+        match Fpath.of_string (Uri.path url) with
+        | Ok p -> p
+        | Error (`Msg msg) ->
+            Fmt.failwith "Failed to parse path %s: %s" (Uri.path url) msg
       in
       let src_dir, path = Fpath.split_base fpath in
       let src_dir = Fpath.rem_empty_seg src_dir in
-      stage ~from:(`Image "alpine")
-        [
-          (* shell [ "/bin/sh"; "-c" ]; *)
-          (* run "mkdir -p %s" (Fpath.to_string (Fpath.parent path)); *)
-          copy [ (Fpath.to_string path) ] ~dst:(Fpath.to_string target_path);
-        ], Some (Fpath.to_string src_dir)
+      ( stage ~from:(`Image "alpine")
+          [
+            (* shell [ "/bin/sh"; "-c" ]; *)
+            (* run "mkdir -p %s" (Fpath.to_string (Fpath.parent path)); *)
+            copy [ Fpath.to_string path ] ~dst:(Fpath.to_string target_path);
+          ],
+        Some (Fpath.to_string src_dir) )
   | Some "http" | Some "https" -> (
       let src_path = Uri.path url in
       match String.cut ~rev:true ~sep:"." src_path with
       | Some (_, "git") ->
           (* Choose better image, just need tools to import? *)
-          stage ~from:(`Image "alpine")
-            [
-              shell [ "/bin/sh"; "-c" ];
-              run ~network:[ "host" ] "apk add --no-cache git";
-              run ~network:[ "host" ] "mkdir -p /data && git clone %s %s"
-                (Uri.to_string url) (Fpath.to_string target_path);
-            ], None
+          ( stage ~from:(`Image "alpine")
+              [
+                shell [ "/bin/sh"; "-c" ];
+                run ~network:[ "host" ] "apk add --no-cache git";
+                run ~network:[ "host" ] "mkdir -p /data && git clone %s %s"
+                  (Uri.to_string url)
+                  (Fpath.to_string target_path);
+              ],
+            None )
       | _ ->
           (* Choose better image, just need tools to import? *)
-          stage ~from:(`Image "alpine")
-            [
-              shell [ "/bin/sh"; "-c" ];
-              run ~network:[ "host" ] "apk add --no-cache curl";
-              run ~network:[ "host" ] "mkdir -p /data && curl -O %s %s"
-                (Fpath.to_string target_path) (Uri.to_string url);
-            ], None
-      )
+          ( stage ~from:(`Image "alpine")
+              [
+                shell [ "/bin/sh"; "-c" ];
+                run ~network:[ "host" ] "apk add --no-cache curl";
+                run ~network:[ "host" ] "mkdir -p /data && curl -O %s %s"
+                  (Fpath.to_string target_path)
+                  (Uri.to_string url);
+              ],
+            None ))
   | Some scheme -> Fmt.failwith "Unsupported import scheme %s" scheme
diff --git a/src/lib/block.mli b/src/lib/block.mli
@@ -74,4 +74,4 @@ val imports : t -> (Uri.t * Fpath.t) list
 val digest : t -> string
 
 val import_spec : t -> Obuilder_spec.t * string option
-(** For a shark-import block generate the spec to execute to enact the import. *)
+(** For a shark-import block generate the spec to execute to enact the import. *)
diff --git a/src/lib/dotrenderer.ml b/src/lib/dotrenderer.ml
@@ -40,7 +40,7 @@ let render_publish_to_dot ppf command =
         (Datafile.id datafile) process_index label)
     (Leaf.inputs command)
 
-let render_import_to_dot ppf command = 
+let render_import_to_dot ppf command =
   let process_index = Leaf.id command in
   List.iter
     (fun datafile ->
@@ -117,7 +117,6 @@ let render_ast_to_dot ppf hyperblocks : unit =
 
 let render ~template_markdown =
   Ast.of_sharkdown template_markdown
-  |> fst
-  |> Ast.to_list
+  |> fst |> Ast.to_list
   |> render_ast_to_dot Format.str_formatter;
-  Format.flush_str_formatter () 
+  Format.flush_str_formatter ()
diff --git a/src/lib/md.ml b/src/lib/md.ml
@@ -224,21 +224,19 @@ let process_run_block ?(env_override = []) ~fs ~build_cache ~pool store ast
             (* If the dir is in the inputs we should substitute it, otherwise we assume it's a new dir in this
                current image. *)
             let args = Command.file_args command in
-            let inspected_path = match (List.length args) with
-            | 0 -> (
-              (* no /data path in this, so just pull the path directly as the AST only works with /data paths *)
-              String.cut ~sep:" " (Command.to_string command) |> Option.get ~err:"Failed to get path in cd" |> snd
-            )
-            | _ -> (
-              let path = Fpath.to_string (List.nth args 0) in
-                match List.assoc_opt path file_subs_map with
-                | None -> path
-                | Some pl -> (
-                  match List.length pl with
-                  | 0 -> path
-                  | _ -> List.nth pl 0
-                )
-            )
+            let inspected_path =
+              match List.length args with
+              | 0 ->
+                  (* no /data path in this, so just pull the path directly as the AST only works with /data paths *)
+                  String.cut ~sep:" " (Command.to_string command)
+                  |> Option.get ~err:"Failed to get path in cd"
+                  |> snd
+              | _ -> (
+                  let path = Fpath.to_string (List.nth args 0) in
+                  match List.assoc_opt path file_subs_map with
+                  | None -> path
+                  | Some pl -> (
+                      match List.length pl with 0 -> path | _ -> List.nth pl 0))
             in
 
             let cmd_result = CommandResult.v ~build_hash cmdstr in
@@ -456,5 +454,5 @@ let translate_import_block ~uid block =
           ~info_string:(Fmt.str "shark-build:%s" alias, Cmarkit.Meta.none)
           (Cmarkit.Block_line.list_of_string body)
       in
-      (code_block, block), src_dir_opt
+      ((code_block, block), src_dir_opt)
   | _ -> failwith "Expected Import Block"
diff --git a/src/lib/md.mli b/src/lib/md.mli
@@ -48,4 +48,6 @@ val process_publish_block :
   Cmarkit.Block.Code_block.t * Block.t
 
 val translate_import_block :
-  uid:string -> Block.t -> (Cmarkit.Block.Code_block.t * Block.t) * string option
+  uid:string ->
+  Block.t ->
+  (Cmarkit.Block.Code_block.t * Block.t) * string option