diff --git a/src/lib/ast.mli b/src/lib/ast.mli deleted file mode 100644 index 62154fea..00000000 --- a/src/lib/ast.mli +++ /dev/null @@ -1,53 +0,0 @@ -(** {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). *) - -module Leaf : sig - (** A Leaf is an atomic exection unit the in the pipeline graph. *) - - type style = Command | Map - type t - - 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 -end - -module CommandGroup : sig - (** A named basic-block in PL terms. *) - - type t - - 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 -end - -type t -(** An AST instance *) - -val order_command_list : Frontmatter.t -> (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. *) diff --git a/src/lib/ast.ml b/src/lib/ast/ast.ml similarity index 73% rename from src/lib/ast.ml rename to src/lib/ast/ast.ml index a256bbda..5c7d4fda 100644 --- a/src/lib/ast.ml +++ b/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 diff --git a/src/lib/ast/ast.mli b/src/lib/ast/ast.mli new file mode 100644 index 00000000..01952526 --- /dev/null +++ b/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. *) diff --git a/src/lib/command.ml b/src/lib/ast/command.ml similarity index 100% rename from src/lib/command.ml rename to src/lib/ast/command.ml diff --git a/src/lib/command.mli b/src/lib/ast/command.mli similarity index 100% rename from src/lib/command.mli rename to src/lib/ast/command.mli diff --git a/src/lib/ast/commandgroup.ml b/src/lib/ast/commandgroup.ml new file mode 100644 index 00000000..d9851b65 --- /dev/null +++ b/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 diff --git a/src/lib/ast/commandgroup.mli b/src/lib/ast/commandgroup.mli new file mode 100644 index 00000000..8b9b69f9 --- /dev/null +++ b/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 diff --git a/src/lib/datafile.ml b/src/lib/ast/datafile.ml similarity index 100% rename from src/lib/datafile.ml rename to src/lib/ast/datafile.ml diff --git a/src/lib/datafile.mli b/src/lib/ast/datafile.mli similarity index 100% rename from src/lib/datafile.mli rename to src/lib/ast/datafile.mli diff --git a/src/lib/ast/leaf.ml b/src/lib/ast/leaf.ml new file mode 100644 index 00000000..4c736046 --- /dev/null +++ b/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 diff --git a/src/lib/ast/leaf.mli b/src/lib/ast/leaf.mli new file mode 100644 index 00000000..be6aaddd --- /dev/null +++ b/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 diff --git a/src/lib/dotrenderer.ml b/src/lib/dotrenderer.ml index 99e81162..55fc29d3 100644 --- a/src/lib/dotrenderer.ml +++ b/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 () diff --git a/src/lib/dune b/src/lib/dune index 950be284..ee7e7fd3 100644 --- a/src/lib/dune +++ b/src/lib/dune @@ -1,3 +1,5 @@ +(include_subdirs unqualified) + (library (name shark) (libraries diff --git a/src/lib/js/dune b/src/lib/js/dune index 2e5fb0a9..e503d66e 100644 --- a/src/lib/js/dune +++ b/src/lib/js/dune @@ -1,3 +1,5 @@ +(include_subdirs no) + (executable (name main) (modes js)