Merge pull request #17 from quantifyearth/mwd-misc-shuffle-2

Refactor AST code into single dir

src/lib/ast.ml → src/lib/ast/ast.ml

@@ -1,40 +1,5 @@
-open Sexplib.Conv
-
-module Leaf = struct
-  type style = Command | Map [@@deriving sexp]
-
-  type t = {
-    id : int;
-    command : Command.t;
-    style : style;
-    inputs : Datafile.t list;
-    outputs : Datafile.t list;
-  }
-  [@@deriving sexp]
-
-  let pp ppf t = Sexplib.Sexp.pp_hum ppf (sexp_of_t t)
-
-  let v id command style inputs outputs =
-    { id; command; style; inputs; outputs }
-
-  let command o = o.command
-  let inputs o = o.inputs
-  let outputs o = o.outputs
-  let command_style o = o.style
-  let id o = o.id
-end
-
-module CommandGroup = struct
-  type t = { name : string; children : Leaf.t list } [@@deriving sexp]
-
-  let pp ppf t = Sexplib.Sexp.pp_hum ppf (sexp_of_t t)
-  let v name children = { name; children }
-  let name g = g.name
-  let children g = g.children
-end
-
 (* Not yet an actual AST, actually an ASL :) *)
-type t = CommandGroup.t list
+type t = Commandgroup.t list
 
 let to_list cg = cg
 
@@ -59,13 +24,13 @@ let find_matching_datafile datafile_map fpath =
                            (Datafile.id df) (Datafile.path df)))))
         None datafile_map
 
-let order_command_list metadata command_groups =
+let order_command_list inputs command_groups =
   let input_map =
     List.mapi
       (fun i f ->
         let df = Datafile.v i f in
         (f, df))
-      (Frontmatter.inputs metadata)
+      inputs
   in
   let counter = ref (List.length input_map) in
 
@@ -117,7 +82,7 @@ let order_command_list metadata command_groups =
               (updated_map, x :: rest)
         in
         let updated_map, commands = loop commands input_map in
-        (updated_map, CommandGroup.v name commands))
+        (updated_map, Commandgroup.v name commands))
       input_map command_groups
   in
   ordered

src/lib/ast/ast.mli

@@ -0,0 +1,18 @@
+(** {1 AST}
+
+The AST is the logical representation of the workflow described in a
+sharkdown file, including the structure of groups (aka basic blocks
+in PL, but block is an overloaded term in this context). *)
+
+type t
+(** An AST instance *)
+
+val order_command_list : Fpath.t list -> (string * Command.t list) list -> t
+(** Takes the sharkdown frontmatter and a list of named CommandGroups and builds
+    an AST from them.
+
+    TODOs: Don't take in all of the frontmatter just what we need? The CommandGroups
+    should probably be a recursive data structure? *)
+
+val to_list : t -> Commandgroup.t list
+(** Convert the AST to a list of command blocks. *)

src/lib/ast/commandgroup.ml

@@ -0,0 +1,8 @@
+open Sexplib.Conv
+
+type t = { name : string; children : Leaf.t list } [@@deriving sexp]
+
+let pp ppf t = Sexplib.Sexp.pp_hum ppf (sexp_of_t t)
+let v name children = { name; children }
+let name g = g.name
+let children g = g.children

src/lib/ast/commandgroup.mli

@@ -0,0 +1,12 @@
+(** A named basic-block in PL terms. *)
+
+type t [@@deriving sexp]
+
+val v : string -> Leaf.t list -> t
+(** Creates a command group made up of a series of leaf nodes and given a name. *)
+
+val pp : t Fmt.t
+(** A pretty printer for command groups. *)
+
+val name : t -> string
+val children : t -> Leaf.t list

src/lib/ast/leaf.ml

@@ -0,0 +1,20 @@
+open Sexplib.Conv
+
+type style = Command | Map [@@deriving sexp]
+
+type t = {
+  id : int;
+  command : Command.t;
+  style : style;
+  inputs : Datafile.t list;
+  outputs : Datafile.t list;
+}
+[@@deriving sexp]
+
+let pp ppf t = Sexplib.Sexp.pp_hum ppf (sexp_of_t t)
+let v id command style inputs outputs = { id; command; style; inputs; outputs }
+let command o = o.command
+let inputs o = o.inputs
+let outputs o = o.outputs
+let command_style o = o.style
+let id o = o.id

src/lib/ast/leaf.mli

@@ -0,0 +1,17 @@
+(** A Leaf is an atomic exection unit the in the pipeline graph. *)
+
+type style = Command | Map
+type t [@@deriving sexp]
+
+val v : int -> Command.t -> style -> Datafile.t list -> Datafile.t list -> t
+(** Creats a new leaf node, taking an integer identifier, the command to execute
+      and a list of inputs and a list of outputs. *)
+
+val pp : t Fmt.t
+(** A pretty printer for leaves. *)
+
+val id : t -> int
+val command : t -> Command.t
+val command_style : t -> style
+val inputs : t -> Datafile.t list
+val outputs : t -> Datafile.t list

src/lib/dotrenderer.ml

@@ -12,7 +12,7 @@ type section_group = { name : string; children : Block.t list }
 let render_command_to_dot ppf command =
   (* let node_style = process_style node.style in *)
   (* TODO - some commands like littlejohn get different box styles*)
-  let process_index = Ast.Leaf.id command in
+  let process_index = Leaf.id command in
   List.iter
     (fun datafile ->
       let label =
@@ -22,19 +22,17 @@ let render_command_to_dot ppf command =
       in
       Format.fprintf ppf "\tn%d->n%d[penwidth=\"2.0\"%s];\n"
         (Datafile.id datafile) process_index label)
-    (Ast.Leaf.inputs command);
+    (Leaf.inputs command);
   let shape =
-    match Ast.Leaf.command_style command with
-    | Command -> "box"
-    | Map -> "box3d"
+    match Leaf.command_style command with Command -> "box" | Map -> "box3d"
   in
   Format.fprintf ppf "\tn%d[shape=\"%s\",label=\"%s\"];\n" process_index shape
-    (Uri.pct_encode (Command.name (Ast.Leaf.command command)));
+    (Uri.pct_encode (Command.name (Leaf.command command)));
   List.iter
     (fun datafile ->
       Format.fprintf ppf "\tn%d->n%d[penwidth=\"2.0\"];\n" process_index
         (Datafile.id datafile))
-    (Ast.Leaf.outputs command);
+    (Leaf.outputs command);
   Format.fprintf ppf "\n"
 
 let datafile_to_dot ppf datafile =
@@ -46,11 +44,10 @@ let render_ast_to_dot ppf ast : unit =
   Format.fprintf ppf "digraph{\n";
   List.concat_map
     (fun group ->
-      let commands = Ast.CommandGroup.children group in
+      let commands = Commandgroup.children group in
       List.concat_map
         (fun command ->
-          let inputs = Ast.Leaf.inputs command
-          and outputs = Ast.Leaf.outputs command in
+          let inputs = Leaf.inputs command and outputs = Leaf.outputs command in
           List.concat [ inputs; outputs ])
         commands)
     ast
@@ -59,8 +56,8 @@ let render_ast_to_dot ppf ast : unit =
 
   List.iteri
     (fun i group ->
-      let name = Ast.CommandGroup.name group
-      and commands = Ast.CommandGroup.children group in
+      let name = Commandgroup.name group
+      and commands = Commandgroup.children group in
       Format.fprintf ppf "subgraph \"cluster_%d\" {\n" i;
       Format.fprintf ppf "\tlabel = \"%s\"\n" name;
       List.iter (render_command_to_dot ppf) commands;
@@ -135,7 +132,7 @@ let render ~template_markdown =
         |> List.filter_map (fun c ->
                match Command.file_args c with [] -> None | _ -> Some c) ))
     sections
-  |> Ast.order_command_list metadata
+  |> Ast.order_command_list (Frontmatter.inputs metadata)
   |> Ast.to_list
   |> render_ast_to_dot Format.str_formatter;
   Format.flush_str_formatter ()

src/lib/dune

@@ -1,3 +1,5 @@
+(include_subdirs unqualified)
+
 (library
  (name shark)
  (libraries

src/lib/js/dune

@@ -1,3 +1,5 @@
+(include_subdirs no)
+
 (executable
  (name main)
  (modes js)