From 2283f5cf53a8e5613d326b56fe218ca5b9f8bc92 Mon Sep 17 00:00:00 2001 From: Mafinar Khan Date: Sun, 19 Jul 2026 00:41:01 -0400 Subject: [PATCH 01/13] Update AGENTS.md - with DSL patterns --- AGENTS.md | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/AGENTS.md b/AGENTS.md index 632b256..719278e 100644 --- a/AGENTS.md +++ b/AGENTS.md @@ -108,6 +108,34 @@ Keep `CHANGELOG.md` up to date. Use the `[Unreleased]` section at the top with t Group related bullets. Mention new modules, significant behavior changes, new guides/livebooks, and new skills. +## API and DSL Philosophy + +Choreo's stable API should remain pipe-first and explicit. Builders such as +`Choreo.C4.add_container/3`, `Choreo.Dataflow.add_source/3`, and +`Choreo.Infrastructure.connect/4` are the canonical programmatic interface. + +Macro DSLs are valuable for sketches, examples, tests, and Livebook ergonomics, but they should incubate under +`Choreo.Lab.DSL.*` unless there is a strong reason to make them part of a stable domain module. Prefer this maturity path: + +```text +Choreo.Lab.DSL. + experimental / Livebook-friendly / sketch syntax + +→ maybe later + +Choreo..DSL or Choreo. + stable public API, only after the syntax and semantics prove durable +``` + +DSL design guardrails: + +- DSLs should compile down to existing stable builders and return ordinary Choreo structs. +- Do not replace or obscure the pipe API; document DSLs as convenience syntax. +- Keep DSL grammars small and strict: fail on unknown constructors or variables instead of silently creating odd models. +- Prefer variable-bound semantic nodes in Lab DSLs when labels/metadata matter, e.g. `api = service("API")` then `api ~> db`. +- Use pipe modifiers for edge metadata when possible, e.g. `api ~> db |> on("reads")`, and explicit forms like `edge api ~> db, label: "reads"` when clarity is needed. +- Avoid adding a generic cross-domain DSL engine to core Choreo unless multiple Lab DSLs converge on the same proven grammar. + ## Style Guidelines - Prefer small, coherent models over exhaustive ones. From f1e3d08f8e339c80a8671d2bf8550dd637aa890e Mon Sep 17 00:00:00 2001 From: Mafinar Khan Date: Sun, 19 Jul 2026 00:41:16 -0400 Subject: [PATCH 02/13] Add experimental infrastructure DSL --- CHANGELOG.md | 2 + lib/choreo/lab/dsl/infrastructure.ex | 348 ++++++++++++++++++++ test/choreo/lab/dsl/infrastructure_test.exs | 87 +++++ 3 files changed, 437 insertions(+) create mode 100644 lib/choreo/lab/dsl/infrastructure.ex create mode 100644 test/choreo/lab/dsl/infrastructure_test.exs diff --git a/CHANGELOG.md b/CHANGELOG.md index befc3cb..e8caf2c 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,8 @@ ### Added +- Added incubating `Choreo.Lab.DSL.Infrastructure` syntax for Livebook-friendly infrastructure sketches over the stable `Choreo` builders. + ### Changed ### Fixed diff --git a/lib/choreo/lab/dsl/infrastructure.ex b/lib/choreo/lab/dsl/infrastructure.ex new file mode 100644 index 0000000..a371498 --- /dev/null +++ b/lib/choreo/lab/dsl/infrastructure.ex @@ -0,0 +1,348 @@ +defmodule Choreo.Lab.DSL.Infrastructure do + @moduledoc """ + Experimental Livebook-friendly DSL for sketching infrastructure diagrams. + + This module is an incubating Lab syntax layer over the stable, pipe-first + `Choreo` infrastructure builders. It returns a normal `%Choreo{}` system, so + the result can be rendered and analysed with the same functions as any other + Choreo graph. + + The DSL is intentionally strict about references: bind nodes to variables and + reuse those variables in edges. Typos in labels render as written; typos in + variable names fail during macro expansion. + + ## Examples + + iex> import Choreo.Lab.DSL.Infrastructure + ...> system = infrastructure do + ...> client = user("API Client") + ...> api = gateway("API Gateway") + ...> redis = cache("Redis", kind: :redis) + ...> db = database("Postgres", kind: :postgres) + ...> + ...> client ~> api + ...> api ~> redis |> on("checks quota") + ...> edge api ~> db, with: "reads/writes" + ...> end + iex> system.graph.nodes[:api].label + "API Gateway" + iex> system.graph.nodes[:redis].node_type + :cache + iex> system.edge_meta |> Map.values() |> Enum.map(& &1.label) |> Enum.sort() + [nil, "checks quota", "reads/writes"] + + Supported node constructors: + + * `user/1`, `client/1` + * `gateway/1`, `load_balancer/1`, `lb/1` + * `service/1` + * `compute/1` + * `database/1`, `db/1` + * `managed_db/1` + * `cache/1` + * `queue/1` + * `storage/1`, `object_store/1` + * `internet/1` + * `network/1`, `external/1` + * `node/1`, `custom/1` + + Edge labels can use either pipe modifiers or the explicit `edge` form: + + api ~> db |> on("reads") + api ~> db |> label("reads") + edge api ~> db, label: "reads" + edge api ~> db, with: "reads" + """ + + @type node_decl :: %{id: Yog.node_id(), builder: atom(), opts: keyword()} + @type edge_decl :: %{from: Yog.node_id(), to: Yog.node_id(), opts: keyword()} + + @node_builders %{ + user: :add_user, + client: :add_user, + gateway: :add_load_balancer, + load_balancer: :add_load_balancer, + lb: :add_load_balancer, + service: :add_service, + compute: :add_compute, + database: :add_database, + db: :add_database, + managed_db: :add_managed_db, + cache: :add_cache, + queue: :add_queue, + storage: :add_storage, + object_store: :add_storage, + internet: :add_internet, + network: :add_network, + external: :add_network, + node: :add_node, + custom: :add_node + } + + @doc """ + Builds a `%Choreo{}` infrastructure sketch from a compact Lab DSL block. + """ + defmacro infrastructure(do: block) do + compile(block) + end + + defmacro infrastructure(opts, do: block) do + compile(block, opts) + end + + defp compile(block, opts \\ []) do + {steps, _env} = + block + |> statements() + |> Enum.reduce({[], %{}}, fn statement, {steps, env} -> + {statement_steps, env} = statement_steps(statement, env) + {steps ++ statement_steps, env} + end) + + Enum.reduce(steps, quote(do: Choreo.new(unquote(Macro.escape(opts)))), &pipe_step/2) + end + + defp statements({:__block__, _meta, list}), do: list + defp statements(nil), do: [] + defp statements(single), do: [single] + + # variable = constructor("Label", opts) + defp statement_steps({:=, meta, [{var, _, context}, constructor]}, env) + when is_atom(var) and is_atom(context) do + node = node_from_constructor(constructor, var, env, meta) + step = {:node, node} + {[step], Map.put(env, var, node.id)} + end + + # edge api ~> db, label: "reads" + defp statement_steps({:edge, meta, [edge_ast, opts]}, env) when is_list(opts) do + {edge, nodes} = edge_from_ast(edge_ast, normalize_edge_opts(opts), env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + # edge api ~> db + defp statement_steps({:edge, meta, [edge_ast]}, env) do + {edge, nodes} = edge_from_ast(edge_ast, [], env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + # api ~> db or api ~> db |> on("label") + defp statement_steps({:|>, _meta, _args} = ast, env) do + {edge, nodes} = edge_from_piped_ast(ast, env) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({:~>, meta, _args} = ast, env) do + {edge, nodes} = edge_from_ast(ast, [], env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + # inline node declaration, e.g. service("API") + defp statement_steps({name, meta, args} = ast, env) when is_atom(name) and is_list(args) do + if Map.has_key?(@node_builders, name) do + node = node_from_constructor(ast, nil, env, meta) + {[{:node, node}], env} + else + unsupported_statement!(ast, meta) + end + end + + defp statement_steps(other, _env) do + unsupported_statement!(other, nil) + end + + defp edge_declaration_steps(nodes, edge) do + nodes + |> Enum.reduce([{:edge, edge}], fn node, steps -> [{:node, node} | steps] end) + |> Enum.reverse() + end + + defp edge_from_piped_ast(ast, env) do + {base, modifiers} = unwrap_pipe(ast, []) + opts = modifiers |> Enum.reduce([], &modifier_opt/2) |> normalize_edge_opts() + edge_from_ast(base, opts, env, line_meta(base)) + end + + defp unwrap_pipe({:|>, _meta, [left, right]}, acc), do: unwrap_pipe(left, [right | acc]) + defp unwrap_pipe(base, acc), do: {base, acc} + + defp modifier_opt({name, _meta, [value]}, acc) when name in [:on, :label] do + Keyword.put(acc, :label, value) + end + + defp modifier_opt(other, _acc) do + raise ArgumentError, + "unsupported infrastructure edge modifier: #{Macro.to_string(other)}; " <> + "use `on(value)` or `label(value)`" + end + + defp edge_from_ast({:~>, meta, [from_ast, to_ast]}, opts, env, _statement_meta) do + {from, from_node} = endpoint_id(from_ast, env, meta) + {to, to_node} = endpoint_id(to_ast, env, meta) + nodes = [from_node, to_node] |> Enum.reject(&is_nil/1) |> Enum.uniq_by(& &1.id) + + {%{from: from, to: to, opts: opts}, nodes} + end + + defp edge_from_ast(other, _opts, _env, meta) do + raise ArgumentError, + "expected `from ~> to` in infrastructure DSL, got #{Macro.to_string(other)}" <> + line_suffix(meta) + end + + defp endpoint_id({var, _meta, context}, env, meta) when is_atom(var) and is_atom(context) do + case Map.fetch(env, var) do + {:ok, id} -> + {id, nil} + + :error -> + raise ArgumentError, "unknown infrastructure node variable `#{var}`#{line_suffix(meta)}" + end + end + + defp endpoint_id({name, meta, args} = constructor, env, _statement_meta) + when is_atom(name) and is_list(args) do + if Map.has_key?(@node_builders, name) do + node = node_from_constructor(constructor, nil, env, meta) + {node.id, node} + else + raise ArgumentError, + "unknown infrastructure node constructor `#{name}`#{line_suffix(meta)}" + end + end + + defp endpoint_id(other, _env, meta) do + raise ArgumentError, + "unsupported infrastructure edge endpoint #{Macro.to_string(other)}#{line_suffix(meta)}; " <> + "bind a node first, e.g. `api = service(\"API\")`" + end + + defp node_from_constructor({name, meta, args}, var, _env, _statement_meta) + when is_atom(name) and is_list(args) do + builder = + Map.get(@node_builders, name) || + raise ArgumentError, + "unknown infrastructure node constructor `#{name}`#{line_suffix(meta)}" + + {opts, positional} = pop_trailing_opts(args) + + {id, opts} = node_id_and_opts(var, positional, opts, meta) + %{id: id, builder: builder, opts: opts} + end + + defp node_from_constructor(other, _var, _env, meta) do + raise ArgumentError, + "expected infrastructure node constructor, got #{Macro.to_string(other)}#{line_suffix(meta)}" + end + + defp pop_trailing_opts(args) do + case List.last(args) do + last when is_list(last) -> + if Keyword.keyword?(last), do: {last, Enum.drop(args, -1)}, else: {[], args} + + _other -> + {[], args} + end + end + + defp node_id_and_opts(var, positional, opts, meta) do + {explicit_id, opts} = Keyword.pop(opts, :id) + + cond do + length(positional) > 1 -> + raise ArgumentError, + "node constructors take at most one positional label/id#{line_suffix(meta)}" + + explicit_id != nil -> + {explicit_id, maybe_put_label(opts, List.first(positional))} + + var != nil -> + {var, maybe_put_label(opts, List.first(positional))} + + positional != [] -> + label_or_id = List.first(positional) + {id_from_label(label_or_id), maybe_put_label(opts, label_or_id)} + + true -> + raise ArgumentError, + "inline infrastructure node constructors need a label/id or `id:` option#{line_suffix(meta)}" + end + end + + defp maybe_put_label(opts, nil), do: opts + + defp maybe_put_label(opts, label) when is_binary(label), + do: Keyword.put_new(opts, :label, label) + + defp maybe_put_label(opts, label) when is_atom(label), + do: Keyword.put_new(opts, :label, to_string(label)) + + defp maybe_put_label(opts, _other), do: opts + + defp id_from_label(id) when is_atom(id), do: id + defp id_from_label(id) when is_binary(id), do: slug_atom(id) + + defp id_from_label(other) do + raise ArgumentError, + "inline infrastructure node label/id must be a string or atom, got #{inspect(other)}" + end + + defp slug_atom(label) do + label + |> String.downcase() + |> String.replace(~r/[^a-z0-9]+/u, "_") + |> String.trim("_") + |> case do + "" -> raise ArgumentError, "cannot derive an infrastructure node id from an empty label" + slug -> String.to_atom(slug) + end + end + + defp normalize_edge_opts(opts) do + {with_label, opts} = Keyword.pop(opts, :with) + + if with_label != nil do + Keyword.put_new(opts, :label, with_label) + else + opts + end + end + + defp pipe_step({:node, %{id: id, builder: builder, opts: opts}}, acc) do + quote do + apply(Choreo, unquote(builder), [ + unquote(acc), + unquote(Macro.escape(id)), + unquote(Macro.escape(opts)) + ]) + end + end + + defp pipe_step({:edge, %{from: from, to: to, opts: opts}}, acc) do + quote do + Choreo.connect( + unquote(acc), + unquote(Macro.escape(from)), + unquote(Macro.escape(to)), + unquote(Macro.escape(opts)) + ) + end + end + + defp unsupported_statement!(ast, meta) do + raise ArgumentError, + "unsupported statement in infrastructure DSL: #{Macro.to_string(ast)}#{line_suffix(meta)}" + end + + defp line_meta({_name, meta, _args}) when is_list(meta), do: meta + defp line_meta(_other), do: [] + + defp line_suffix(meta) when is_list(meta) do + case Keyword.get(meta, :line) do + nil -> "" + line -> " (line #{line})" + end + end + + defp line_suffix(_meta), do: "" +end diff --git a/test/choreo/lab/dsl/infrastructure_test.exs b/test/choreo/lab/dsl/infrastructure_test.exs new file mode 100644 index 0000000..818ae6b --- /dev/null +++ b/test/choreo/lab/dsl/infrastructure_test.exs @@ -0,0 +1,87 @@ +defmodule Choreo.Lab.InfrastructureDSLTest do + use ExUnit.Case, async: true + + import Choreo.Lab.DSL.Infrastructure + + doctest Choreo.Lab.DSL.Infrastructure + + test "builds an infrastructure sketch with variable-bound nodes" do + system = + infrastructure do + client = user("API Client") + gateway = gateway("API Gateway") + router = service("Tenant Router") + policy = service("Policy Engine") + redis = cache("Redis", kind: :redis) + tenant_db = database("Tenant Metadata DB", kind: :postgres) + audit_events = queue("Audit Events", kind: :kafka) + audit_worker = compute("Audit Worker") + audit_db = database("Audit Log DB") + + client ~> gateway + gateway ~> redis |> on("checks quota") + gateway ~> router |> label("routes request") + router ~> policy + router ~> tenant_db + gateway ~> audit_events |> on("writes audit event") + audit_events ~> audit_worker + edge(audit_worker ~> audit_db, with: "persists") + end + + assert system.graph.nodes[:client].node_type == :user + assert system.graph.nodes[:gateway].node_type == :load_balancer + assert system.graph.nodes[:router].label == "Tenant Router" + assert system.graph.nodes[:redis].kind == :redis + assert system.graph.nodes[:tenant_db].node_type == :database + + labels = system.edge_meta |> Map.values() |> Enum.map(& &1.label) + assert "checks quota" in labels + assert "routes request" in labels + assert "writes audit event" in labels + assert "persists" in labels + assert Enum.count(Choreo.edges(system)) == 8 + end + + test "supports inline constructors for one-off sketches" do + system = + infrastructure do + database("Postgres") ~> cache("Redis") |> on("warms") + end + + assert system.graph.nodes[:postgres].label == "Postgres" + assert system.graph.nodes[:redis].node_type == :cache + assert [{:postgres, :redis, 1}] = Choreo.edges(system) + assert [meta] = Map.values(system.edge_meta) + assert meta.label == "warms" + end + + test "supports id option while keeping display label" do + system = + infrastructure do + api = service("Public API", id: :public_api) + db = database("Postgres") + + edge(api ~> db, label: "reads") + end + + assert system.graph.nodes[:public_api].label == "Public API" + assert [{:public_api, :db, 1}] = Choreo.edges(system) + assert [meta] = Map.values(system.edge_meta) + assert meta.label == "reads" + end + + test "raises on unknown node variables" do + assert_raise ArgumentError, ~r/unknown infrastructure node variable `db`/, fn -> + Code.eval_quoted( + quote do + import Choreo.Lab.DSL.Infrastructure + + infrastructure do + api = service("API") + api ~> db + end + end + ) + end + end +end From e31fc53d056659b11c965020a6fbdc4b1ff7ddbc Mon Sep 17 00:00:00 2001 From: Mafinar Khan Date: Sun, 19 Jul 2026 01:17:34 -0400 Subject: [PATCH 03/13] Add Lab view helpers --- CHANGELOG.md | 1 + lib/choreo/lab/dsl/infrastructure.ex | 51 +++++ lib/choreo/lab/view.ex | 233 ++++++++++++++++++++ test/choreo/lab/dsl/infrastructure_test.exs | 11 + test/choreo/lab/view_test.exs | 98 ++++++++ 5 files changed, 394 insertions(+) create mode 100644 lib/choreo/lab/view.ex create mode 100644 test/choreo/lab/view_test.exs diff --git a/CHANGELOG.md b/CHANGELOG.md index e8caf2c..c0271cc 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,7 @@ ### Added - Added incubating `Choreo.Lab.DSL.Infrastructure` syntax for Livebook-friendly infrastructure sketches over the stable `Choreo` builders. +- Added `Choreo.Lab.View` pipe-friendly helpers for Livebook zoom, focus, filter, path, and collapse exploration over `Choreo.View`. ### Changed diff --git a/lib/choreo/lab/dsl/infrastructure.ex b/lib/choreo/lab/dsl/infrastructure.ex index a371498..a8f59e5 100644 --- a/lib/choreo/lab/dsl/infrastructure.ex +++ b/lib/choreo/lab/dsl/infrastructure.ex @@ -57,6 +57,28 @@ defmodule Choreo.Lab.DSL.Infrastructure do @type node_decl :: %{id: Yog.node_id(), builder: atom(), opts: keyword()} @type edge_decl :: %{from: Yog.node_id(), to: Yog.node_id(), opts: keyword()} + @node_verbs [ + :user, + :client, + :gateway, + :load_balancer, + :lb, + :service, + :compute, + :database, + :db, + :managed_db, + :cache, + :queue, + :storage, + :object_store, + :internet, + :network, + :external, + :node, + :custom + ] + @node_builders %{ user: :add_user, client: :add_user, @@ -79,6 +101,35 @@ defmodule Choreo.Lab.DSL.Infrastructure do custom: :add_node } + @doc """ + Returns the vocabulary supported by the infrastructure DSL. + + This is meant as a lightweight Livebook discovery helper when autocomplete is + not enough. + + iex> verbs = Choreo.Lab.DSL.Infrastructure.verbs() + iex> :service in verbs.nodes + true + iex> :~> in verbs.edges + true + iex> :on in verbs.modifiers + true + """ + @spec verbs() :: %{ + nodes: [atom()], + edges: [atom()], + modifiers: [atom()], + options: [atom()] + } + def verbs do + %{ + nodes: @node_verbs, + edges: [:~>, :edge], + modifiers: [:on, :label], + options: [:label, :with, :id, :kind, :cluster, :description] + } + end + @doc """ Builds a `%Choreo{}` infrastructure sketch from a compact Lab DSL block. """ diff --git a/lib/choreo/lab/view.ex b/lib/choreo/lab/view.ex new file mode 100644 index 0000000..cf1c35a --- /dev/null +++ b/lib/choreo/lab/view.ex @@ -0,0 +1,233 @@ +defmodule Choreo.Lab.View do + @moduledoc """ + Pipe-friendly view helpers for exploring Choreo models in Livebook. + + This module is ordinary Elixir, not a macro DSL. It is a thin convenience + layer over `Choreo.View` that keeps the stable view API intact while making + common zoom, focus, filter, path, and collapse operations easier to compose in + pipelines. + + `Choreo.View` remains the primitive graph-lens API. `Choreo.Lab.View` is the + ergonomic exploration API: a place to try friendlier names, positional forms, + and common predicates before deciding whether any of them should graduate into + core `Choreo.View`. + + Prefer alias-qualified usage for better editor autocomplete: + + alias Choreo.Lab.View + + system + |> View.zoom(1) + |> View.only_type([:service, :database, :cache]) + |> View.focus(:api, depth: 2) + + The functions return ordinary Choreo structs rebuilt through the + `Choreo.Viewable` protocol. + """ + + @type viewable :: struct() + @type node_id :: Yog.node_id() + @type node_type :: atom() + + @doc """ + Returns the view helper vocabulary for Livebook discovery. + + iex> verbs = Choreo.Lab.View.verbs() + iex> :zoom in verbs.transforms + true + iex> :only_type in verbs.filters + true + iex> :collapse_type in verbs.collapse + true + """ + @spec verbs() :: %{ + transforms: [atom()], + filters: [atom()], + collapse: [atom()], + options: [atom()] + } + def verbs do + %{ + transforms: [:zoom, :focus, :neighborhood, :between, :path, :trace], + filters: [:only, :without, :only_nodes, :without_nodes, :only_type, :without_type], + collapse: [:collapse_nodes, :collapse_type], + options: [:depth, :radius, :mode, :transitive, :label, :data] + } + end + + @doc """ + Applies `Choreo.View.zoom/2` with a positional level. + + iex> system = Choreo.new() |> Choreo.add_service(:api) |> Choreo.add_database(:db) + iex> system |> Choreo.Lab.View.zoom(0) |> Choreo.nodes() + %{api: %{label: "api", node_type: :service}} + """ + @spec zoom(viewable(), non_neg_integer(), keyword()) :: viewable() + def zoom(diagram, level, opts \\ []) when is_struct(diagram) do + Choreo.View.zoom(diagram, Keyword.put(opts, :level, level)) + end + + @doc """ + Keeps `node` and its surrounding neighbourhood. + + Accepts either `:depth` or `:radius`; both map to `Choreo.View.focus/3`'s + `:radius` option. `:mode` may be `:neighbors`, `:successors`, or + `:predecessors`. + """ + @spec focus(viewable(), node_id(), keyword()) :: viewable() + def focus(diagram, node, opts \\ []) when is_struct(diagram) do + Choreo.View.focus(diagram, node, normalize_focus_opts(opts)) + end + + @doc """ + Alias for `focus/3` that reads naturally in exploratory pipelines. + """ + @spec neighborhood(viewable(), node_id(), keyword()) :: viewable() + def neighborhood(diagram, node, opts \\ []), do: focus(diagram, node, opts) + + @doc """ + Keeps the shortest path between two nodes, optionally with surrounding radius. + """ + @spec between(viewable(), node_id(), node_id(), keyword()) :: viewable() + def between(diagram, from, to, opts \\ []) when is_struct(diagram) do + Choreo.View.focus_between(diagram, from, to, normalize_focus_opts(opts)) + end + + @doc """ + Alias for `between/4`. + """ + @spec path(viewable(), node_id(), node_id(), keyword()) :: viewable() + def path(diagram, from, to, opts \\ []), do: between(diagram, from, to, opts) + + @doc """ + Keeps a trace path between two nodes using `Choreo.View.focus_trace/4`. + """ + @spec trace(viewable(), node_id(), node_id(), keyword()) :: viewable() + def trace(diagram, from, to, opts \\ []) when is_struct(diagram) do + Choreo.View.focus_trace(diagram, from, to, normalize_focus_opts(opts)) + end + + @doc """ + Keeps only the listed node IDs. + """ + @spec only_nodes(viewable(), node_id() | [node_id()], keyword()) :: viewable() + def only_nodes(diagram, ids, opts \\ []) when is_struct(diagram) do + keep = ids |> List.wrap() |> MapSet.new() + Choreo.View.filter(diagram, fn id, _data -> MapSet.member?(keep, id) end, opts) + end + + @doc """ + Removes the listed node IDs. + """ + @spec without_nodes(viewable(), node_id() | [node_id()], keyword()) :: viewable() + def without_nodes(diagram, ids, opts \\ []) when is_struct(diagram) do + remove = ids |> List.wrap() |> MapSet.new() + Choreo.View.filter(diagram, fn id, _data -> not MapSet.member?(remove, id) end, opts) + end + + @doc """ + Keeps only nodes whose `:node_type` or `:type` matches the given type(s). + """ + @spec only_type(viewable(), node_type() | [node_type()], keyword()) :: viewable() + def only_type(diagram, types, opts \\ []) when is_struct(diagram) do + keep = types |> List.wrap() |> MapSet.new() + + Choreo.View.filter( + diagram, + fn _id, data -> MapSet.member?(keep, semantic_type(data)) end, + opts + ) + end + + @doc """ + Removes nodes whose `:node_type` or `:type` matches the given type(s). + """ + @spec without_type(viewable(), node_type() | [node_type()], keyword()) :: viewable() + def without_type(diagram, types, opts \\ []) when is_struct(diagram) do + remove = types |> List.wrap() |> MapSet.new() + + Choreo.View.filter( + diagram, + fn _id, data -> not MapSet.member?(remove, semantic_type(data)) end, + opts + ) + end + + @doc """ + Generic keep filter for small Livebook experiments. + + Supported options: + + * `:nodes` — node ID or IDs to keep + * `:type` / `:types` — semantic node type or types to keep + + When both are supplied, a node may match either condition. + """ + @spec only(viewable(), keyword()) :: viewable() + def only(diagram, opts) when is_struct(diagram) and is_list(opts) do + node_set = opts |> Keyword.get(:nodes, []) |> List.wrap() |> MapSet.new() + + type_set = + opts |> Keyword.get(:type, Keyword.get(opts, :types, [])) |> List.wrap() |> MapSet.new() + + Choreo.View.filter(diagram, fn id, data -> + MapSet.member?(node_set, id) or MapSet.member?(type_set, semantic_type(data)) + end) + end + + @doc """ + Generic remove filter for small Livebook experiments. + + Supported options mirror `only/2`. + """ + @spec without(viewable(), keyword()) :: viewable() + def without(diagram, opts) when is_struct(diagram) and is_list(opts) do + node_set = opts |> Keyword.get(:nodes, []) |> List.wrap() |> MapSet.new() + + type_set = + opts |> Keyword.get(:type, Keyword.get(opts, :types, [])) |> List.wrap() |> MapSet.new() + + Choreo.View.filter(diagram, fn id, data -> + not (MapSet.member?(node_set, id) or MapSet.member?(type_set, semantic_type(data))) + end) + end + + @doc """ + Collapses the listed node IDs into `new_id`. + """ + @spec collapse_nodes(viewable(), node_id() | [node_id()], node_id(), keyword()) :: viewable() + def collapse_nodes(diagram, ids, new_id, opts \\ []) when is_struct(diagram) do + collapse_set = ids |> List.wrap() |> MapSet.new() + + Choreo.View.collapse( + diagram, + fn id, _data -> MapSet.member?(collapse_set, id) end, + new_id, + opts + ) + end + + @doc """ + Collapses all nodes of the given type(s) into `new_id`. + """ + @spec collapse_type(viewable(), node_type() | [node_type()], node_id(), keyword()) :: viewable() + def collapse_type(diagram, types, new_id, opts \\ []) when is_struct(diagram) do + collapse_set = types |> List.wrap() |> MapSet.new() + + Choreo.View.collapse( + diagram, + fn _id, data -> MapSet.member?(collapse_set, semantic_type(data)) end, + new_id, + opts + ) + end + + defp normalize_focus_opts(opts) do + case Keyword.pop(opts, :depth) do + {nil, opts} -> opts + {depth, opts} -> Keyword.put_new(opts, :radius, depth) + end + end + + defp semantic_type(data), do: data[:node_type] || data[:type] +end diff --git a/test/choreo/lab/dsl/infrastructure_test.exs b/test/choreo/lab/dsl/infrastructure_test.exs index 818ae6b..8878b63 100644 --- a/test/choreo/lab/dsl/infrastructure_test.exs +++ b/test/choreo/lab/dsl/infrastructure_test.exs @@ -5,6 +5,17 @@ defmodule Choreo.Lab.InfrastructureDSLTest do doctest Choreo.Lab.DSL.Infrastructure + test "verbs returns the Livebook discovery vocabulary" do + verbs = Choreo.Lab.DSL.Infrastructure.verbs() + + assert :service in verbs.nodes + assert :database in verbs.nodes + assert :~> in verbs.edges + assert :edge in verbs.edges + assert :on in verbs.modifiers + assert :with in verbs.options + end + test "builds an infrastructure sketch with variable-bound nodes" do system = infrastructure do diff --git a/test/choreo/lab/view_test.exs b/test/choreo/lab/view_test.exs new file mode 100644 index 0000000..ad73938 --- /dev/null +++ b/test/choreo/lab/view_test.exs @@ -0,0 +1,98 @@ +defmodule Choreo.Lab.ViewTest do + use ExUnit.Case, async: true + + import Choreo.Lab.DSL.Infrastructure + + alias Choreo.Lab.View + + doctest Choreo.Lab.View + + test "verbs returns the Livebook discovery vocabulary" do + verbs = View.verbs() + + assert :zoom in verbs.transforms + assert :focus in verbs.transforms + assert :only_type in verbs.filters + assert :without_nodes in verbs.filters + assert :collapse_type in verbs.collapse + end + + test "zoom is pipe friendly" do + system = sample_system() + + zoomed = View.zoom(system, 1) + + assert Enum.sort(Map.keys(Choreo.nodes(zoomed))) == [:db, :policy, :redis, :router] + end + + test "focus accepts depth as a friendlier radius alias" do + system = sample_system() + + focused = View.focus(system, :router, depth: 1) + + assert Enum.sort(Map.keys(Choreo.nodes(focused))) == [:api, :db, :policy, :router] + end + + test "between and path keep shortest paths" do + system = sample_system() + + between = View.between(system, :client, :db) + path = View.path(system, :client, :db) + + assert Enum.sort(Map.keys(Choreo.nodes(between))) == [:api, :client, :db, :router] + assert Enum.sort(Map.keys(Choreo.nodes(path))) == [:api, :client, :db, :router] + end + + test "only and without filters support nodes and types" do + system = sample_system() + + only = View.only(system, type: [:service], nodes: [:db]) + without = View.without(system, type: [:cache], nodes: [:client]) + + assert Enum.sort(Map.keys(Choreo.nodes(only))) == [:db, :policy, :router] + refute Map.has_key?(Choreo.nodes(without), :redis) + refute Map.has_key?(Choreo.nodes(without), :client) + end + + test "specific type and node filters are pipe friendly" do + system = sample_system() + + service_view = View.only_type(system, :service) + no_policy = View.without_nodes(system, :policy) + + assert Enum.sort(Map.keys(Choreo.nodes(service_view))) == [:policy, :router] + refute Map.has_key?(Choreo.nodes(no_policy), :policy) + end + + test "collapse helpers aggregate nodes" do + system = sample_system() + + collapsed_nodes = View.collapse_nodes(system, [:redis, :db], :state, label: "State") + collapsed_type = View.collapse_type(system, :service, :services, label: "Services") + + assert Map.has_key?(Choreo.nodes(collapsed_nodes), :state) + refute Map.has_key?(Choreo.nodes(collapsed_nodes), :redis) + refute Map.has_key?(Choreo.nodes(collapsed_nodes), :db) + + assert Map.has_key?(Choreo.nodes(collapsed_type), :services) + refute Map.has_key?(Choreo.nodes(collapsed_type), :router) + refute Map.has_key?(Choreo.nodes(collapsed_type), :policy) + end + + defp sample_system do + infrastructure do + client = user("API Client") + api = gateway("API Gateway") + router = service("Tenant Router") + policy = service("Policy Engine") + redis = cache("Redis", kind: :redis) + db = database("Postgres", kind: :postgres) + + client ~> api + api ~> redis |> on("checks quota") + api ~> router |> on("routes") + router ~> policy + router ~> db |> on("reads") + end + end +end From 8b87eac0e59db596db100c5792276d268076a826 Mon Sep 17 00:00:00 2001 From: Mafinar Khan Date: Sun, 19 Jul 2026 02:11:49 -0400 Subject: [PATCH 04/13] Add Lab FSM and compose helpers --- .formatter.exs | 4 + CHANGELOG.md | 4 +- lib/choreo/lab/compose.ex | 156 +++++++++ lib/choreo/lab/dsl/fsm.ex | 350 ++++++++++++++++++++ lib/choreo/lab/dsl/infrastructure.ex | 178 +++++++++- test/choreo/lab/compose_test.exs | 73 ++++ test/choreo/lab/composition_test.exs | 66 ++++ test/choreo/lab/dsl/fsm_test.exs | 100 ++++++ test/choreo/lab/dsl/infrastructure_test.exs | 68 +++- 9 files changed, 983 insertions(+), 16 deletions(-) create mode 100644 lib/choreo/lab/compose.ex create mode 100644 lib/choreo/lab/dsl/fsm.ex create mode 100644 test/choreo/lab/compose_test.exs create mode 100644 test/choreo/lab/composition_test.exs create mode 100644 test/choreo/lab/dsl/fsm_test.exs diff --git a/.formatter.exs b/.formatter.exs index 56de6cd..95597b6 100644 --- a/.formatter.exs +++ b/.formatter.exs @@ -3,5 +3,9 @@ inputs: [ "{mix,.formatter}.exs", "{config,lib,test}/**/*.{ex,exs}" + ], + locals_without_parens: [ + edge: 1, + edge: 2 ] ] diff --git a/CHANGELOG.md b/CHANGELOG.md index c0271cc..4137cdc 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,8 +4,10 @@ ### Added -- Added incubating `Choreo.Lab.DSL.Infrastructure` syntax for Livebook-friendly infrastructure sketches over the stable `Choreo` builders. +- Added incubating `Choreo.Lab.DSL.Infrastructure` syntax for Livebook-friendly infrastructure sketches over the stable `Choreo` builders, including bindable cluster constructors for VPCs and subnets. +- Added incubating `Choreo.Lab.DSL.FSM` syntax for variable-bound finite-state-machine sketches over the stable `Choreo.FSM` builders. - Added `Choreo.Lab.View` pipe-friendly helpers for Livebook zoom, focus, filter, path, and collapse exploration over `Choreo.View`. +- Added `Choreo.Lab.Compose` pipe-friendly helpers for Livebook cluster, embed, connect, and trace composition over `Choreo`. ### Changed diff --git a/lib/choreo/lab/compose.ex b/lib/choreo/lab/compose.ex new file mode 100644 index 0000000..28cd424 --- /dev/null +++ b/lib/choreo/lab/compose.ex @@ -0,0 +1,156 @@ +defmodule Choreo.Lab.Compose do + @moduledoc """ + Pipe-friendly composition helpers for assembling Choreo models in Livebook. + + This module is ordinary Elixir, not a macro DSL. It is a thin convenience + layer over the stable composition primitives in `Choreo`: clusters, embedding, + normal graph connections, and semantic trace links. + + `Choreo` remains the primitive composition API. `Choreo.Lab.Compose` is the + ergonomic exploration API for building larger composed models from smaller + Choreo diagrams. + + Prefer alias-qualified usage for better editor autocomplete: + + alias Choreo.Lab.Compose + + Choreo.new() + |> Compose.cluster("system", label: "System") + |> Compose.embed(infra, into: "system", as: :infra) + |> Compose.embed(auth_fsm, into: "system", as: :auth) + |> Compose.trace(:infra_auth, :auth_unauthenticated, :executes) + + `connect/4` creates a normal visible relationship. `trace/4` creates a + semantic cross-model relationship that `Choreo.Analysis.Tracing` and + `Choreo.View.focus_trace/4` can follow. + """ + + @type system :: Choreo.t() + @type node_id :: Yog.node_id() + @type cluster_id :: String.t() | atom() + + @doc """ + Returns the composition helper vocabulary for Livebook discovery. + + iex> verbs = Choreo.Lab.Compose.verbs() + iex> :embed in verbs.structure + true + iex> :trace in verbs.links + true + iex> :as in verbs.options + true + """ + @spec verbs() :: %{ + structure: [atom()], + links: [atom()], + options: [atom()] + } + def verbs do + %{ + structure: [:cluster, :embed], + links: [:connect, :trace], + options: [:into, :as, :prefix, :label, :type] + } + end + + @doc """ + Adds a visual cluster/grouping boundary to a composed system. + + iex> system = Choreo.new() |> Choreo.Lab.Compose.cluster(:auth, label: "Auth") + iex> Map.has_key?(system.clusters, "cluster_auth") + true + """ + @spec cluster(system(), cluster_id(), keyword()) :: system() + def cluster(%Choreo{} = system, name, opts \\ []) do + Choreo.add_cluster(system, name, opts) + end + + @doc """ + Embeds a child diagram into a cluster of the parent system. + + Required options: + + * `:into` — target cluster name/id + + Prefix options: + + * `:as` — friendly alias converted to a prefix with a trailing underscore + * `:prefix` — explicit prefix passed through to `Choreo.embed/4` + + `:prefix` wins over `:as` when both are supplied. + + iex> child = Choreo.new() |> Choreo.add_service(:api) + iex> system = + ...> Choreo.new() + ...> |> Choreo.Lab.Compose.cluster(:system) + ...> |> Choreo.Lab.Compose.embed(child, into: :system, as: :child) + iex> Map.has_key?(Choreo.nodes(system), :child_api) + true + """ + @spec embed(system(), struct(), keyword()) :: system() + def embed(%Choreo{} = system, child, opts) when is_struct(child) and is_list(opts) do + into = Keyword.fetch!(opts, :into) + prefix = embed_prefix(opts) + Choreo.embed(system, child, into, prefix: prefix) + end + + @doc """ + Connects two nodes with a normal visible relationship. + + The third argument may be a label string, a keyword list, or omitted. + + iex> system = + ...> Choreo.new() + ...> |> Choreo.add_service(:api) + ...> |> Choreo.add_database(:db) + ...> |> Choreo.Lab.Compose.connect(:api, :db, "reads") + iex> [{:api, :db, _weight, meta}] = Choreo.edges_with_meta(system) + iex> meta.label + "reads" + """ + @spec connect(system(), node_id(), node_id(), String.t() | keyword()) :: system() + def connect(%Choreo{} = system, from, to, label_or_opts \\ []) do + Choreo.connect(system, from, to, normalize_label_or_opts(label_or_opts)) + end + + @doc """ + Adds a semantic trace relationship between two nodes. + + The fourth argument may be a trace type atom, a keyword list, or omitted. + + iex> system = + ...> Choreo.new() + ...> |> Choreo.add_service(:api) + ...> |> Choreo.add_service(:auth) + ...> |> Choreo.Lab.Compose.trace(:api, :auth, :executes) + iex> [{:api, :auth, _weight, meta}] = Choreo.edges_with_meta(system) + iex> {meta.edge_type, meta.type, meta.label} + {:trace, :executes, "executes"} + """ + @spec trace(system(), node_id(), node_id(), atom() | keyword()) :: system() + def trace(%Choreo{} = system, from, to, type_or_opts \\ []) do + Choreo.trace(system, from, to, normalize_type_or_opts(type_or_opts)) + end + + defp embed_prefix(opts) do + cond do + prefix = Keyword.get(opts, :prefix) -> + to_string(prefix) + + as = Keyword.get(opts, :as) -> + as + |> to_string() + |> String.trim_trailing("_") + |> Kernel.<>("_") + + true -> + "sub_" + end + end + + defp normalize_label_or_opts(label) when is_binary(label), do: [label: label] + defp normalize_label_or_opts(opts) when is_list(opts), do: opts + + defp normalize_type_or_opts(type) when is_atom(type), do: [type: type] + defp normalize_type_or_opts(opts) when is_list(opts), do: opts +end diff --git a/lib/choreo/lab/dsl/fsm.ex b/lib/choreo/lab/dsl/fsm.ex new file mode 100644 index 0000000..ff22ec8 --- /dev/null +++ b/lib/choreo/lab/dsl/fsm.ex @@ -0,0 +1,350 @@ +defmodule Choreo.Lab.DSL.FSM do + @moduledoc """ + Experimental Livebook-friendly DSL for sketching finite-state machines. + + This Lab DSL compiles to the stable, pipe-first `Choreo.FSM` builders and + returns an ordinary `%Choreo.FSM{}`. It follows the same identity rule as the + infrastructure Lab DSL: in assignment form, the variable name becomes the node + id and the string becomes the display label; in inline form, the string is + slugged into an id and also used as the label. + + ## Examples + + iex> import Choreo.Lab.DSL.FSM + ...> machine = fsm do + ...> idle = initial("Idle") + ...> authorized = state("Authorized") + ...> denied = final("Denied") + ...> + ...> idle ~> authorized |> on("token valid") + ...> edge idle ~> denied, with: "token invalid" + ...> end + iex> Choreo.FSM.initial_state(machine) + :idle + iex> Choreo.FSM.final_states(machine) + [:denied] + iex> Choreo.FSM.transitions(machine) |> Enum.sort() + [{:idle, :authorized, "token valid"}, {:idle, :denied, "token invalid"}] + + Transition labels can use pipe modifiers or the explicit `edge` form: + + idle ~> authorized |> on("token valid") + idle ~> authorized |> label("token valid") + idle ~> authorized |> guard("claims.tenant == request.tenant") + edge idle ~> denied, "token invalid" + edge idle ~> denied, with: "token invalid" + edge idle ~> denied, label: "token invalid" + """ + + @type state_decl :: %{id: Yog.node_id(), builder: atom(), opts: keyword()} + @type transition_decl :: %{from: Yog.node_id(), to: Yog.node_id(), opts: keyword()} + + @state_verbs [:state, :initial, :init, :start, :final, :done] + + @state_builders %{ + state: :add_state, + initial: :add_initial_state, + init: :add_initial_state, + start: :add_initial_state, + final: :add_final_state, + done: :add_final_state + } + + @doc """ + Returns the vocabulary supported by the FSM DSL. + + iex> verbs = Choreo.Lab.DSL.FSM.verbs() + iex> :initial in verbs.states + true + iex> :~> in verbs.edges + true + iex> :guard in verbs.modifiers + true + """ + @spec verbs() :: %{ + states: [atom()], + edges: [atom()], + modifiers: [atom()], + options: [atom()] + } + def verbs do + %{ + states: @state_verbs, + edges: [:~>, :edge], + modifiers: [:on, :label, :guard], + options: [:label, :with, :guard, :id] + } + end + + @doc """ + Builds a `%Choreo.FSM{}` from a compact Lab DSL block. + """ + defmacro fsm(do: block) do + compile(block) + end + + defmacro fsm(opts, do: block) do + compile(block, opts) + end + + defp compile(block, opts \\ []) do + {steps, _env} = + block + |> statements() + |> Enum.reduce({[], %{}}, fn statement, {steps, env} -> + {statement_steps, env} = statement_steps(statement, env) + {steps ++ statement_steps, env} + end) + + Enum.reduce(steps, quote(do: Choreo.FSM.new(unquote(Macro.escape(opts)))), &pipe_step/2) + end + + defp statements({:__block__, _meta, list}), do: list + defp statements(nil), do: [] + defp statements(single), do: [single] + + defp statement_steps({:=, meta, [{var, _, context}, constructor]}, env) + when is_atom(var) and is_atom(context) do + state = state_from_constructor(constructor, var, meta) + {[{:state, state}], Map.put(env, var, state.id)} + end + + defp statement_steps({:edge, meta, [edge_ast, label]}, env) when is_binary(label) do + {transition, states} = transition_from_ast(edge_ast, [label: label], env, meta) + {transition_declaration_steps(states, transition), env} + end + + defp statement_steps({:edge, meta, [edge_ast, opts]}, env) when is_list(opts) do + {transition, states} = + transition_from_ast(edge_ast, normalize_transition_opts(opts), env, meta) + + {transition_declaration_steps(states, transition), env} + end + + defp statement_steps({:edge, meta, [edge_ast]}, env) do + {transition, states} = transition_from_ast(edge_ast, [], env, meta) + {transition_declaration_steps(states, transition), env} + end + + defp statement_steps({:|>, _meta, _args} = ast, env) do + {transition, states} = transition_from_piped_ast(ast, env) + {transition_declaration_steps(states, transition), env} + end + + defp statement_steps({:~>, meta, _args} = ast, env) do + {transition, states} = transition_from_ast(ast, [], env, meta) + {transition_declaration_steps(states, transition), env} + end + + defp statement_steps({name, meta, args} = ast, env) when is_atom(name) and is_list(args) do + if Map.has_key?(@state_builders, name) do + state = state_from_constructor(ast, nil, meta) + {[{:state, state}], env} + else + unsupported_statement!(ast, meta) + end + end + + defp statement_steps(other, _env), do: unsupported_statement!(other, nil) + + defp transition_declaration_steps(states, transition) do + states + |> Enum.reduce([{:transition, transition}], fn state, steps -> [{:state, state} | steps] end) + |> Enum.reverse() + end + + defp transition_from_piped_ast(ast, env) do + {base, modifiers} = unwrap_pipe(ast, []) + opts = modifiers |> Enum.reduce([], &modifier_opt/2) |> normalize_transition_opts() + transition_from_ast(base, opts, env, line_meta(base)) + end + + defp unwrap_pipe({:|>, _meta, [left, right]}, acc), do: unwrap_pipe(left, [right | acc]) + defp unwrap_pipe(base, acc), do: {base, acc} + + defp modifier_opt({name, _meta, [value]}, acc) when name in [:on, :label] do + Keyword.put(acc, :label, value) + end + + defp modifier_opt({:guard, _meta, [value]}, acc), do: Keyword.put(acc, :guard, value) + + defp modifier_opt(other, _acc) do + raise ArgumentError, + "unsupported FSM transition modifier: #{Macro.to_string(other)}; " <> + "use `on(value)`, `label(value)`, or `guard(value)`" + end + + defp transition_from_ast({:~>, meta, [from_ast, to_ast]}, opts, env, _statement_meta) do + opts = require_transition_label_or_guard!(opts, meta) + {from, from_state} = endpoint_id(from_ast, env, meta) + {to, to_state} = endpoint_id(to_ast, env, meta) + states = [from_state, to_state] |> Enum.reject(&is_nil/1) |> Enum.uniq_by(& &1.id) + + {%{from: from, to: to, opts: opts}, states} + end + + defp transition_from_ast(other, _opts, _env, meta) do + raise ArgumentError, + "expected `from ~> to` in FSM DSL, got #{Macro.to_string(other)}" <> line_suffix(meta) + end + + defp endpoint_id({var, _meta, context}, env, meta) when is_atom(var) and is_atom(context) do + case Map.fetch(env, var) do + {:ok, id} -> {id, nil} + :error -> raise ArgumentError, "unknown FSM state variable `#{var}`#{line_suffix(meta)}" + end + end + + defp endpoint_id({name, meta, args} = constructor, _env, _statement_meta) + when is_atom(name) and is_list(args) do + if Map.has_key?(@state_builders, name) do + state = state_from_constructor(constructor, nil, meta) + {state.id, state} + else + raise ArgumentError, "unknown FSM state constructor `#{name}`#{line_suffix(meta)}" + end + end + + defp endpoint_id(other, _env, meta) do + raise ArgumentError, + "unsupported FSM transition endpoint #{Macro.to_string(other)}#{line_suffix(meta)}; " <> + "bind a state first, e.g. `idle = initial(\"Idle\")`" + end + + defp state_from_constructor({name, meta, args}, var, _statement_meta) + when is_atom(name) and is_list(args) do + builder = + Map.get(@state_builders, name) || + raise ArgumentError, "unknown FSM state constructor `#{name}`#{line_suffix(meta)}" + + {opts, positional} = pop_trailing_opts(args) + {id, opts} = state_id_and_opts(var, positional, opts, meta) + %{id: id, builder: builder, opts: opts} + end + + defp state_from_constructor(other, _var, meta) do + raise ArgumentError, + "expected FSM state constructor, got #{Macro.to_string(other)}#{line_suffix(meta)}" + end + + defp pop_trailing_opts(args) do + case List.last(args) do + last when is_list(last) -> + if Keyword.keyword?(last), do: {last, Enum.drop(args, -1)}, else: {[], args} + + _other -> + {[], args} + end + end + + defp state_id_and_opts(var, positional, opts, meta) do + {explicit_id, opts} = Keyword.pop(opts, :id) + + cond do + length(positional) > 1 -> + raise ArgumentError, + "state constructors take at most one positional label/id#{line_suffix(meta)}" + + explicit_id != nil -> + {explicit_id, maybe_put_label(opts, List.first(positional))} + + var != nil -> + {var, maybe_put_label(opts, List.first(positional))} + + positional != [] -> + label_or_id = List.first(positional) + {id_from_label(label_or_id), maybe_put_label(opts, label_or_id)} + + true -> + raise ArgumentError, + "inline FSM state constructors need a label/id or `id:` option#{line_suffix(meta)}" + end + end + + defp maybe_put_label(opts, nil), do: opts + + defp maybe_put_label(opts, label) when is_binary(label), + do: Keyword.put_new(opts, :label, label) + + defp maybe_put_label(opts, label) when is_atom(label), + do: Keyword.put_new(opts, :label, to_string(label)) + + defp maybe_put_label(opts, _other), do: opts + + defp id_from_label(id) when is_atom(id), do: id + defp id_from_label(id) when is_binary(id), do: slug_atom(id) + + defp id_from_label(other) do + raise ArgumentError, + "inline FSM state label/id must be a string or atom, got #{inspect(other)}" + end + + defp slug_atom(label) do + label + |> String.downcase() + |> String.replace(~r/[^a-z0-9]+/u, "_") + |> String.trim("_") + |> case do + "" -> raise ArgumentError, "cannot derive an FSM state id from an empty label" + slug -> String.to_atom(slug) + end + end + + defp normalize_transition_opts(opts) do + {with_label, opts} = Keyword.pop(opts, :with) + + if with_label != nil do + Keyword.put_new(opts, :label, with_label) + else + opts + end + end + + defp require_transition_label_or_guard!(opts, meta) do + if Keyword.has_key?(opts, :label) or Keyword.has_key?(opts, :guard) do + opts + else + raise ArgumentError, + "FSM transitions require `on(value)`, `label(value)`, `guard(value)`, " <> + "or `edge from ~> to, with: value`#{line_suffix(meta)}" + end + end + + defp pipe_step({:state, %{id: id, builder: builder, opts: opts}}, acc) do + quote do + apply(Choreo.FSM, unquote(builder), [ + unquote(acc), + unquote(Macro.escape(id)), + unquote(Macro.escape(opts)) + ]) + end + end + + defp pipe_step({:transition, %{from: from, to: to, opts: opts}}, acc) do + quote do + Choreo.FSM.add_transition( + unquote(acc), + unquote(Macro.escape(from)), + unquote(Macro.escape(to)), + unquote(Macro.escape(opts)) + ) + end + end + + defp unsupported_statement!(ast, meta) do + raise ArgumentError, + "unsupported statement in FSM DSL: #{Macro.to_string(ast)}#{line_suffix(meta)}" + end + + defp line_meta({_name, meta, _args}) when is_list(meta), do: meta + defp line_meta(_other), do: [] + + defp line_suffix(meta) when is_list(meta) do + case Keyword.get(meta, :line) do + nil -> "" + line -> " (line #{line})" + end + end + + defp line_suffix(_meta), do: "" +end diff --git a/lib/choreo/lab/dsl/infrastructure.ex b/lib/choreo/lab/dsl/infrastructure.ex index a8f59e5..a2be993 100644 --- a/lib/choreo/lab/dsl/infrastructure.ex +++ b/lib/choreo/lab/dsl/infrastructure.ex @@ -31,6 +31,13 @@ defmodule Choreo.Lab.DSL.Infrastructure do iex> system.edge_meta |> Map.values() |> Enum.map(& &1.label) |> Enum.sort() [nil, "checks quota", "reads/writes"] + Supported cluster constructors: + + * `cluster/1` + * `vpc/1` + * `public_subnet/1`, `subnet_public/1` + * `private_subnet/1`, `subnet_private/1` + Supported node constructors: * `user/1`, `client/1` @@ -46,17 +53,43 @@ defmodule Choreo.Lab.DSL.Infrastructure do * `network/1`, `external/1` * `node/1`, `custom/1` + Cluster variables can be used in `parent:` and node `cluster:` options: + + prod = vpc("Production VPC") + private = private_subnet("Private Subnet", parent: prod) + api = service("API", cluster: private) + Edge labels can use either pipe modifiers or the explicit `edge` form: api ~> db |> on("reads") api ~> db |> label("reads") + edge api ~> db, "reads" edge api ~> db, label: "reads" edge api ~> db, with: "reads" """ + @type cluster_decl :: %{id: String.t(), builder: atom(), opts: keyword()} @type node_decl :: %{id: Yog.node_id(), builder: atom(), opts: keyword()} @type edge_decl :: %{from: Yog.node_id(), to: Yog.node_id(), opts: keyword()} + @cluster_verbs [ + :cluster, + :vpc, + :public_subnet, + :subnet_public, + :private_subnet, + :subnet_private + ] + + @cluster_builders %{ + cluster: :add_cluster, + vpc: :add_vpc, + public_subnet: :add_subnet_public, + subnet_public: :add_subnet_public, + private_subnet: :add_subnet_private, + subnet_private: :add_subnet_private + } + @node_verbs [ :user, :client, @@ -108,6 +141,8 @@ defmodule Choreo.Lab.DSL.Infrastructure do not enough. iex> verbs = Choreo.Lab.DSL.Infrastructure.verbs() + iex> :vpc in verbs.clusters + true iex> :service in verbs.nodes true iex> :~> in verbs.edges @@ -116,6 +151,7 @@ defmodule Choreo.Lab.DSL.Infrastructure do true """ @spec verbs() :: %{ + clusters: [atom()], nodes: [atom()], edges: [atom()], modifiers: [atom()], @@ -123,10 +159,11 @@ defmodule Choreo.Lab.DSL.Infrastructure do } def verbs do %{ + clusters: @cluster_verbs, nodes: @node_verbs, edges: [:~>, :edge], modifiers: [:on, :label], - options: [:label, :with, :id, :kind, :cluster, :description] + options: [:label, :with, :id, :kind, :cluster, :parent, :description] } end @@ -145,7 +182,7 @@ defmodule Choreo.Lab.DSL.Infrastructure do {steps, _env} = block |> statements() - |> Enum.reduce({[], %{}}, fn statement, {steps, env} -> + |> Enum.reduce({[], empty_env()}, fn statement, {steps, env} -> {statement_steps, env} = statement_steps(statement, env) {steps ++ statement_steps, env} end) @@ -157,12 +194,30 @@ defmodule Choreo.Lab.DSL.Infrastructure do defp statements(nil), do: [] defp statements(single), do: [single] + defp empty_env, do: %{nodes: %{}, clusters: %{}} + # variable = constructor("Label", opts) defp statement_steps({:=, meta, [{var, _, context}, constructor]}, env) when is_atom(var) and is_atom(context) do - node = node_from_constructor(constructor, var, env, meta) - step = {:node, node} - {[step], Map.put(env, var, node.id)} + cond do + cluster_constructor?(constructor) -> + cluster = cluster_from_constructor(constructor, var, env, meta) + {[{:cluster, cluster}], put_in(env.clusters[var], cluster.id)} + + node_constructor?(constructor) -> + node = node_from_constructor(constructor, var, env, meta) + {[{:node, node}], put_in(env.nodes[var], node.id)} + + true -> + raise ArgumentError, + "expected infrastructure constructor, got #{Macro.to_string(constructor)}#{line_suffix(meta)}" + end + end + + # edge api ~> db, "reads" + defp statement_steps({:edge, meta, [edge_ast, label]}, env) when is_binary(label) do + {edge, nodes} = edge_from_ast(edge_ast, [label: label], env, meta) + {edge_declaration_steps(nodes, edge), env} end # edge api ~> db, label: "reads" @@ -188,13 +243,19 @@ defmodule Choreo.Lab.DSL.Infrastructure do {edge_declaration_steps(nodes, edge), env} end - # inline node declaration, e.g. service("API") + # inline cluster/node declaration, e.g. vpc("Prod") or service("API") defp statement_steps({name, meta, args} = ast, env) when is_atom(name) and is_list(args) do - if Map.has_key?(@node_builders, name) do - node = node_from_constructor(ast, nil, env, meta) - {[{:node, node}], env} - else - unsupported_statement!(ast, meta) + cond do + Map.has_key?(@cluster_builders, name) -> + cluster = cluster_from_constructor(ast, nil, env, meta) + {[{:cluster, cluster}], env} + + Map.has_key?(@node_builders, name) -> + node = node_from_constructor(ast, nil, env, meta) + {[{:node, node}], env} + + true -> + unsupported_statement!(ast, meta) end end @@ -242,7 +303,7 @@ defmodule Choreo.Lab.DSL.Infrastructure do end defp endpoint_id({var, _meta, context}, env, meta) when is_atom(var) and is_atom(context) do - case Map.fetch(env, var) do + case Map.fetch(env.nodes, var) do {:ok, id} -> {id, nil} @@ -268,7 +329,7 @@ defmodule Choreo.Lab.DSL.Infrastructure do "bind a node first, e.g. `api = service(\"API\")`" end - defp node_from_constructor({name, meta, args}, var, _env, _statement_meta) + defp node_from_constructor({name, meta, args}, var, env, _statement_meta) when is_atom(name) and is_list(args) do builder = Map.get(@node_builders, name) || @@ -276,6 +337,7 @@ defmodule Choreo.Lab.DSL.Infrastructure do "unknown infrastructure node constructor `#{name}`#{line_suffix(meta)}" {opts, positional} = pop_trailing_opts(args) + opts = resolve_cluster_option(opts, :cluster, env, meta) {id, opts} = node_id_and_opts(var, positional, opts, meta) %{id: id, builder: builder, opts: opts} @@ -286,6 +348,25 @@ defmodule Choreo.Lab.DSL.Infrastructure do "expected infrastructure node constructor, got #{Macro.to_string(other)}#{line_suffix(meta)}" end + defp cluster_from_constructor({name, meta, args}, var, env, _statement_meta) + when is_atom(name) and is_list(args) do + builder = + Map.get(@cluster_builders, name) || + raise ArgumentError, + "unknown infrastructure cluster constructor `#{name}`#{line_suffix(meta)}" + + {opts, positional} = pop_trailing_opts(args) + opts = resolve_cluster_option(opts, :parent, env, meta) + + {id, opts} = cluster_id_and_opts(var, positional, opts, meta) + %{id: id, builder: builder, opts: opts} + end + + defp cluster_from_constructor(other, _var, _env, meta) do + raise ArgumentError, + "expected infrastructure cluster constructor, got #{Macro.to_string(other)}#{line_suffix(meta)}" + end + defp pop_trailing_opts(args) do case List.last(args) do last when is_list(last) -> @@ -320,6 +401,30 @@ defmodule Choreo.Lab.DSL.Infrastructure do end end + defp cluster_id_and_opts(var, positional, opts, meta) do + {explicit_id, opts} = Keyword.pop(opts, :id) + + cond do + length(positional) > 1 -> + raise ArgumentError, + "cluster constructors take at most one positional label/id#{line_suffix(meta)}" + + explicit_id != nil -> + {to_string(explicit_id), maybe_put_label(opts, List.first(positional))} + + var != nil -> + {to_string(var), maybe_put_label(opts, List.first(positional))} + + positional != [] -> + label_or_id = List.first(positional) + {cluster_id_from_label(label_or_id), maybe_put_label(opts, label_or_id)} + + true -> + raise ArgumentError, + "inline infrastructure cluster constructors need a label/id or `id:` option#{line_suffix(meta)}" + end + end + defp maybe_put_label(opts, nil), do: opts defp maybe_put_label(opts, label) when is_binary(label), @@ -338,6 +443,14 @@ defmodule Choreo.Lab.DSL.Infrastructure do "inline infrastructure node label/id must be a string or atom, got #{inspect(other)}" end + defp cluster_id_from_label(id) when is_atom(id), do: to_string(id) + defp cluster_id_from_label(id) when is_binary(id), do: id |> slug_atom() |> to_string() + + defp cluster_id_from_label(other) do + raise ArgumentError, + "inline infrastructure cluster label/id must be a string or atom, got #{inspect(other)}" + end + defp slug_atom(label) do label |> String.downcase() @@ -349,6 +462,25 @@ defmodule Choreo.Lab.DSL.Infrastructure do end end + defp resolve_cluster_option(opts, key, env, meta) do + Keyword.update(opts, key, nil, &resolve_cluster_reference(&1, env, key, meta)) + |> Keyword.reject(fn {_key, value} -> is_nil(value) end) + end + + defp resolve_cluster_reference({var, _meta, context}, env, key, meta) + when is_atom(var) and is_atom(context) do + case Map.fetch(env.clusters, var) do + {:ok, id} -> + id + + :error -> + raise ArgumentError, + "unknown infrastructure cluster variable `#{var}` in `#{key}:`#{line_suffix(meta)}" + end + end + + defp resolve_cluster_reference(value, _env, _key, _meta), do: value + defp normalize_edge_opts(opts) do {with_label, opts} = Keyword.pop(opts, :with) @@ -359,6 +491,26 @@ defmodule Choreo.Lab.DSL.Infrastructure do end end + defp cluster_constructor?({name, _meta, args}) when is_atom(name) and is_list(args), + do: Map.has_key?(@cluster_builders, name) + + defp cluster_constructor?(_other), do: false + + defp node_constructor?({name, _meta, args}) when is_atom(name) and is_list(args), + do: Map.has_key?(@node_builders, name) + + defp node_constructor?(_other), do: false + + defp pipe_step({:cluster, %{id: id, builder: builder, opts: opts}}, acc) do + quote do + apply(Choreo, unquote(builder), [ + unquote(acc), + unquote(Macro.escape(id)), + unquote(Macro.escape(opts)) + ]) + end + end + defp pipe_step({:node, %{id: id, builder: builder, opts: opts}}, acc) do quote do apply(Choreo, unquote(builder), [ diff --git a/test/choreo/lab/compose_test.exs b/test/choreo/lab/compose_test.exs new file mode 100644 index 0000000..e685f87 --- /dev/null +++ b/test/choreo/lab/compose_test.exs @@ -0,0 +1,73 @@ +defmodule Choreo.Lab.ComposeTest do + use ExUnit.Case, async: true + + alias Choreo.Lab.Compose + + doctest Choreo.Lab.Compose + + test "verbs returns the Livebook discovery vocabulary" do + verbs = Compose.verbs() + + assert :cluster in verbs.structure + assert :embed in verbs.structure + assert :connect in verbs.links + assert :trace in verbs.links + assert :into in verbs.options + assert :as in verbs.options + end + + test "cluster adds a visual grouping" do + system = Choreo.new() |> Compose.cluster(:auth, label: "Auth") + + assert system.clusters["cluster_auth"].label == "Auth" + end + + test "embed supports friendly as prefix" do + child = Choreo.new() |> Choreo.add_service(:api) + + system = + Choreo.new() + |> Compose.cluster(:system) + |> Compose.embed(child, into: :system, as: :child) + + assert Map.has_key?(Choreo.nodes(system), :child_api) + assert Choreo.nodes(system)[:child_api].cluster == "cluster_system" + end + + test "explicit prefix wins over as" do + child = Choreo.new() |> Choreo.add_service(:api) + + system = + Choreo.new() + |> Compose.cluster(:system) + |> Compose.embed(child, into: :system, as: :child, prefix: "explicit_") + + assert Map.has_key?(Choreo.nodes(system), :explicit_api) + refute Map.has_key?(Choreo.nodes(system), :child_api) + end + + test "connect creates normal visible relationships" do + system = + Choreo.new() + |> Choreo.add_service(:api) + |> Choreo.add_database(:db) + |> Compose.connect(:api, :db, "reads") + + assert [{:api, :db, _weight, meta}] = Choreo.edges_with_meta(system) + assert meta.label == "reads" + refute meta[:edge_type] == :trace + end + + test "trace creates semantic cross-model relationships" do + system = + Choreo.new() + |> Choreo.add_service(:api) + |> Choreo.add_service(:auth) + |> Compose.trace(:api, :auth, :executes) + + assert [{:api, :auth, _weight, meta}] = Choreo.edges_with_meta(system) + assert meta.edge_type == :trace + assert meta.type == :executes + assert meta.label == "executes" + end +end diff --git a/test/choreo/lab/composition_test.exs b/test/choreo/lab/composition_test.exs new file mode 100644 index 0000000..2a553f3 --- /dev/null +++ b/test/choreo/lab/composition_test.exs @@ -0,0 +1,66 @@ +defmodule Choreo.Lab.CompositionTest do + use ExUnit.Case, async: true + + import Choreo.Lab.DSL.FSM + import Choreo.Lab.DSL.Infrastructure + + alias Choreo.Lab.Compose + alias Choreo.Lab.View + + test "composes infrastructure and FSM sketches through embed and trace" do + auth_fsm = + fsm do + unauthenticated = initial("Unauthenticated") + authenticated = state("Authenticated") + denied = final("Denied") + + unauthenticated ~> authenticated |> on("valid token") + edge unauthenticated ~> denied, "invalid token" + end + + infra = + infrastructure do + client = user("API Client") + gateway = gateway("API Gateway") + auth = service("Auth Service") + db = database("Users DB") + + client ~> gateway |> on("calls") + gateway ~> auth |> on("validates token") + auth ~> db |> on("loads user") + end + + system = + Choreo.new() + |> Compose.cluster("system", label: "API Gateway System") + |> Compose.embed(infra, into: "system", as: :infra) + |> Compose.embed(auth_fsm, into: "system", as: :auth) + |> Compose.trace(:infra_auth, :auth_unauthenticated, :executes) + |> Compose.trace(:auth_authenticated, :infra_db, :stores) + + nodes = Choreo.nodes(system) + + assert Map.has_key?(nodes, :infra_gateway) + assert Map.has_key?(nodes, :infra_auth) + assert Map.has_key?(nodes, :auth_unauthenticated) + assert Map.has_key?(nodes, :auth_authenticated) + assert nodes[:infra_gateway].cluster == "cluster_system" + assert nodes[:auth_unauthenticated].cluster == "cluster_system" + + path_view = View.between(system, :infra_gateway, :auth_authenticated) + + assert Enum.sort(Map.keys(Choreo.nodes(path_view))) == [ + :auth_authenticated, + :auth_unauthenticated, + :infra_auth, + :infra_gateway + ] + + trace_edges = + system + |> Choreo.edges_with_meta() + |> Enum.filter(fn {_from, _to, _weight, meta} -> meta[:edge_type] == :trace end) + + assert length(trace_edges) == 2 + end +end diff --git a/test/choreo/lab/dsl/fsm_test.exs b/test/choreo/lab/dsl/fsm_test.exs new file mode 100644 index 0000000..f030dc2 --- /dev/null +++ b/test/choreo/lab/dsl/fsm_test.exs @@ -0,0 +1,100 @@ +defmodule Choreo.Lab.FSMDSLTest do + use ExUnit.Case, async: true + + import Choreo.Lab.DSL.FSM + + doctest Choreo.Lab.DSL.FSM + + test "verbs returns the Livebook discovery vocabulary" do + verbs = Choreo.Lab.DSL.FSM.verbs() + + assert :state in verbs.states + assert :initial in verbs.states + assert :final in verbs.states + assert :~> in verbs.edges + assert :edge in verbs.edges + assert :on in verbs.modifiers + assert :guard in verbs.modifiers + assert :with in verbs.options + end + + test "builds an FSM with variable-bound states" do + machine = + fsm do + idle = initial("Idle") + authorized = state("Authorized") + denied = final("Denied") + expired = final("Expired") + + idle ~> authorized |> on("token valid") + edge idle ~> denied, "token invalid" + authorized ~> expired |> label("token expired") + authorized ~> denied |> guard("revoked?(token)") + end + + assert Choreo.FSM.initial_state(machine) == :idle + assert Enum.sort(Choreo.FSM.final_states(machine)) == [:denied, :expired] + assert machine.graph.nodes[:authorized].label == "Authorized" + + assert {:idle, :authorized, "token valid"} in Choreo.FSM.transitions(machine) + assert {:idle, :denied, "token invalid"} in Choreo.FSM.transitions(machine) + assert {:authorized, :expired, "token expired"} in Choreo.FSM.transitions(machine) + assert {:authorized, :denied, "[revoked?(token)]"} in Choreo.FSM.transitions(machine) + end + + test "supports inline state constructors for one-off sketches" do + machine = + fsm do + initial("Idle") ~> final("Done") |> on("finish") + end + + assert Choreo.FSM.initial_state(machine) == :idle + assert Choreo.FSM.final_states(machine) == [:done] + assert Choreo.FSM.transitions(machine) == [{:idle, :done, "finish"}] + end + + test "supports id option while keeping display label" do + machine = + fsm do + a = initial("Idle", id: :idle_state) + b = final("Done") + + edge a ~> b, "finish" + end + + assert machine.graph.nodes[:idle_state].label == "Idle" + assert Choreo.FSM.initial_state(machine) == :idle_state + assert Choreo.FSM.transitions(machine) == [{:idle_state, :b, "finish"}] + end + + test "raises on unknown state variables" do + assert_raise ArgumentError, ~r/unknown FSM state variable `done`/, fn -> + Code.eval_quoted( + quote do + import Choreo.Lab.DSL.FSM + + fsm do + idle = initial("Idle") + idle ~> done |> on("finish") + end + end + ) + end + end + + test "raises when transition label or guard is missing" do + assert_raise ArgumentError, ~r/FSM transitions require/, fn -> + Code.eval_quoted( + quote do + import Choreo.Lab.DSL.FSM + + fsm do + idle = initial("Idle") + done = final("Done") + idle ~> done + end + end + ) + end + end +end diff --git a/test/choreo/lab/dsl/infrastructure_test.exs b/test/choreo/lab/dsl/infrastructure_test.exs index 8878b63..9d5d7da 100644 --- a/test/choreo/lab/dsl/infrastructure_test.exs +++ b/test/choreo/lab/dsl/infrastructure_test.exs @@ -8,14 +8,78 @@ defmodule Choreo.Lab.InfrastructureDSLTest do test "verbs returns the Livebook discovery vocabulary" do verbs = Choreo.Lab.DSL.Infrastructure.verbs() + assert :vpc in verbs.clusters + assert :public_subnet in verbs.clusters assert :service in verbs.nodes assert :database in verbs.nodes assert :~> in verbs.edges assert :edge in verbs.edges assert :on in verbs.modifiers + assert :parent in verbs.options assert :with in verbs.options end + test "builds an infrastructure sketch with variable-bound clusters" do + system = + infrastructure do + prod = vpc("Production VPC") + public = public_subnet("Public Subnet", parent: prod) + private = private_subnet("Private Subnet", parent: prod) + + internet = user("Internet") + alb = gateway("ALB", cluster: public) + api = service("API", cluster: private) + db = database("Postgres", cluster: private) + + internet ~> alb |> on("HTTPS") + alb ~> api |> on("HTTP") + api ~> db |> on("TCP") + end + + assert system.clusters["cluster_prod"].cluster_type == :vpc + assert system.clusters["cluster_prod"].label == "Production VPC" + assert system.clusters["cluster_public"].cluster_type == :subnet_public + assert system.clusters["cluster_public"].parent == "cluster_prod" + assert system.clusters["cluster_private"].cluster_type == :subnet_private + assert system.clusters["cluster_private"].parent == "cluster_prod" + + assert system.graph.nodes[:alb].cluster == "cluster_public" + assert system.graph.nodes[:api].cluster == "cluster_private" + assert system.graph.nodes[:db].cluster == "cluster_private" + end + + test "supports inline cluster constructors" do + system = + infrastructure do + vpc("Production VPC") + private = private_subnet("Private Subnet", parent: "production_vpc") + api = service("API", cluster: private) + db = database("Postgres", cluster: private) + + api ~> db |> on("TCP") + end + + assert system.clusters["cluster_production_vpc"].cluster_type == :vpc + assert system.clusters["cluster_private"].parent == "cluster_production_vpc" + assert system.graph.nodes[:api].cluster == "cluster_private" + end + + test "raises on unknown cluster variables" do + assert_raise ArgumentError, ~r/unknown infrastructure cluster variable `privat`/, fn -> + Code.eval_quoted( + quote do + import Choreo.Lab.DSL.Infrastructure + + infrastructure do + api = service("API", cluster: privat) + db = database("Postgres") + api ~> db + end + end + ) + end + end + test "builds an infrastructure sketch with variable-bound nodes" do system = infrastructure do @@ -36,7 +100,7 @@ defmodule Choreo.Lab.InfrastructureDSLTest do router ~> tenant_db gateway ~> audit_events |> on("writes audit event") audit_events ~> audit_worker - edge(audit_worker ~> audit_db, with: "persists") + edge audit_worker ~> audit_db, "persists" end assert system.graph.nodes[:client].node_type == :user @@ -72,7 +136,7 @@ defmodule Choreo.Lab.InfrastructureDSLTest do api = service("Public API", id: :public_api) db = database("Postgres") - edge(api ~> db, label: "reads") + edge api ~> db, "reads" end assert system.graph.nodes[:public_api].label == "Public API" From a030fb81039795031c212662c2750f5e7a581542 Mon Sep 17 00:00:00 2001 From: Mafinar Khan Date: Sun, 19 Jul 2026 13:29:01 -0400 Subject: [PATCH 05/13] Add Lab MindMap DSL --- CHANGELOG.md | 1 + lib/choreo/lab/dsl/mind_map.ex | 422 ++++++++++++++++++++++++++ test/choreo/lab/dsl/mind_map_test.exs | 127 ++++++++ 3 files changed, 550 insertions(+) create mode 100644 lib/choreo/lab/dsl/mind_map.ex create mode 100644 test/choreo/lab/dsl/mind_map_test.exs diff --git a/CHANGELOG.md b/CHANGELOG.md index 4137cdc..68f4875 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,6 +6,7 @@ - Added incubating `Choreo.Lab.DSL.Infrastructure` syntax for Livebook-friendly infrastructure sketches over the stable `Choreo` builders, including bindable cluster constructors for VPCs and subnets. - Added incubating `Choreo.Lab.DSL.FSM` syntax for variable-bound finite-state-machine sketches over the stable `Choreo.FSM` builders. +- Added incubating `Choreo.Lab.DSL.MindMap` syntax for Livebook-friendly mind-map sketches over the stable `Choreo.MindMap` builders, including typed branch and association edges. - Added `Choreo.Lab.View` pipe-friendly helpers for Livebook zoom, focus, filter, path, and collapse exploration over `Choreo.View`. - Added `Choreo.Lab.Compose` pipe-friendly helpers for Livebook cluster, embed, connect, and trace composition over `Choreo`. diff --git a/lib/choreo/lab/dsl/mind_map.ex b/lib/choreo/lab/dsl/mind_map.ex new file mode 100644 index 0000000..3d227bf --- /dev/null +++ b/lib/choreo/lab/dsl/mind_map.ex @@ -0,0 +1,422 @@ +defmodule Choreo.Lab.DSL.MindMap do + @moduledoc """ + Experimental Livebook-friendly DSL for sketching mind maps. + + This Lab DSL compiles to the stable, pipe-first `Choreo.MindMap` builders and + returns an ordinary `%Choreo.MindMap{}`. It follows the shared Lab identity rule: + in assignment form, the variable name becomes the node id and the string becomes + the display label; in inline form, the string is slugged into an id and also used + as the label. + + ## Examples + + iex> import Choreo.Lab.DSL.MindMap + ...> map = mind_map do + ...> system = root("System Design") + ...> requirements = topic("Requirements") + ...> risks = note("Open Risks") + ...> + ...> system ~> requirements + ...> edge requirements ~> risks, "needs review" + ...> end + iex> Choreo.MindMap.root(map) + :system + iex> map.graph.nodes[:requirements].label + "Requirements" + iex> map.edge_meta[{:requirements, :risks}].label + "needs review" + + Branch edges can use `~>`, pipe modifiers, explicit `edge`, or the typed + `branch` form: + + root ~> topic + root ~> topic |> on("expands into") + edge root ~> topic, "expands into" + branch root ~> topic, "expands into" + + Associative cross-links use the typed `associate`/`association` form, a typed + keyword on `edge`, or a pipe modifier: + + associate topic ~> note, "related" + association topic ~> note, "related" + edge topic ~> note, associate: "related" + topic ~> note |> associate("related") + """ + + @type node_decl :: %{id: Yog.node_id(), builder: atom(), opts: keyword()} + @type edge_decl :: %{ + from: Yog.node_id(), + to: Yog.node_id(), + edge_type: :branch | :associate, + opts: keyword() + } + + @node_verbs [:root, :topic, :subtopic, :note] + + @node_builders %{ + root: :set_root, + topic: :add_topic, + subtopic: :add_subtopic, + note: :add_note + } + + @doc """ + Returns the vocabulary supported by the mind-map DSL. + + iex> verbs = Choreo.Lab.DSL.MindMap.verbs() + iex> :root in verbs.nodes + true + iex> :associate in verbs.edges + true + iex> :on in verbs.modifiers + true + """ + @spec verbs() :: %{ + nodes: [atom()], + edges: [atom()], + modifiers: [atom()], + options: [atom()] + } + def verbs do + %{ + nodes: @node_verbs, + edges: [:~>, :edge, :branch, :associate, :association], + modifiers: [:on, :label, :associate, :association], + options: [:label, :with, :id, :branch, :associate, :association, :type] + } + end + + @doc """ + Builds a `%Choreo.MindMap{}` from a compact Lab DSL block. + """ + defmacro mind_map(do: block) do + compile(block) + end + + defmacro mind_map(opts, do: block) do + compile(block, opts) + end + + defp compile(block, opts \\ []) do + {steps, _env} = + block + |> statements() + |> Enum.reduce({[], %{}}, fn statement, {steps, env} -> + {statement_steps, env} = statement_steps(statement, env) + {steps ++ statement_steps, env} + end) + + Enum.reduce(steps, quote(do: Choreo.MindMap.new(unquote(Macro.escape(opts)))), &pipe_step/2) + end + + defp statements({:__block__, _meta, list}), do: list + defp statements(nil), do: [] + defp statements(single), do: [single] + + defp statement_steps({:=, meta, [{var, _, context}, constructor]}, env) + when is_atom(var) and is_atom(context) do + node = node_from_constructor(constructor, var, meta) + {[{:node, node}], Map.put(env, var, node.id)} + end + + defp statement_steps({:edge, meta, [edge_ast, label]}, env) when is_binary(label) do + {edge, nodes} = edge_from_ast(edge_ast, [label: label], env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({:edge, meta, [edge_ast, opts]}, env) when is_list(opts) do + {edge, nodes} = edge_from_ast(edge_ast, normalize_edge_opts(opts), env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({:edge, meta, [edge_ast]}, env) do + {edge, nodes} = edge_from_ast(edge_ast, [], env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({name, meta, [edge_ast, label]}, env) + when name in [:branch, :associate, :association] and is_binary(label) do + {edge, nodes} = edge_from_ast(edge_ast, [type: edge_type(name), label: label], env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({name, meta, [edge_ast, opts]}, env) + when name in [:branch, :associate, :association] and is_list(opts) do + opts = opts |> normalize_edge_opts() |> Keyword.put(:type, edge_type(name)) + {edge, nodes} = edge_from_ast(edge_ast, opts, env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({name, meta, [edge_ast]}, env) + when name in [:branch, :associate, :association] do + {edge, nodes} = edge_from_ast(edge_ast, [type: edge_type(name)], env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({:|>, _meta, _args} = ast, env) do + {edge, nodes} = edge_from_piped_ast(ast, env) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({:~>, meta, _args} = ast, env) do + {edge, nodes} = edge_from_ast(ast, [], env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({name, meta, args} = ast, env) when is_atom(name) and is_list(args) do + if Map.has_key?(@node_builders, name) do + node = node_from_constructor(ast, nil, meta) + {[{:node, node}], env} + else + unsupported_statement!(ast, meta) + end + end + + defp statement_steps(other, _env), do: unsupported_statement!(other, nil) + + defp edge_declaration_steps(nodes, edge) do + nodes + |> Enum.reduce([{:edge, edge}], fn node, steps -> [{:node, node} | steps] end) + |> Enum.reverse() + end + + defp edge_from_piped_ast(ast, env) do + {base, modifiers} = unwrap_pipe(ast, []) + opts = modifiers |> Enum.reduce([], &modifier_opt/2) |> normalize_edge_opts() + edge_from_ast(base, opts, env, line_meta(base)) + end + + defp unwrap_pipe({:|>, _meta, [left, right]}, acc), do: unwrap_pipe(left, [right | acc]) + defp unwrap_pipe(base, acc), do: {base, acc} + + defp modifier_opt({name, _meta, [value]}, acc) when name in [:on, :label] do + Keyword.put(acc, :label, value) + end + + defp modifier_opt({name, _meta, [value]}, acc) when name in [:associate, :association] do + acc + |> Keyword.put(:type, :associate) + |> Keyword.put(:label, value) + end + + defp modifier_opt(other, _acc) do + raise ArgumentError, + "unsupported mind-map edge modifier: #{Macro.to_string(other)}; " <> + "use `on(value)`, `label(value)`, or `associate(value)`" + end + + defp edge_from_ast({:~>, meta, [from_ast, to_ast]}, opts, env, _statement_meta) do + {from, from_node} = endpoint_id(from_ast, env, meta) + {to, to_node} = endpoint_id(to_ast, env, meta) + nodes = [from_node, to_node] |> Enum.reject(&is_nil/1) |> Enum.uniq_by(& &1.id) + {edge_type, opts} = edge_type_and_opts(opts) + + {%{from: from, to: to, edge_type: edge_type, opts: opts}, nodes} + end + + defp edge_from_ast(other, _opts, _env, meta) do + raise ArgumentError, + "expected `from ~> to` in mind-map DSL, got #{Macro.to_string(other)}" <> + line_suffix(meta) + end + + defp endpoint_id({var, _meta, context}, env, meta) when is_atom(var) and is_atom(context) do + case Map.fetch(env, var) do + {:ok, id} -> {id, nil} + :error -> raise ArgumentError, "unknown mind-map node variable `#{var}`#{line_suffix(meta)}" + end + end + + defp endpoint_id({name, meta, args} = constructor, _env, _statement_meta) + when is_atom(name) and is_list(args) do + if Map.has_key?(@node_builders, name) do + node = node_from_constructor(constructor, nil, meta) + {node.id, node} + else + raise ArgumentError, "unknown mind-map node constructor `#{name}`#{line_suffix(meta)}" + end + end + + defp endpoint_id(other, _env, meta) do + raise ArgumentError, + "unsupported mind-map edge endpoint #{Macro.to_string(other)}#{line_suffix(meta)}; " <> + "bind a node first, e.g. `idea = root(\"Idea\")`" + end + + defp node_from_constructor({name, meta, args}, var, _statement_meta) + when is_atom(name) and is_list(args) do + builder = + Map.get(@node_builders, name) || + raise ArgumentError, "unknown mind-map node constructor `#{name}`#{line_suffix(meta)}" + + {opts, positional} = pop_trailing_opts(args) + {id, opts} = node_id_and_opts(var, positional, opts, meta) + %{id: id, builder: builder, opts: opts} + end + + defp node_from_constructor(other, _var, meta) do + raise ArgumentError, + "expected mind-map node constructor, got #{Macro.to_string(other)}#{line_suffix(meta)}" + end + + defp pop_trailing_opts(args) do + case List.last(args) do + last when is_list(last) -> + if Keyword.keyword?(last), do: {last, Enum.drop(args, -1)}, else: {[], args} + + _other -> + {[], args} + end + end + + defp node_id_and_opts(var, positional, opts, meta) do + {explicit_id, opts} = Keyword.pop(opts, :id) + + cond do + length(positional) > 1 -> + raise ArgumentError, + "mind-map node constructors take at most one positional label/id#{line_suffix(meta)}" + + explicit_id != nil -> + {explicit_id, maybe_put_label(opts, List.first(positional))} + + var != nil -> + {var, maybe_put_label(opts, List.first(positional))} + + positional != [] -> + label_or_id = List.first(positional) + {id_from_label(label_or_id), maybe_put_label(opts, label_or_id)} + + true -> + raise ArgumentError, + "inline mind-map node constructors need a label/id or `id:` option#{line_suffix(meta)}" + end + end + + defp maybe_put_label(opts, nil), do: opts + + defp maybe_put_label(opts, label) when is_binary(label), + do: Keyword.put_new(opts, :label, label) + + defp maybe_put_label(opts, label) when is_atom(label), + do: Keyword.put_new(opts, :label, to_string(label)) + + defp maybe_put_label(opts, _other), do: opts + + defp id_from_label(id) when is_atom(id), do: id + defp id_from_label(id) when is_binary(id), do: slug_atom(id) + + defp id_from_label(other) do + raise ArgumentError, + "inline mind-map node label/id must be a string or atom, got #{inspect(other)}" + end + + defp slug_atom(label) do + label + |> String.downcase() + |> String.replace(~r/[^a-z0-9]+/u, "_") + |> String.trim("_") + |> case do + "" -> raise ArgumentError, "cannot derive a mind-map node id from an empty label" + slug -> String.to_atom(slug) + end + end + + defp normalize_edge_opts(opts) do + opts + |> normalize_label_alias(:with) + |> normalize_label_alias(:branch) + |> normalize_label_alias(:associate) + |> normalize_label_alias(:association) + end + + defp normalize_label_alias(opts, key) do + {value, opts} = Keyword.pop(opts, key) + + cond do + value == nil -> + opts + + key == :branch -> + opts |> Keyword.put_new(:type, :branch) |> Keyword.put_new(:label, value) + + key in [:associate, :association] -> + opts |> Keyword.put_new(:type, :associate) |> Keyword.put_new(:label, value) + + true -> + Keyword.put_new(opts, :label, value) + end + end + + defp edge_type_and_opts(opts) do + {type, opts} = Keyword.pop(opts, :type) + + case type || :branch do + :branch -> + {:branch, opts} + + :associate -> + {:associate, opts} + + :association -> + {:associate, opts} + + other -> + raise ArgumentError, + "unsupported mind-map edge type #{inspect(other)}; use :branch or :associate" + end + end + + defp edge_type(:branch), do: :branch + defp edge_type(:associate), do: :associate + defp edge_type(:association), do: :associate + + defp pipe_step({:node, %{id: id, builder: builder, opts: opts}}, acc) do + quote do + apply(Choreo.MindMap, unquote(builder), [ + unquote(acc), + unquote(Macro.escape(id)), + unquote(Macro.escape(opts)) + ]) + end + end + + defp pipe_step({:edge, %{from: from, to: to, edge_type: :branch, opts: opts}}, acc) do + quote do + Choreo.MindMap.branch( + unquote(acc), + unquote(Macro.escape(from)), + unquote(Macro.escape(to)), + unquote(Macro.escape(opts)) + ) + end + end + + defp pipe_step({:edge, %{from: from, to: to, edge_type: :associate, opts: opts}}, acc) do + quote do + Choreo.MindMap.associate( + unquote(acc), + unquote(Macro.escape(from)), + unquote(Macro.escape(to)), + unquote(Macro.escape(opts)) + ) + end + end + + defp unsupported_statement!(ast, meta) do + raise ArgumentError, + "unsupported statement in mind-map DSL: #{Macro.to_string(ast)}#{line_suffix(meta)}" + end + + defp line_meta({_name, meta, _args}) when is_list(meta), do: meta + defp line_meta(_other), do: [] + + defp line_suffix(meta) when is_list(meta) do + case Keyword.get(meta, :line) do + nil -> "" + line -> " (line #{line})" + end + end + + defp line_suffix(_meta), do: "" +end diff --git a/test/choreo/lab/dsl/mind_map_test.exs b/test/choreo/lab/dsl/mind_map_test.exs new file mode 100644 index 0000000..0d1d69e --- /dev/null +++ b/test/choreo/lab/dsl/mind_map_test.exs @@ -0,0 +1,127 @@ +defmodule Choreo.Lab.MindMapDSLTest do + use ExUnit.Case, async: true + + import Choreo.Lab.DSL.MindMap + + doctest Choreo.Lab.DSL.MindMap + + test "verbs returns the Livebook discovery vocabulary" do + verbs = Choreo.Lab.DSL.MindMap.verbs() + + assert :root in verbs.nodes + assert :topic in verbs.nodes + assert :subtopic in verbs.nodes + assert :note in verbs.nodes + assert :branch in verbs.edges + assert :associate in verbs.edges + assert :association in verbs.edges + assert :on in verbs.modifiers + assert :with in verbs.options + end + + test "builds a mind map with variable-bound nodes" do + map = + mind_map do + system = root("System Design") + requirements = topic("Requirements") + architecture = topic("Architecture") + c4 = subtopic("C4") + risks = note("Open Risks") + + system ~> requirements + edge system ~> architecture, "explores" + architecture ~> c4 |> on("uses") + edge requirements ~> risks, with: "needs review" + end + + assert Choreo.MindMap.root(map) == :system + assert map.graph.nodes[:requirements].node_type == :topic + assert map.graph.nodes[:c4].node_type == :subtopic + assert map.graph.nodes[:risks].node_type == :note + + assert map.edge_meta[{:system, :requirements}].edge_type == :branch + assert map.edge_meta[{:system, :architecture}].label == "explores" + assert map.edge_meta[{:architecture, :c4}].label == "uses" + assert map.edge_meta[{:requirements, :risks}].label == "needs review" + end + + test "supports inline node constructors for one-off sketches" do + map = + mind_map do + root("System Design") ~> topic("Requirements") + end + + assert Choreo.MindMap.root(map) == :system_design + assert map.graph.nodes[:requirements].label == "Requirements" + assert [{:system_design, :requirements, 1}] = Choreo.MindMap.edges(map) + end + + test "supports id option while keeping display label" do + map = + mind_map do + idea = root("System Design", id: :design) + reqs = topic("Requirements") + + edge idea ~> reqs, "contains" + end + + assert Choreo.MindMap.root(map) == :design + assert map.graph.nodes[:design].label == "System Design" + assert map.edge_meta[{:design, :reqs}].label == "contains" + end + + test "supports typed association edges" do + map = + mind_map do + idea = root("System Design") + requirements = topic("Requirements") + risks = note("Open Risks") + tradeoffs = note("Tradeoffs") + + idea ~> requirements + idea ~> risks + idea ~> tradeoffs + associate(requirements ~> risks, "drives") + association(risks ~> tradeoffs, "informs") + edge tradeoffs ~> requirements, associate: "reframes" + end + + assert map.edge_meta[{:requirements, :risks}].edge_type == :associates + assert map.edge_meta[{:requirements, :risks}].label == "drives" + assert map.edge_meta[{:risks, :tradeoffs}].edge_type == :associates + assert map.edge_meta[{:risks, :tradeoffs}].label == "informs" + assert map.edge_meta[{:tradeoffs, :requirements}].edge_type == :associates + assert map.edge_meta[{:tradeoffs, :requirements}].label == "reframes" + end + + test "supports association pipe modifier" do + map = + mind_map do + idea = root("System Design") + api = topic("API") + auth = topic("Auth") + + idea ~> api + idea ~> auth + api ~> auth |> associate("cross-cutting") + end + + assert map.edge_meta[{:api, :auth}].edge_type == :associates + assert map.edge_meta[{:api, :auth}].label == "cross-cutting" + end + + test "raises on unknown node variables" do + assert_raise ArgumentError, ~r/unknown mind-map node variable `risk`/, fn -> + Code.eval_quoted( + quote do + import Choreo.Lab.DSL.MindMap + + mind_map do + idea = root("System Design") + idea ~> risk + end + end + ) + end + end +end From cc0684609b196a375745ca3d9eb1e180fccf5b4d Mon Sep 17 00:00:00 2001 From: Mafinar Khan Date: Sun, 19 Jul 2026 13:46:58 -0400 Subject: [PATCH 06/13] Prefer taxonomy for Lab discovery --- CHANGELOG.md | 2 ++ lib/choreo/lab/compose.ex | 22 ++++++++++++----- lib/choreo/lab/dsl/fsm.ex | 26 ++++++++++++++++----- lib/choreo/lab/dsl/infrastructure.ex | 26 +++++++++++++++------ lib/choreo/lab/dsl/mind_map.ex | 26 ++++++++++++++++----- lib/choreo/lab/view.ex | 23 +++++++++++++----- test/choreo/lab/compose_test.exs | 19 ++++++++------- test/choreo/lab/dsl/fsm_test.exs | 23 +++++++++--------- test/choreo/lab/dsl/infrastructure_test.exs | 25 ++++++++++---------- test/choreo/lab/dsl/mind_map_test.exs | 25 ++++++++++---------- test/choreo/lab/view_test.exs | 17 +++++++------- 11 files changed, 151 insertions(+), 83 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 68f4875..67b7edb 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -12,6 +12,8 @@ ### Changed +- Added `taxonomy/0` as the preferred Livebook discovery helper for `Choreo.Lab.View`, `Choreo.Lab.Compose`, and current `Choreo.Lab.DSL.*` modules; kept `verbs/0` as a compatibility alias. + ### Fixed ## [0.11.0] - 2026-07-17 diff --git a/lib/choreo/lab/compose.ex b/lib/choreo/lab/compose.ex index 28cd424..3d7c888 100644 --- a/lib/choreo/lab/compose.ex +++ b/lib/choreo/lab/compose.ex @@ -32,20 +32,20 @@ defmodule Choreo.Lab.Compose do @doc """ Returns the composition helper vocabulary for Livebook discovery. - iex> verbs = Choreo.Lab.Compose.verbs() - iex> :embed in verbs.structure + iex> taxonomy = Choreo.Lab.Compose.taxonomy() + iex> :embed in taxonomy.structure true - iex> :trace in verbs.links + iex> :trace in taxonomy.links true - iex> :as in verbs.options + iex> :as in taxonomy.options true """ - @spec verbs() :: %{ + @spec taxonomy() :: %{ structure: [atom()], links: [atom()], options: [atom()] } - def verbs do + def taxonomy do %{ structure: [:cluster, :embed], links: [:connect, :trace], @@ -53,6 +53,16 @@ defmodule Choreo.Lab.Compose do } end + @doc """ + Compatibility alias for `taxonomy/0`. + """ + @spec verbs() :: %{ + structure: [atom()], + links: [atom()], + options: [atom()] + } + def verbs, do: taxonomy() + @doc """ Adds a visual cluster/grouping boundary to a composed system. diff --git a/lib/choreo/lab/dsl/fsm.ex b/lib/choreo/lab/dsl/fsm.ex index ff22ec8..f5beaae 100644 --- a/lib/choreo/lab/dsl/fsm.ex +++ b/lib/choreo/lab/dsl/fsm.ex @@ -53,21 +53,24 @@ defmodule Choreo.Lab.DSL.FSM do @doc """ Returns the vocabulary supported by the FSM DSL. - iex> verbs = Choreo.Lab.DSL.FSM.verbs() - iex> :initial in verbs.states + This is meant as a lightweight Livebook discovery helper when autocomplete is + not enough. + + iex> taxonomy = Choreo.Lab.DSL.FSM.taxonomy() + iex> :initial in taxonomy.states true - iex> :~> in verbs.edges + iex> :~> in taxonomy.edges true - iex> :guard in verbs.modifiers + iex> :guard in taxonomy.modifiers true """ - @spec verbs() :: %{ + @spec taxonomy() :: %{ states: [atom()], edges: [atom()], modifiers: [atom()], options: [atom()] } - def verbs do + def taxonomy do %{ states: @state_verbs, edges: [:~>, :edge], @@ -76,6 +79,17 @@ defmodule Choreo.Lab.DSL.FSM do } end + @doc """ + Compatibility alias for `taxonomy/0`. + """ + @spec verbs() :: %{ + states: [atom()], + edges: [atom()], + modifiers: [atom()], + options: [atom()] + } + def verbs, do: taxonomy() + @doc """ Builds a `%Choreo.FSM{}` from a compact Lab DSL block. """ diff --git a/lib/choreo/lab/dsl/infrastructure.ex b/lib/choreo/lab/dsl/infrastructure.ex index a2be993..624bcb7 100644 --- a/lib/choreo/lab/dsl/infrastructure.ex +++ b/lib/choreo/lab/dsl/infrastructure.ex @@ -140,24 +140,24 @@ defmodule Choreo.Lab.DSL.Infrastructure do This is meant as a lightweight Livebook discovery helper when autocomplete is not enough. - iex> verbs = Choreo.Lab.DSL.Infrastructure.verbs() - iex> :vpc in verbs.clusters + iex> taxonomy = Choreo.Lab.DSL.Infrastructure.taxonomy() + iex> :vpc in taxonomy.clusters true - iex> :service in verbs.nodes + iex> :service in taxonomy.nodes true - iex> :~> in verbs.edges + iex> :~> in taxonomy.edges true - iex> :on in verbs.modifiers + iex> :on in taxonomy.modifiers true """ - @spec verbs() :: %{ + @spec taxonomy() :: %{ clusters: [atom()], nodes: [atom()], edges: [atom()], modifiers: [atom()], options: [atom()] } - def verbs do + def taxonomy do %{ clusters: @cluster_verbs, nodes: @node_verbs, @@ -167,6 +167,18 @@ defmodule Choreo.Lab.DSL.Infrastructure do } end + @doc """ + Compatibility alias for `taxonomy/0`. + """ + @spec verbs() :: %{ + clusters: [atom()], + nodes: [atom()], + edges: [atom()], + modifiers: [atom()], + options: [atom()] + } + def verbs, do: taxonomy() + @doc """ Builds a `%Choreo{}` infrastructure sketch from a compact Lab DSL block. """ diff --git a/lib/choreo/lab/dsl/mind_map.ex b/lib/choreo/lab/dsl/mind_map.ex index 3d227bf..9d3c426 100644 --- a/lib/choreo/lab/dsl/mind_map.ex +++ b/lib/choreo/lab/dsl/mind_map.ex @@ -63,21 +63,24 @@ defmodule Choreo.Lab.DSL.MindMap do @doc """ Returns the vocabulary supported by the mind-map DSL. - iex> verbs = Choreo.Lab.DSL.MindMap.verbs() - iex> :root in verbs.nodes + This is meant as a lightweight Livebook discovery helper when autocomplete is + not enough. + + iex> taxonomy = Choreo.Lab.DSL.MindMap.taxonomy() + iex> :root in taxonomy.nodes true - iex> :associate in verbs.edges + iex> :associate in taxonomy.edges true - iex> :on in verbs.modifiers + iex> :on in taxonomy.modifiers true """ - @spec verbs() :: %{ + @spec taxonomy() :: %{ nodes: [atom()], edges: [atom()], modifiers: [atom()], options: [atom()] } - def verbs do + def taxonomy do %{ nodes: @node_verbs, edges: [:~>, :edge, :branch, :associate, :association], @@ -86,6 +89,17 @@ defmodule Choreo.Lab.DSL.MindMap do } end + @doc """ + Compatibility alias for `taxonomy/0`. + """ + @spec verbs() :: %{ + nodes: [atom()], + edges: [atom()], + modifiers: [atom()], + options: [atom()] + } + def verbs, do: taxonomy() + @doc """ Builds a `%Choreo.MindMap{}` from a compact Lab DSL block. """ diff --git a/lib/choreo/lab/view.ex b/lib/choreo/lab/view.ex index cf1c35a..db1b4cc 100644 --- a/lib/choreo/lab/view.ex +++ b/lib/choreo/lab/view.ex @@ -32,21 +32,21 @@ defmodule Choreo.Lab.View do @doc """ Returns the view helper vocabulary for Livebook discovery. - iex> verbs = Choreo.Lab.View.verbs() - iex> :zoom in verbs.transforms + iex> taxonomy = Choreo.Lab.View.taxonomy() + iex> :zoom in taxonomy.transforms true - iex> :only_type in verbs.filters + iex> :only_type in taxonomy.filters true - iex> :collapse_type in verbs.collapse + iex> :collapse_type in taxonomy.collapse true """ - @spec verbs() :: %{ + @spec taxonomy() :: %{ transforms: [atom()], filters: [atom()], collapse: [atom()], options: [atom()] } - def verbs do + def taxonomy do %{ transforms: [:zoom, :focus, :neighborhood, :between, :path, :trace], filters: [:only, :without, :only_nodes, :without_nodes, :only_type, :without_type], @@ -55,6 +55,17 @@ defmodule Choreo.Lab.View do } end + @doc """ + Compatibility alias for `taxonomy/0`. + """ + @spec verbs() :: %{ + transforms: [atom()], + filters: [atom()], + collapse: [atom()], + options: [atom()] + } + def verbs, do: taxonomy() + @doc """ Applies `Choreo.View.zoom/2` with a positional level. diff --git a/test/choreo/lab/compose_test.exs b/test/choreo/lab/compose_test.exs index e685f87..aea940e 100644 --- a/test/choreo/lab/compose_test.exs +++ b/test/choreo/lab/compose_test.exs @@ -5,15 +5,16 @@ defmodule Choreo.Lab.ComposeTest do doctest Choreo.Lab.Compose - test "verbs returns the Livebook discovery vocabulary" do - verbs = Compose.verbs() - - assert :cluster in verbs.structure - assert :embed in verbs.structure - assert :connect in verbs.links - assert :trace in verbs.links - assert :into in verbs.options - assert :as in verbs.options + test "taxonomy returns the Livebook discovery vocabulary" do + taxonomy = Compose.taxonomy() + + assert :cluster in taxonomy.structure + assert :embed in taxonomy.structure + assert :connect in taxonomy.links + assert :trace in taxonomy.links + assert :into in taxonomy.options + assert :as in taxonomy.options + assert Compose.verbs() == taxonomy end test "cluster adds a visual grouping" do diff --git a/test/choreo/lab/dsl/fsm_test.exs b/test/choreo/lab/dsl/fsm_test.exs index f030dc2..710dc99 100644 --- a/test/choreo/lab/dsl/fsm_test.exs +++ b/test/choreo/lab/dsl/fsm_test.exs @@ -5,17 +5,18 @@ defmodule Choreo.Lab.FSMDSLTest do doctest Choreo.Lab.DSL.FSM - test "verbs returns the Livebook discovery vocabulary" do - verbs = Choreo.Lab.DSL.FSM.verbs() - - assert :state in verbs.states - assert :initial in verbs.states - assert :final in verbs.states - assert :~> in verbs.edges - assert :edge in verbs.edges - assert :on in verbs.modifiers - assert :guard in verbs.modifiers - assert :with in verbs.options + test "taxonomy returns the Livebook discovery vocabulary" do + taxonomy = Choreo.Lab.DSL.FSM.taxonomy() + + assert :state in taxonomy.states + assert :initial in taxonomy.states + assert :final in taxonomy.states + assert :~> in taxonomy.edges + assert :edge in taxonomy.edges + assert :on in taxonomy.modifiers + assert :guard in taxonomy.modifiers + assert :with in taxonomy.options + assert Choreo.Lab.DSL.FSM.verbs() == taxonomy end test "builds an FSM with variable-bound states" do diff --git a/test/choreo/lab/dsl/infrastructure_test.exs b/test/choreo/lab/dsl/infrastructure_test.exs index 9d5d7da..f60f5ee 100644 --- a/test/choreo/lab/dsl/infrastructure_test.exs +++ b/test/choreo/lab/dsl/infrastructure_test.exs @@ -5,18 +5,19 @@ defmodule Choreo.Lab.InfrastructureDSLTest do doctest Choreo.Lab.DSL.Infrastructure - test "verbs returns the Livebook discovery vocabulary" do - verbs = Choreo.Lab.DSL.Infrastructure.verbs() - - assert :vpc in verbs.clusters - assert :public_subnet in verbs.clusters - assert :service in verbs.nodes - assert :database in verbs.nodes - assert :~> in verbs.edges - assert :edge in verbs.edges - assert :on in verbs.modifiers - assert :parent in verbs.options - assert :with in verbs.options + test "taxonomy returns the Livebook discovery vocabulary" do + taxonomy = Choreo.Lab.DSL.Infrastructure.taxonomy() + + assert :vpc in taxonomy.clusters + assert :public_subnet in taxonomy.clusters + assert :service in taxonomy.nodes + assert :database in taxonomy.nodes + assert :~> in taxonomy.edges + assert :edge in taxonomy.edges + assert :on in taxonomy.modifiers + assert :parent in taxonomy.options + assert :with in taxonomy.options + assert Choreo.Lab.DSL.Infrastructure.verbs() == taxonomy end test "builds an infrastructure sketch with variable-bound clusters" do diff --git a/test/choreo/lab/dsl/mind_map_test.exs b/test/choreo/lab/dsl/mind_map_test.exs index 0d1d69e..a6698bf 100644 --- a/test/choreo/lab/dsl/mind_map_test.exs +++ b/test/choreo/lab/dsl/mind_map_test.exs @@ -5,18 +5,19 @@ defmodule Choreo.Lab.MindMapDSLTest do doctest Choreo.Lab.DSL.MindMap - test "verbs returns the Livebook discovery vocabulary" do - verbs = Choreo.Lab.DSL.MindMap.verbs() - - assert :root in verbs.nodes - assert :topic in verbs.nodes - assert :subtopic in verbs.nodes - assert :note in verbs.nodes - assert :branch in verbs.edges - assert :associate in verbs.edges - assert :association in verbs.edges - assert :on in verbs.modifiers - assert :with in verbs.options + test "taxonomy returns the Livebook discovery vocabulary" do + taxonomy = Choreo.Lab.DSL.MindMap.taxonomy() + + assert :root in taxonomy.nodes + assert :topic in taxonomy.nodes + assert :subtopic in taxonomy.nodes + assert :note in taxonomy.nodes + assert :branch in taxonomy.edges + assert :associate in taxonomy.edges + assert :association in taxonomy.edges + assert :on in taxonomy.modifiers + assert :with in taxonomy.options + assert Choreo.Lab.DSL.MindMap.verbs() == taxonomy end test "builds a mind map with variable-bound nodes" do diff --git a/test/choreo/lab/view_test.exs b/test/choreo/lab/view_test.exs index ad73938..d96d74c 100644 --- a/test/choreo/lab/view_test.exs +++ b/test/choreo/lab/view_test.exs @@ -7,14 +7,15 @@ defmodule Choreo.Lab.ViewTest do doctest Choreo.Lab.View - test "verbs returns the Livebook discovery vocabulary" do - verbs = View.verbs() - - assert :zoom in verbs.transforms - assert :focus in verbs.transforms - assert :only_type in verbs.filters - assert :without_nodes in verbs.filters - assert :collapse_type in verbs.collapse + test "taxonomy returns the Livebook discovery vocabulary" do + taxonomy = View.taxonomy() + + assert :zoom in taxonomy.transforms + assert :focus in taxonomy.transforms + assert :only_type in taxonomy.filters + assert :without_nodes in taxonomy.filters + assert :collapse_type in taxonomy.collapse + assert View.verbs() == taxonomy end test "zoom is pipe friendly" do From e5a80d93d36546950486089f59cdb01176fbcc47 Mon Sep 17 00:00:00 2001 From: Mafinar Khan Date: Sun, 19 Jul 2026 14:18:00 -0400 Subject: [PATCH 07/13] Add Lab ERD DSL --- .formatter.exs | 44 ++- CHANGELOG.md | 1 + lib/choreo/lab/dsl/erd.ex | 578 +++++++++++++++++++++++++++++++ test/choreo/lab/dsl/erd_test.exs | 199 +++++++++++ 4 files changed, 821 insertions(+), 1 deletion(-) create mode 100644 lib/choreo/lab/dsl/erd.ex create mode 100644 test/choreo/lab/dsl/erd_test.exs diff --git a/.formatter.exs b/.formatter.exs index 95597b6..40f703d 100644 --- a/.formatter.exs +++ b/.formatter.exs @@ -6,6 +6,48 @@ ], locals_without_parens: [ edge: 1, - edge: 2 + edge: 2, + one_to_one: 1, + one_to_one: 2, + one_to_one: 3, + one_to_many: 1, + one_to_many: 2, + one_to_many: 3, + zero_or_one_to_many: 1, + zero_or_one_to_many: 2, + zero_or_one_to_many: 3, + exactly_one_to_many: 1, + exactly_one_to_many: 2, + exactly_one_to_many: 3, + many_to_many: 1, + many_to_many: 2, + many_to_many: 3, + has_one: 1, + has_one: 2, + has_one: 3, + has_many: 1, + has_many: 2, + has_many: 3, + maybe_has_many: 1, + maybe_has_many: 2, + maybe_has_many: 3, + has_at_least_one: 1, + has_at_least_one: 2, + has_at_least_one: 3, + has_and_belongs_to_many: 1, + has_and_belongs_to_many: 2, + has_and_belongs_to_many: 3, + field: 2, + field: 3, + column: 2, + column: 3, + pk: 2, + pk: 3, + primary_key: 2, + primary_key: 3, + fk: 2, + fk: 3, + foreign_key: 2, + foreign_key: 3 ] ] diff --git a/CHANGELOG.md b/CHANGELOG.md index 67b7edb..a11c462 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,6 +7,7 @@ - Added incubating `Choreo.Lab.DSL.Infrastructure` syntax for Livebook-friendly infrastructure sketches over the stable `Choreo` builders, including bindable cluster constructors for VPCs and subnets. - Added incubating `Choreo.Lab.DSL.FSM` syntax for variable-bound finite-state-machine sketches over the stable `Choreo.FSM` builders. - Added incubating `Choreo.Lab.DSL.MindMap` syntax for Livebook-friendly mind-map sketches over the stable `Choreo.MindMap` builders, including typed branch and association edges. +- Added incubating `Choreo.Lab.DSL.ERD` syntax for Livebook-friendly schema sketches over the stable `Choreo.ERD` builders, including block-based table columns and typed cardinality edges. - Added `Choreo.Lab.View` pipe-friendly helpers for Livebook zoom, focus, filter, path, and collapse exploration over `Choreo.View`. - Added `Choreo.Lab.Compose` pipe-friendly helpers for Livebook cluster, embed, connect, and trace composition over `Choreo`. diff --git a/lib/choreo/lab/dsl/erd.ex b/lib/choreo/lab/dsl/erd.ex new file mode 100644 index 0000000..82c94d3 --- /dev/null +++ b/lib/choreo/lab/dsl/erd.ex @@ -0,0 +1,578 @@ +defmodule Choreo.Lab.DSL.ERD do + @moduledoc """ + Experimental Livebook-friendly DSL for sketching entity-relationship diagrams. + + This Lab DSL compiles to the stable, pipe-first `Choreo.ERD` builders and + returns an ordinary `%Choreo.ERD{}`. Tables can be declared as compact column + blocks, while relationship edges expose ERD cardinalities as domain vocabulary. + + ## Examples + + iex> import Choreo.Lab.DSL.ERD + ...> schema = erd do + ...> users = table("users") do + ...> pk :id, :integer + ...> field :email, :varchar, comment: "unique email" + ...> end + ...> + ...> posts = table("posts") do + ...> pk :id, :integer + ...> fk :user_id, :integer + ...> field :title, :varchar + ...> end + ...> + ...> one_to_many users ~> posts, "writes", from: :id, to: :user_id + ...> end + iex> schema.graph.nodes[:users].columns |> Enum.map(& &1[:name]) + [:id, :email] + iex> [meta] = Map.values(schema.edge_meta) + iex> {meta.cardinality, meta.label, meta.from_column, meta.to_column} + {:one_to_many, "writes", :id, :user_id} + + Relationship edges can use typed constructors, generic `edge`, or pipe + modifiers: + + one_to_many users ~> posts, "writes" + has_many users ~> posts, "writes" + edge users ~> posts, one_to_many: "writes" + users ~> posts |> one_to_many("writes") |> columns(:id, :user_id) + + The generic `~>` form defaults to `:one_to_many`, which matches the most common + parent-table-to-child-table sketching direction. + """ + + @type table_decl :: %{id: Yog.node_id(), opts: keyword()} + @type relationship_decl :: %{from: Yog.node_id(), to: Yog.node_id(), opts: keyword()} + + @table_verbs [:table, :entity] + @column_verbs [:field, :column, :pk, :primary_key, :fk, :foreign_key] + + @cardinality_verbs [ + :one_to_one, + :one_to_many, + :zero_or_one_to_many, + :exactly_one_to_many, + :many_to_many, + :has_one, + :has_many, + :maybe_has_many, + :has_at_least_one, + :has_and_belongs_to_many + ] + + @cardinality_aliases %{ + one_to_one: :one_to_one, + one_to_many: :one_to_many, + zero_or_one_to_many: :zero_or_one_to_many, + exactly_one_to_many: :exactly_one_to_many, + many_to_many: :many_to_many, + has_one: :one_to_one, + has_many: :one_to_many, + maybe_has_many: :zero_or_one_to_many, + has_at_least_one: :exactly_one_to_many, + has_and_belongs_to_many: :many_to_many + } + + @doc """ + Returns the vocabulary supported by the ERD DSL. + + This is meant as a lightweight Livebook discovery helper when autocomplete is + not enough. + + iex> taxonomy = Choreo.Lab.DSL.ERD.taxonomy() + iex> :table in taxonomy.tables + true + iex> :pk in taxonomy.columns + true + iex> :one_to_many in taxonomy.edges + true + """ + @spec taxonomy() :: %{ + tables: [atom()], + columns: [atom()], + edges: [atom()], + modifiers: [atom()], + options: [atom()] + } + def taxonomy do + %{ + tables: @table_verbs, + columns: @column_verbs, + edges: [:~>, :edge | @cardinality_verbs], + modifiers: [:on, :label, :columns, :from, :to | @cardinality_verbs], + options: [ + :label, + :with, + :id, + :cardinality, + :from, + :to, + :from_column, + :to_column | @cardinality_verbs + ] + } + end + + @doc """ + Compatibility alias for `taxonomy/0`. + """ + @spec verbs() :: %{ + tables: [atom()], + columns: [atom()], + edges: [atom()], + modifiers: [atom()], + options: [atom()] + } + def verbs, do: taxonomy() + + @doc """ + Builds a `%Choreo.ERD{}` from a compact Lab DSL block. + """ + defmacro erd(do: block) do + compile(block) + end + + defmacro erd(opts, do: block) do + compile(block, opts) + end + + defp compile(block, opts \\ []) do + {steps, _env} = + block + |> statements() + |> Enum.reduce({[], %{}}, fn statement, {steps, env} -> + {statement_steps, env} = statement_steps(statement, env) + {steps ++ statement_steps, env} + end) + + Enum.reduce(steps, quote(do: Choreo.ERD.new(unquote(Macro.escape(opts)))), &pipe_step/2) + end + + defp statements({:__block__, _meta, list}), do: list + defp statements(nil), do: [] + defp statements(single), do: [single] + + defp statement_steps({:=, meta, [{var, _, context}, constructor]}, env) + when is_atom(var) and is_atom(context) do + table = table_from_constructor(constructor, var, meta) + {[{:table, table}], Map.put(env, var, table.id)} + end + + defp statement_steps({:edge, meta, [edge_ast, label]}, env) when is_binary(label) do + {relationship, tables} = relationship_from_ast(edge_ast, [label: label], env, meta) + {relationship_declaration_steps(tables, relationship), env} + end + + defp statement_steps({:edge, meta, [edge_ast, opts]}, env) when is_list(opts) do + {relationship, tables} = + relationship_from_ast(edge_ast, normalize_relationship_opts(opts), env, meta) + + {relationship_declaration_steps(tables, relationship), env} + end + + defp statement_steps({:edge, meta, [edge_ast]}, env) do + {relationship, tables} = relationship_from_ast(edge_ast, [], env, meta) + {relationship_declaration_steps(tables, relationship), env} + end + + defp statement_steps({name, meta, [edge_ast, label, opts]}, env) + when name in [ + :one_to_one, + :one_to_many, + :zero_or_one_to_many, + :exactly_one_to_many, + :many_to_many, + :has_one, + :has_many, + :maybe_has_many, + :has_at_least_one, + :has_and_belongs_to_many + ] and is_binary(label) and is_list(opts) do + typed_relationship_statement(name, edge_ast, [label: label] ++ opts, env, meta) + end + + defp statement_steps({name, meta, [edge_ast, label]}, env) + when name in [ + :one_to_one, + :one_to_many, + :zero_or_one_to_many, + :exactly_one_to_many, + :many_to_many, + :has_one, + :has_many, + :maybe_has_many, + :has_at_least_one, + :has_and_belongs_to_many + ] and is_binary(label) do + typed_relationship_statement(name, edge_ast, [label: label], env, meta) + end + + defp statement_steps({name, meta, [edge_ast, opts]}, env) + when name in [ + :one_to_one, + :one_to_many, + :zero_or_one_to_many, + :exactly_one_to_many, + :many_to_many, + :has_one, + :has_many, + :maybe_has_many, + :has_at_least_one, + :has_and_belongs_to_many + ] and is_list(opts) do + typed_relationship_statement(name, edge_ast, opts, env, meta) + end + + defp statement_steps({name, meta, [edge_ast]}, env) + when name in [ + :one_to_one, + :one_to_many, + :zero_or_one_to_many, + :exactly_one_to_many, + :many_to_many, + :has_one, + :has_many, + :maybe_has_many, + :has_at_least_one, + :has_and_belongs_to_many + ] do + typed_relationship_statement(name, edge_ast, [], env, meta) + end + + defp statement_steps({:|>, _meta, _args} = ast, env) do + {relationship, tables} = relationship_from_piped_ast(ast, env) + {relationship_declaration_steps(tables, relationship), env} + end + + defp statement_steps({:~>, meta, _args} = ast, env) do + {relationship, tables} = relationship_from_ast(ast, [], env, meta) + {relationship_declaration_steps(tables, relationship), env} + end + + defp statement_steps({name, meta, args} = ast, env) when is_atom(name) and is_list(args) do + if table_constructor?(ast) do + table = table_from_constructor(ast, nil, meta) + {[{:table, table}], env} + else + unsupported_statement!(ast, meta) + end + end + + defp statement_steps(other, _env), do: unsupported_statement!(other, nil) + + defp typed_relationship_statement(name, edge_ast, opts, env, meta) do + case cardinality_for(name) do + {:ok, cardinality} -> + opts = opts |> normalize_relationship_opts() |> Keyword.put(:cardinality, cardinality) + {relationship, tables} = relationship_from_ast(edge_ast, opts, env, meta) + {relationship_declaration_steps(tables, relationship), env} + + :error -> + unsupported_statement!({name, meta, [edge_ast | List.wrap(opts)]}, meta) + end + end + + defp relationship_declaration_steps(tables, relationship) do + tables + |> Enum.reduce([{:relationship, relationship}], fn table, steps -> + [{:table, table} | steps] + end) + |> Enum.reverse() + end + + defp relationship_from_piped_ast(ast, env) do + {base, modifiers} = unwrap_pipe(ast, []) + opts = modifiers |> Enum.reduce([], &modifier_opt/2) |> normalize_relationship_opts() + relationship_from_ast(base, opts, env, line_meta(base)) + end + + defp unwrap_pipe({:|>, _meta, [left, right]}, acc), do: unwrap_pipe(left, [right | acc]) + defp unwrap_pipe(base, acc), do: {base, acc} + + defp modifier_opt({name, _meta, [value]}, acc) when name in [:on, :label] do + Keyword.put(acc, :label, value) + end + + defp modifier_opt({:from, _meta, [value]}, acc), do: Keyword.put(acc, :from_column, value) + defp modifier_opt({:to, _meta, [value]}, acc), do: Keyword.put(acc, :to_column, value) + + defp modifier_opt({:columns, _meta, [from_column, to_column]}, acc) do + acc + |> Keyword.put(:from_column, from_column) + |> Keyword.put(:to_column, to_column) + end + + defp modifier_opt({name, _meta, []}, acc) do + case cardinality_for(name) do + {:ok, cardinality} -> Keyword.put(acc, :cardinality, cardinality) + :error -> unsupported_modifier!(name, []) + end + end + + defp modifier_opt({name, _meta, [label]}, acc) when is_binary(label) do + case cardinality_for(name) do + {:ok, cardinality} -> + acc + |> Keyword.put(:cardinality, cardinality) + |> Keyword.put(:label, label) + + :error -> + unsupported_modifier!(name, [label]) + end + end + + defp modifier_opt(other, _acc) do + raise ArgumentError, + "unsupported ERD relationship modifier: #{Macro.to_string(other)}; " <> + "use `on(value)`, `label(value)`, `one_to_many(value)`, or `columns(from, to)`" + end + + defp unsupported_modifier!(name, args) do + rendered = Macro.to_string({name, [], args}) + + raise ArgumentError, + "unsupported ERD relationship modifier: #{rendered}; " <> + "use `on(value)`, `label(value)`, `one_to_many(value)`, or `columns(from, to)`" + end + + defp relationship_from_ast({:~>, meta, [from_ast, to_ast]}, opts, env, _statement_meta) do + {from, from_table} = endpoint_id(from_ast, env, meta) + {to, to_table} = endpoint_id(to_ast, env, meta) + tables = [from_table, to_table] |> Enum.reject(&is_nil/1) |> Enum.uniq_by(& &1.id) + opts = opts |> normalize_relationship_opts() |> Keyword.put_new(:cardinality, :one_to_many) + + {%{from: from, to: to, opts: opts}, tables} + end + + defp relationship_from_ast(other, _opts, _env, meta) do + raise ArgumentError, + "expected `from ~> to` in ERD DSL, got #{Macro.to_string(other)}" <> line_suffix(meta) + end + + defp endpoint_id({var, _meta, context}, env, meta) when is_atom(var) and is_atom(context) do + case Map.fetch(env, var) do + {:ok, id} -> {id, nil} + :error -> raise ArgumentError, "unknown ERD table variable `#{var}`#{line_suffix(meta)}" + end + end + + defp endpoint_id({name, meta, args} = constructor, _env, _statement_meta) + when is_atom(name) and is_list(args) do + if table_constructor?(constructor) do + table = table_from_constructor(constructor, nil, meta) + {table.id, table} + else + raise ArgumentError, "unknown ERD table constructor `#{name}`#{line_suffix(meta)}" + end + end + + defp endpoint_id(other, _env, meta) do + raise ArgumentError, + "unsupported ERD relationship endpoint #{Macro.to_string(other)}#{line_suffix(meta)}; " <> + "bind a table first, e.g. `users = table(\"users\") do ... end`" + end + + defp table_from_constructor({name, meta, args}, var, _statement_meta) + when name in [:table, :entity] and is_list(args) do + {block, args} = pop_do_block(args) + {opts, positional} = pop_trailing_opts(args) + {id, opts} = table_id_and_opts(var, positional, opts, meta) + columns = columns_from_block(block) + opts = Keyword.put_new(opts, :columns, columns) + %{id: id, opts: opts} + end + + defp table_from_constructor(other, _var, meta) do + raise ArgumentError, + "expected ERD table constructor, got #{Macro.to_string(other)}#{line_suffix(meta)}" + end + + defp table_constructor?({name, _meta, args}) when name in [:table, :entity] and is_list(args), + do: true + + defp table_constructor?(_other), do: false + + defp pop_do_block(args) do + case List.last(args) do + [do: block] -> {block, Enum.drop(args, -1)} + _other -> {nil, args} + end + end + + defp pop_trailing_opts(args) do + case List.last(args) do + last when is_list(last) -> + if Keyword.keyword?(last), do: {last, Enum.drop(args, -1)}, else: {[], args} + + _other -> + {[], args} + end + end + + defp table_id_and_opts(var, positional, opts, meta) do + {explicit_id, opts} = Keyword.pop(opts, :id) + + cond do + length(positional) > 1 -> + raise ArgumentError, + "ERD table constructors take at most one positional label/id#{line_suffix(meta)}" + + explicit_id != nil -> + {explicit_id, maybe_put_label(opts, List.first(positional))} + + var != nil -> + {var, maybe_put_label(opts, List.first(positional))} + + positional != [] -> + label_or_id = List.first(positional) + {id_from_label(label_or_id), maybe_put_label(opts, label_or_id)} + + true -> + raise ArgumentError, + "inline ERD table constructors need a label/id or `id:` option#{line_suffix(meta)}" + end + end + + defp columns_from_block(nil), do: [] + + defp columns_from_block(block) do + block + |> statements() + |> Enum.map(&column_from_ast/1) + end + + defp column_from_ast({name, meta, args}) + when name in [:field, :column, :pk, :primary_key, :fk, :foreign_key] do + {opts, positional} = pop_trailing_opts(args) + column_kind = column_kind(name) + column_from_parts(column_kind, positional, opts, meta) + end + + defp column_from_ast(other) do + raise ArgumentError, + "unsupported column declaration in ERD DSL: #{Macro.to_string(other)}; " <> + "use `field name, type`, `pk name, type`, or `fk name, type`" + end + + defp column_from_parts(key, positional, opts, meta) do + cond do + length(positional) != 2 -> + raise ArgumentError, + "ERD column declarations require name and type#{line_suffix(meta)}" + + key == nil -> + opts + + true -> + Keyword.put_new(opts, :key, key) + end + |> Keyword.put(:name, Enum.at(positional, 0)) + |> Keyword.put(:type, Enum.at(positional, 1)) + |> Map.new() + end + + defp column_kind(name) when name in [:pk, :primary_key], do: :pk + defp column_kind(name) when name in [:fk, :foreign_key], do: :fk + defp column_kind(_name), do: nil + + defp maybe_put_label(opts, nil), do: opts + + defp maybe_put_label(opts, label) when is_binary(label), + do: Keyword.put_new(opts, :label, label) + + defp maybe_put_label(opts, label) when is_atom(label), + do: Keyword.put_new(opts, :label, to_string(label)) + + defp maybe_put_label(opts, _other), do: opts + + defp id_from_label(id) when is_atom(id), do: id + defp id_from_label(id) when is_binary(id), do: slug_atom(id) + + defp id_from_label(other) do + raise ArgumentError, + "inline ERD table label/id must be a string or atom, got #{inspect(other)}" + end + + defp slug_atom(label) do + label + |> String.downcase() + |> String.replace(~r/[^a-z0-9]+/u, "_") + |> String.trim("_") + |> case do + "" -> raise ArgumentError, "cannot derive an ERD table id from an empty label" + slug -> String.to_atom(slug) + end + end + + defp normalize_relationship_opts(opts) do + opts + |> normalize_column_alias(:from, :from_column) + |> normalize_column_alias(:to, :to_column) + |> normalize_label_alias(:with) + |> normalize_cardinality_aliases() + end + + defp normalize_column_alias(opts, from_key, to_key) do + {value, opts} = Keyword.pop(opts, from_key) + if value == nil, do: opts, else: Keyword.put_new(opts, to_key, value) + end + + defp normalize_label_alias(opts, key) do + {value, opts} = Keyword.pop(opts, key) + if value == nil, do: opts, else: Keyword.put_new(opts, :label, value) + end + + defp normalize_cardinality_aliases(opts) do + Enum.reduce(@cardinality_aliases, opts, fn {key, cardinality}, acc -> + {value, acc} = Keyword.pop(acc, key) + + if value == nil do + acc + else + acc + |> Keyword.put_new(:cardinality, cardinality) + |> Keyword.put_new(:label, value) + end + end) + end + + defp cardinality_for(name), do: Map.fetch(@cardinality_aliases, name) + + defp pipe_step({:table, %{id: id, opts: opts}}, acc) do + quote do + Choreo.ERD.add_table( + unquote(acc), + unquote(Macro.escape(id)), + unquote(Macro.escape(opts)) + ) + end + end + + defp pipe_step({:relationship, %{from: from, to: to, opts: opts}}, acc) do + quote do + Choreo.ERD.add_relationship( + unquote(acc), + unquote(Macro.escape(from)), + unquote(Macro.escape(to)), + unquote(Macro.escape(opts)) + ) + end + end + + defp unsupported_statement!(ast, meta) do + raise ArgumentError, + "unsupported statement in ERD DSL: #{Macro.to_string(ast)}#{line_suffix(meta)}" + end + + defp line_meta({_name, meta, _args}) when is_list(meta), do: meta + defp line_meta(_other), do: [] + + defp line_suffix(meta) when is_list(meta) do + case Keyword.get(meta, :line) do + nil -> "" + line -> " (line #{line})" + end + end + + defp line_suffix(_meta), do: "" +end diff --git a/test/choreo/lab/dsl/erd_test.exs b/test/choreo/lab/dsl/erd_test.exs new file mode 100644 index 0000000..6d13c87 --- /dev/null +++ b/test/choreo/lab/dsl/erd_test.exs @@ -0,0 +1,199 @@ +defmodule Choreo.Lab.ERDDSLTest do + use ExUnit.Case, async: true + + import Choreo.Lab.DSL.ERD + + doctest Choreo.Lab.DSL.ERD + + test "taxonomy returns the Livebook discovery vocabulary" do + taxonomy = Choreo.Lab.DSL.ERD.taxonomy() + + assert :table in taxonomy.tables + assert :entity in taxonomy.tables + assert :pk in taxonomy.columns + assert :fk in taxonomy.columns + assert :one_to_many in taxonomy.edges + assert :has_many in taxonomy.edges + assert :columns in taxonomy.modifiers + assert :from_column in taxonomy.options + assert Choreo.Lab.DSL.ERD.verbs() == taxonomy + end + + test "builds an ERD with block-based table declarations" do + schema = + erd do + users = + table("users") do + pk :id, :integer + field :email, :varchar, comment: "unique email" + end + + posts = + table("posts") do + pk :id, :integer + fk :user_id, :integer + field :title, :varchar + end + + one_to_many users ~> posts, "writes", from: :id, to: :user_id + end + + assert schema.graph.nodes[:users].label == "users" + + assert schema.graph.nodes[:users].columns == [ + [name: :id, type: :integer, key: :pk], + [name: :email, type: :varchar, comment: "unique email"] + ] + + assert schema.graph.nodes[:posts].columns == [ + [name: :id, type: :integer, key: :pk], + [name: :user_id, type: :integer, key: :fk], + [name: :title, type: :varchar] + ] + + assert [{:users, :posts, 1}] = edge_tuples(schema.graph) + assert [meta] = Map.values(schema.edge_meta) + assert meta.cardinality == :one_to_many + assert meta.label == "writes" + assert meta.from_column == :id + assert meta.to_column == :user_id + end + + test "supports inline table constructors for one-off sketches" do + schema = + erd do + table("users") ~> table("posts") |> one_to_many("writes") + end + + assert Map.has_key?(schema.graph.nodes, :users) + assert Map.has_key?(schema.graph.nodes, :posts) + assert [meta] = Map.values(schema.edge_meta) + assert meta.cardinality == :one_to_many + assert meta.label == "writes" + end + + test "supports id option while keeping display label" do + schema = + erd do + u = + table("users", id: :accounts) do + pk :id, :uuid + end + + k = + table("api_keys") do + pk :id, :uuid + fk :account_id, :uuid + end + + has_many u ~> k, "owns", from: :id, to: :account_id + end + + assert schema.graph.nodes[:accounts].label == "users" + assert [meta] = Map.values(schema.edge_meta) + assert meta.cardinality == :one_to_many + assert meta.label == "owns" + end + + test "supports typed cardinality aliases and keyword edge forms" do + schema = + erd do + users = + table("users") do + pk :id, :integer + end + + profiles = + table("profiles") do + pk :id, :integer + fk :user_id, :integer + end + + roles = + table("roles") do + pk :id, :integer + end + + memberships = + table("memberships") do + pk :id, :integer + fk :user_id, :integer + fk :role_id, :integer + end + + has_one users ~> profiles, "has profile" + edge users ~> memberships, one_to_many: "has membership" + many_to_many users ~> roles, "can have roles" + end + + metas = schema.edge_meta |> Map.values() |> Enum.sort_by(& &1.label) + + assert Enum.map(metas, & &1.cardinality) == [:many_to_many, :one_to_many, :one_to_one] + assert Enum.map(metas, & &1.label) == ["can have roles", "has membership", "has profile"] + end + + test "supports relationship pipe modifiers" do + schema = + erd do + tenants = + table("tenants") do + pk :id, :uuid + end + + users = + table("users") do + pk :id, :uuid + fk :tenant_id, :uuid + end + + tenants ~> users |> has_many("has users") |> columns(:id, :tenant_id) + end + + assert [meta] = Map.values(schema.edge_meta) + assert meta.cardinality == :one_to_many + assert meta.label == "has users" + assert meta.from_column == :id + assert meta.to_column == :tenant_id + end + + test "raises on unknown table variables" do + assert_raise ArgumentError, ~r/unknown ERD table variable `posts`/, fn -> + Code.eval_quoted( + quote do + import Choreo.Lab.DSL.ERD + + erd do + users = + table("users") do + pk :id, :integer + end + + users ~> posts + end + end + ) + end + end + + test "raises on unsupported column declarations" do + assert_raise ArgumentError, ~r/unsupported column declaration/, fn -> + Code.eval_quoted( + quote do + import Choreo.Lab.DSL.ERD + + erd do + table("users") do + index(:email) + end + end + end + ) + end + end + + defp edge_tuples(graph) do + graph.edges + |> Map.values() + |> Enum.sort() + end +end From f9f95245fccc8b92ac9f956538a3f3e573ebbd7a Mon Sep 17 00:00:00 2001 From: Mafinar Khan Date: Sun, 19 Jul 2026 16:04:21 -0400 Subject: [PATCH 08/13] Add Lab UML and Dataflow DSLs --- .formatter.exs | 89 +++- CHANGELOG.md | 2 + lib/choreo/lab/dsl/dataflow.ex | 592 ++++++++++++++++++++++++++ lib/choreo/lab/dsl/uml.ex | 570 +++++++++++++++++++++++++ test/choreo/lab/dsl/dataflow_test.exs | 141 ++++++ test/choreo/lab/dsl/uml_test.exs | 179 ++++++++ 6 files changed, 1572 insertions(+), 1 deletion(-) create mode 100644 lib/choreo/lab/dsl/dataflow.ex create mode 100644 lib/choreo/lab/dsl/uml.ex create mode 100644 test/choreo/lab/dsl/dataflow_test.exs create mode 100644 test/choreo/lab/dsl/uml_test.exs diff --git a/.formatter.exs b/.formatter.exs index 40f703d..31f5507 100644 --- a/.formatter.exs +++ b/.formatter.exs @@ -48,6 +48,93 @@ fk: 2, fk: 3, foreign_key: 2, - foreign_key: 3 + foreign_key: 3, + inherits: 1, + inherits: 2, + inherits: 3, + extends: 1, + extends: 2, + extends: 3, + realizes: 1, + realizes: 2, + realizes: 3, + implements: 1, + implements: 2, + implements: 3, + associates: 1, + associates: 2, + associates: 3, + association: 1, + association: 2, + association: 3, + has: 1, + has: 2, + has: 3, + depends: 1, + depends: 2, + depends: 3, + dependency: 1, + dependency: 2, + dependency: 3, + uses: 1, + uses: 2, + uses: 3, + attribute: 1, + attribute: 2, + attribute: 3, + attr: 1, + attr: 2, + attr: 3, + function: 1, + function: 2, + function: 3, + method: 1, + method: 2, + method: 3, + operation: 1, + operation: 2, + operation: 3, + flow: 1, + flow: 2, + flow: 3, + flows: 1, + flows: 2, + flows: 3, + emits: 1, + emits: 2, + emits: 3, + sends: 1, + sends: 2, + sends: 3, + publishes: 1, + publishes: 2, + publishes: 3, + consumes: 1, + consumes: 2, + consumes: 3, + reads: 1, + reads: 2, + reads: 3, + writes: 1, + writes: 2, + writes: 3, + routes: 1, + routes: 2, + routes: 3, + normal: 1, + normal: 2, + normal: 3, + error: 1, + error: 2, + error: 3, + retry: 1, + retry: 2, + retry: 3, + dead_letter: 1, + dead_letter: 2, + dead_letter: 3, + dlq: 1, + dlq: 2, + dlq: 3 ] ] diff --git a/CHANGELOG.md b/CHANGELOG.md index a11c462..7da0c11 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -8,6 +8,8 @@ - Added incubating `Choreo.Lab.DSL.FSM` syntax for variable-bound finite-state-machine sketches over the stable `Choreo.FSM` builders. - Added incubating `Choreo.Lab.DSL.MindMap` syntax for Livebook-friendly mind-map sketches over the stable `Choreo.MindMap` builders, including typed branch and association edges. - Added incubating `Choreo.Lab.DSL.ERD` syntax for Livebook-friendly schema sketches over the stable `Choreo.ERD` builders, including block-based table columns and typed cardinality edges. +- Added incubating `Choreo.Lab.DSL.UML` syntax for Livebook-friendly class/struct sketches over the stable `Choreo.UML` builders, including block-based fields/functions and typed relationship edges. +- Added incubating `Choreo.Lab.DSL.Dataflow` syntax for Livebook-friendly pipeline sketches over the stable `Choreo.Dataflow` builders, including stage clusters and typed normal/error/retry/dead-letter paths. - Added `Choreo.Lab.View` pipe-friendly helpers for Livebook zoom, focus, filter, path, and collapse exploration over `Choreo.View`. - Added `Choreo.Lab.Compose` pipe-friendly helpers for Livebook cluster, embed, connect, and trace composition over `Choreo`. diff --git a/lib/choreo/lab/dsl/dataflow.ex b/lib/choreo/lab/dsl/dataflow.ex new file mode 100644 index 0000000..d96db3a --- /dev/null +++ b/lib/choreo/lab/dsl/dataflow.ex @@ -0,0 +1,592 @@ +defmodule Choreo.Lab.DSL.Dataflow do + @moduledoc """ + Experimental Livebook-friendly DSL for sketching dataflow pipelines. + + This Lab DSL compiles to the stable, pipe-first `Choreo.Dataflow` builders and + returns an ordinary `%Choreo.Dataflow{}`. It uses node constructors for dataflow + stages and typed edge vocabulary for normal, error, retry, and dead-letter paths. + + ## Examples + + iex> import Choreo.Lab.DSL.Dataflow + ...> pipeline = dataflow do + ...> ingest = source("Kafka Ingest", rate: "10k/s") + ...> parser = transform("JSON Parser", latency_ms: 5) + ...> valid = conditional("Valid?") + ...> postgres = sink("Postgres") + ...> dlq = sink("Dead Letter Queue") + ...> + ...> ingest ~> parser |> emits("raw events") + ...> parser ~> valid |> emits("parsed events") + ...> valid ~> postgres |> writes("valid records") + ...> dead_letter valid ~> dlq, "invalid records" + ...> end + iex> pipeline.graph.nodes[:ingest].node_type + :source + iex> pipeline.edge_meta[{:valid, :dlq}].path_type + :dead_letter + + Edge labels can use generic labels, typed data labels, or explicit path types: + + source ~> transform |> on("events") + edge source ~> transform, data_type: "events" + emits source ~> transform, "events" + error transform ~> sink, "invalid input" + retry transform ~> buffer, "retry later" + dead_letter transform ~> dlq, "poison message" + """ + + @type cluster_decl :: %{id: String.t(), opts: keyword()} + @type node_decl :: %{id: Yog.node_id(), builder: atom(), opts: keyword()} + @type edge_decl :: %{from: Yog.node_id(), to: Yog.node_id(), opts: keyword()} + + @cluster_verbs [:cluster, :stage, :lane] + + @node_verbs [ + :source, + :input, + :producer, + :sink, + :output, + :consumer, + :transform, + :process, + :processor, + :buffer, + :queue, + :topic, + :conditional, + :decision, + :split, + :merge, + :join + ] + + @node_builders %{ + source: :add_source, + input: :add_source, + producer: :add_source, + sink: :add_sink, + output: :add_sink, + consumer: :add_sink, + transform: :add_transform, + process: :add_transform, + processor: :add_transform, + buffer: :add_buffer, + queue: :add_buffer, + topic: :add_buffer, + conditional: :add_conditional, + decision: :add_conditional, + split: :add_conditional, + merge: :add_merge, + join: :add_merge + } + + @edge_verbs [ + :flow, + :flows, + :emits, + :sends, + :publishes, + :consumes, + :reads, + :writes, + :routes, + :normal, + :error, + :retry, + :dead_letter, + :dlq + ] + + @data_label_edges [ + :flow, + :flows, + :emits, + :sends, + :publishes, + :consumes, + :reads, + :writes, + :routes + ] + + @path_edges %{ + normal: :normal, + error: :error, + retry: :retry, + dead_letter: :dead_letter, + dlq: :dead_letter + } + + @doc """ + Returns the vocabulary supported by the dataflow DSL. + + This is meant as a lightweight Livebook discovery helper when autocomplete is + not enough. + + iex> taxonomy = Choreo.Lab.DSL.Dataflow.taxonomy() + iex> :source in taxonomy.nodes + true + iex> :emits in taxonomy.edges + true + iex> :dead_letter in taxonomy.edges + true + """ + @spec taxonomy() :: %{ + clusters: [atom()], + nodes: [atom()], + edges: [atom()], + modifiers: [atom()], + options: [atom()] + } + def taxonomy do + %{ + clusters: @cluster_verbs, + nodes: @node_verbs, + edges: [:~>, :edge | @edge_verbs], + modifiers: [:on, :label, :data, :rate | @edge_verbs], + options: [ + :label, + :with, + :id, + :cluster, + :parent, + :data_type, + :rate, + :path_type, + :weight, + :capacity, + :latency_ms + ] + } + end + + @doc """ + Compatibility alias for `taxonomy/0`. + """ + @spec verbs() :: map() + def verbs, do: taxonomy() + + @doc """ + Builds a `%Choreo.Dataflow{}` from a compact Lab DSL block. + """ + defmacro dataflow(do: block), do: compile(block) + defmacro dataflow(opts, do: block), do: compile(block, opts) + + defp compile(block, opts \\ []) do + {steps, _env} = + block + |> statements() + |> Enum.reduce({[], empty_env()}, fn statement, {steps, env} -> + {statement_steps, env} = statement_steps(statement, env) + {steps ++ statement_steps, env} + end) + + Enum.reduce(steps, quote(do: Choreo.Dataflow.new(unquote(Macro.escape(opts)))), &pipe_step/2) + end + + defp statements({:__block__, _meta, list}), do: list + defp statements(nil), do: [] + defp statements(single), do: [single] + + defp empty_env, do: %{nodes: %{}, clusters: %{}} + + defp statement_steps({:=, meta, [{var, _, context}, constructor]}, env) + when is_atom(var) and is_atom(context) do + cond do + cluster_constructor?(constructor) -> + cluster = cluster_from_constructor(constructor, var, env, meta) + {[{:cluster, cluster}], put_in(env.clusters[var], cluster.id)} + + node_constructor?(constructor) -> + node = node_from_constructor(constructor, var, env, meta) + {[{:node, node}], put_in(env.nodes[var], node.id)} + + true -> + raise ArgumentError, + "expected dataflow constructor, got #{Macro.to_string(constructor)}#{line_suffix(meta)}" + end + end + + defp statement_steps({:edge, meta, [edge_ast, label]}, env) when is_binary(label) do + {edge, nodes} = edge_from_ast(edge_ast, [label: label], env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({:edge, meta, [edge_ast, opts]}, env) when is_list(opts) do + {edge, nodes} = edge_from_ast(edge_ast, normalize_edge_opts(opts), env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({:edge, meta, [edge_ast]}, env) do + {edge, nodes} = edge_from_ast(edge_ast, [], env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + for edge_name <- @edge_verbs do + defp statement_steps({unquote(edge_name), meta, [edge_ast, label, opts]}, env) + when is_binary(label) and is_list(opts) do + typed_edge_statement(unquote(edge_name), edge_ast, [label: label] ++ opts, env, meta) + end + + defp statement_steps({unquote(edge_name), meta, [edge_ast, label]}, env) + when is_binary(label) do + typed_edge_statement(unquote(edge_name), edge_ast, [label: label], env, meta) + end + + defp statement_steps({unquote(edge_name), meta, [edge_ast, opts]}, env) when is_list(opts) do + typed_edge_statement(unquote(edge_name), edge_ast, opts, env, meta) + end + + defp statement_steps({unquote(edge_name), meta, [edge_ast]}, env) do + typed_edge_statement(unquote(edge_name), edge_ast, [], env, meta) + end + end + + defp statement_steps({:|>, _meta, _args} = ast, env) do + {edge, nodes} = edge_from_piped_ast(ast, env) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({:~>, meta, _args} = ast, env) do + {edge, nodes} = edge_from_ast(ast, [], env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({name, meta, args} = ast, env) when is_atom(name) and is_list(args) do + cond do + Map.has_key?(cluster_builders(), name) -> + cluster = cluster_from_constructor(ast, nil, env, meta) + {[{:cluster, cluster}], env} + + Map.has_key?(@node_builders, name) -> + node = node_from_constructor(ast, nil, env, meta) + {[{:node, node}], env} + + true -> + unsupported_statement!(ast, meta) + end + end + + defp statement_steps(other, _env), do: unsupported_statement!(other, nil) + + defp typed_edge_statement(name, edge_ast, opts, env, meta) do + opts = opts |> normalize_edge_opts() |> edge_type_opts(name) + {edge, nodes} = edge_from_ast(edge_ast, opts, env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + defp edge_declaration_steps(nodes, edge) do + nodes + |> Enum.reduce([{:edge, edge}], fn node, steps -> [{:node, node} | steps] end) + |> Enum.reverse() + end + + defp edge_from_piped_ast(ast, env) do + {base, modifiers} = unwrap_pipe(ast, []) + opts = modifiers |> Enum.reduce([], &modifier_opt/2) |> normalize_edge_opts() + edge_from_ast(base, opts, env, line_meta(base)) + end + + defp unwrap_pipe({:|>, _meta, [left, right]}, acc), do: unwrap_pipe(left, [right | acc]) + defp unwrap_pipe(base, acc), do: {base, acc} + + defp modifier_opt({name, _meta, [value]}, acc) when name in [:on, :label] do + Keyword.put(acc, :label, value) + end + + defp modifier_opt({:data, _meta, [value]}, acc), do: Keyword.put(acc, :data_type, value) + defp modifier_opt({:rate, _meta, [value]}, acc), do: Keyword.put(acc, :rate, value) + + defp modifier_opt({name, _meta, []}, acc) when name in @edge_verbs do + edge_type_opts(acc, name) + end + + defp modifier_opt({name, _meta, [value]}, acc) when name in @edge_verbs do + acc + |> edge_type_opts(name) + |> put_edge_label_for(name, value) + end + + defp modifier_opt(other, _acc) do + raise ArgumentError, + "unsupported dataflow edge modifier: #{Macro.to_string(other)}; " <> + "use `on(value)`, `emits(value)`, `error(value)`, `retry(value)`, or `data(value)`" + end + + defp edge_from_ast({:~>, meta, [from_ast, to_ast]}, opts, env, _statement_meta) do + {from, from_node} = endpoint_id(from_ast, env, meta) + {to, to_node} = endpoint_id(to_ast, env, meta) + nodes = [from_node, to_node] |> Enum.reject(&is_nil/1) |> Enum.uniq_by(& &1.id) + opts = opts |> normalize_edge_opts() |> Keyword.put_new(:path_type, :normal) + + {%{from: from, to: to, opts: opts}, nodes} + end + + defp edge_from_ast(other, _opts, _env, meta) do + raise ArgumentError, + "expected `from ~> to` in dataflow DSL, got #{Macro.to_string(other)}" <> + line_suffix(meta) + end + + defp endpoint_id({var, _meta, context}, env, meta) when is_atom(var) and is_atom(context) do + case Map.fetch(env.nodes, var) do + {:ok, id} -> {id, nil} + :error -> raise ArgumentError, "unknown dataflow node variable `#{var}`#{line_suffix(meta)}" + end + end + + defp endpoint_id({name, meta, args} = constructor, env, _statement_meta) + when is_atom(name) and is_list(args) do + if Map.has_key?(@node_builders, name) do + node = node_from_constructor(constructor, nil, env, meta) + {node.id, node} + else + raise ArgumentError, "unknown dataflow node constructor `#{name}`#{line_suffix(meta)}" + end + end + + defp endpoint_id(other, _env, meta) do + raise ArgumentError, + "unsupported dataflow edge endpoint #{Macro.to_string(other)}#{line_suffix(meta)}; " <> + "bind a node first, e.g. `parser = transform(\"Parser\")`" + end + + defp node_from_constructor({name, meta, args}, var, env, _statement_meta) + when is_atom(name) and is_list(args) do + builder = + Map.get(@node_builders, name) || + raise ArgumentError, "unknown dataflow node constructor `#{name}`#{line_suffix(meta)}" + + {opts, positional} = pop_trailing_opts(args) + opts = resolve_cluster_option(opts, :cluster, env, meta) + {id, opts} = node_id_and_opts(var, positional, opts, meta) + %{id: id, builder: builder, opts: opts} + end + + defp cluster_from_constructor({name, meta, args}, var, env, _statement_meta) + when is_atom(name) and is_list(args) do + builder = Map.fetch!(cluster_builders(), name) + {opts, positional} = pop_trailing_opts(args) + opts = resolve_cluster_option(opts, :parent, env, meta) + {id, opts} = cluster_id_and_opts(var, positional, opts, meta) + %{id: id, builder: builder, opts: opts} + end + + defp pop_trailing_opts(args) do + case List.last(args) do + last when is_list(last) -> + if Keyword.keyword?(last), do: {last, Enum.drop(args, -1)}, else: {[], args} + + _other -> + {[], args} + end + end + + defp node_id_and_opts(var, positional, opts, meta) do + {explicit_id, opts} = Keyword.pop(opts, :id) + + cond do + length(positional) > 1 -> + raise ArgumentError, + "node constructors take at most one positional label/id#{line_suffix(meta)}" + + explicit_id != nil -> + {explicit_id, maybe_put_label(opts, List.first(positional))} + + var != nil -> + {var, maybe_put_label(opts, List.first(positional))} + + positional != [] -> + label_or_id = List.first(positional) + {id_from_label(label_or_id), maybe_put_label(opts, label_or_id)} + + true -> + raise ArgumentError, + "inline dataflow node constructors need a label/id or `id:` option#{line_suffix(meta)}" + end + end + + defp cluster_id_and_opts(var, positional, opts, meta) do + {explicit_id, opts} = Keyword.pop(opts, :id) + + cond do + length(positional) > 1 -> + raise ArgumentError, + "cluster constructors take at most one positional label/id#{line_suffix(meta)}" + + explicit_id != nil -> + {to_string(explicit_id), maybe_put_label(opts, List.first(positional))} + + var != nil -> + {to_string(var), maybe_put_label(opts, List.first(positional))} + + positional != [] -> + label_or_id = List.first(positional) + {cluster_id_from_label(label_or_id), maybe_put_label(opts, label_or_id)} + + true -> + raise ArgumentError, + "inline dataflow cluster constructors need a label/id or `id:` option#{line_suffix(meta)}" + end + end + + defp maybe_put_label(opts, nil), do: opts + + defp maybe_put_label(opts, label) when is_binary(label), + do: Keyword.put_new(opts, :label, label) + + defp maybe_put_label(opts, label) when is_atom(label), + do: Keyword.put_new(opts, :label, to_string(label)) + + defp maybe_put_label(opts, _other), do: opts + + defp id_from_label(id) when is_atom(id), do: id + defp id_from_label(id) when is_binary(id), do: slug_atom(id) + + defp id_from_label(other) do + raise ArgumentError, + "inline dataflow node label/id must be a string or atom, got #{inspect(other)}" + end + + defp cluster_id_from_label(id) when is_atom(id), do: to_string(id) + defp cluster_id_from_label(id) when is_binary(id), do: id |> slug_atom() |> to_string() + + defp cluster_id_from_label(other) do + raise ArgumentError, + "inline dataflow cluster label/id must be a string or atom, got #{inspect(other)}" + end + + defp slug_atom(label) do + label + |> String.downcase() + |> String.replace(~r/[^a-z0-9]+/u, "_") + |> String.trim("_") + |> case do + "" -> raise ArgumentError, "cannot derive a dataflow node id from an empty label" + slug -> String.to_atom(slug) + end + end + + defp resolve_cluster_option(opts, key, env, meta) do + Keyword.update(opts, key, nil, &resolve_cluster_reference(&1, env, key, meta)) + |> Keyword.reject(fn {_key, value} -> is_nil(value) end) + end + + defp resolve_cluster_reference({var, _meta, context}, env, key, meta) + when is_atom(var) and is_atom(context) do + case Map.fetch(env.clusters, var) do + {:ok, id} -> + id + + :error -> + raise ArgumentError, + "unknown dataflow cluster variable `#{var}` in `#{key}:`#{line_suffix(meta)}" + end + end + + defp resolve_cluster_reference(value, _env, _key, _meta), do: value + + defp normalize_edge_opts(opts) do + opts + |> normalize_label_alias(:with) + |> normalize_edge_aliases() + end + + defp normalize_label_alias(opts, key) do + {value, opts} = Keyword.pop(opts, key) + if value == nil, do: opts, else: Keyword.put_new(opts, :label, value) + end + + defp normalize_edge_aliases(opts) do + Enum.reduce(@edge_verbs, opts, fn key, acc -> + {value, acc} = Keyword.pop(acc, key) + + if value == nil do + acc + else + acc |> edge_type_opts(key) |> put_edge_label_for(key, value) + end + end) + end + + defp edge_type_opts(opts, name) when name in @data_label_edges do + Keyword.put_new(opts, :path_type, :normal) + end + + defp edge_type_opts(opts, name) do + case Map.fetch(@path_edges, name) do + {:ok, path_type} -> Keyword.put(opts, :path_type, path_type) + :error -> opts + end + end + + defp put_edge_label_for(opts, name, value) when name in @data_label_edges do + opts + |> Keyword.put_new(:data_type, value) + |> Keyword.put_new(:label, value) + end + + defp put_edge_label_for(opts, _name, value), do: Keyword.put_new(opts, :label, value) + + defp cluster_builders, do: %{cluster: :add_cluster, stage: :add_cluster, lane: :add_cluster} + + defp cluster_constructor?({name, _meta, args}) when is_atom(name) and is_list(args), + do: Map.has_key?(cluster_builders(), name) + + defp cluster_constructor?(_other), do: false + + defp node_constructor?({name, _meta, args}) when is_atom(name) and is_list(args), + do: Map.has_key?(@node_builders, name) + + defp node_constructor?(_other), do: false + + defp pipe_step({:cluster, %{id: id, builder: builder, opts: opts}}, acc) do + quote do + apply(Choreo.Dataflow, unquote(builder), [ + unquote(acc), + unquote(Macro.escape(id)), + unquote(Macro.escape(opts)) + ]) + end + end + + defp pipe_step({:node, %{id: id, builder: builder, opts: opts}}, acc) do + quote do + apply(Choreo.Dataflow, unquote(builder), [ + unquote(acc), + unquote(Macro.escape(id)), + unquote(Macro.escape(opts)) + ]) + end + end + + defp pipe_step({:edge, %{from: from, to: to, opts: opts}}, acc) do + quote do + Choreo.Dataflow.connect( + unquote(acc), + unquote(Macro.escape(from)), + unquote(Macro.escape(to)), + unquote(Macro.escape(opts)) + ) + end + end + + defp unsupported_statement!(ast, meta) do + raise ArgumentError, + "unsupported statement in dataflow DSL: #{Macro.to_string(ast)}#{line_suffix(meta)}" + end + + defp line_meta({_name, meta, _args}) when is_list(meta), do: meta + defp line_meta(_other), do: [] + + defp line_suffix(meta) when is_list(meta) do + case Keyword.get(meta, :line) do + nil -> "" + line -> " (line #{line})" + end + end + + defp line_suffix(_meta), do: "" +end diff --git a/lib/choreo/lab/dsl/uml.ex b/lib/choreo/lab/dsl/uml.ex new file mode 100644 index 0000000..7a1adf2 --- /dev/null +++ b/lib/choreo/lab/dsl/uml.ex @@ -0,0 +1,570 @@ +defmodule Choreo.Lab.DSL.UML do + @moduledoc """ + Experimental Livebook-friendly DSL for sketching UML class diagrams. + + This Lab DSL compiles to the stable, pipe-first `Choreo.UML` builders and + returns an ordinary `%Choreo.UML{}`. Classes, structs, behaviors, protocols, + and interfaces can be declared with block-based fields and functions. Edges + expose UML relationship types as readable domain vocabulary. + + ## Examples + + iex> import Choreo.Lab.DSL.UML + ...> diagram = uml do + ...> user = struct("User") do + ...> field :id, :integer + ...> private field(:email, :string) + ...> function :authenticate, 2, return: :boolean + ...> end + ...> + ...> auth = behavior("AuthProvider") do + ...> function :verify, 1, return: :ok_error + ...> end + ...> + ...> realizes user ~> auth, "implements" + ...> end + iex> diagram.graph.nodes[:user].type + :struct + iex> diagram.graph.nodes[:user].fields |> Enum.map(& &1[:name]) + ["id", "email"] + iex> [meta] = Map.values(diagram.edge_meta) + iex> {meta.type, meta.label} + {:realizes, "implements"} + + Relationship edges can use typed constructors, generic `edge`, or pipe + modifiers: + + inherits child ~> parent, "extends" + realizes adapter ~> protocol, "implements" + associates user ~> profile, "has one" + depends controller ~> repo, "calls" + edge controller ~> repo, depends: "calls" + controller ~> repo |> depends("calls") + + The generic `~>` form defaults to `:depends`, which matches a lightweight + dependency sketch. + """ + + @type class_decl :: %{id: Yog.node_id(), opts: keyword()} + @type relationship_decl :: %{from: Yog.node_id(), to: Yog.node_id(), opts: keyword()} + + @node_verbs [:class, :struct, :behavior, :protocol, :interface] + @member_verbs [ + :field, + :attribute, + :attr, + :function, + :method, + :operation, + :private, + :protected, + :public + ] + + @relationship_verbs [ + :inherits, + :extends, + :realizes, + :implements, + :associates, + :association, + :has, + :depends, + :dependency, + :uses + ] + + @node_types %{ + class: :class, + struct: :struct, + behavior: :behavior, + protocol: :protocol, + interface: :interface + } + + @relationship_aliases %{ + inherits: :inherits, + extends: :inherits, + realizes: :realizes, + implements: :realizes, + associates: :associates, + association: :associates, + has: :associates, + depends: :depends, + dependency: :depends, + uses: :depends + } + + @doc """ + Returns the vocabulary supported by the UML DSL. + + This is meant as a lightweight Livebook discovery helper when autocomplete is + not enough. + + iex> taxonomy = Choreo.Lab.DSL.UML.taxonomy() + iex> :struct in taxonomy.nodes + true + iex> :function in taxonomy.members + true + iex> :implements in taxonomy.edges + true + """ + @spec taxonomy() :: %{ + nodes: [atom()], + members: [atom()], + edges: [atom()], + modifiers: [atom()], + options: [atom()] + } + def taxonomy do + %{ + nodes: @node_verbs, + members: @member_verbs, + edges: [:~>, :edge | @relationship_verbs], + modifiers: [:on, :label | @relationship_verbs], + options: [:label, :with, :id, :type, :arity, :return, :visibility | @relationship_verbs] + } + end + + @doc """ + Compatibility alias for `taxonomy/0`. + """ + @spec verbs() :: %{ + nodes: [atom()], + members: [atom()], + edges: [atom()], + modifiers: [atom()], + options: [atom()] + } + def verbs, do: taxonomy() + + @doc """ + Builds a `%Choreo.UML{}` from a compact Lab DSL block. + """ + defmacro uml(do: block) do + compile(block) + end + + defmacro uml(opts, do: block) do + compile(block, opts) + end + + defp compile(block, opts \\ []) do + {steps, _env} = + block + |> statements() + |> Enum.reduce({[], %{}}, fn statement, {steps, env} -> + {statement_steps, env} = statement_steps(statement, env) + {steps ++ statement_steps, env} + end) + + Enum.reduce(steps, quote(do: Choreo.UML.new(unquote(Macro.escape(opts)))), &pipe_step/2) + end + + defp statements({:__block__, _meta, list}), do: list + defp statements(nil), do: [] + defp statements(single), do: [single] + + defp statement_steps({:=, meta, [{var, _, context}, constructor]}, env) + when is_atom(var) and is_atom(context) do + class = class_from_constructor(constructor, var, meta) + {[{:class, class}], Map.put(env, var, class.id)} + end + + defp statement_steps({:edge, meta, [edge_ast, label]}, env) when is_binary(label) do + {relationship, classes} = relationship_from_ast(edge_ast, [label: label], env, meta) + {relationship_declaration_steps(classes, relationship), env} + end + + defp statement_steps({:edge, meta, [edge_ast, opts]}, env) when is_list(opts) do + {relationship, classes} = + relationship_from_ast(edge_ast, normalize_relationship_opts(opts), env, meta) + + {relationship_declaration_steps(classes, relationship), env} + end + + defp statement_steps({:edge, meta, [edge_ast]}, env) do + {relationship, classes} = relationship_from_ast(edge_ast, [], env, meta) + {relationship_declaration_steps(classes, relationship), env} + end + + for relationship <- @relationship_verbs do + defp statement_steps({unquote(relationship), meta, [edge_ast, label, opts]}, env) + when is_binary(label) and is_list(opts) do + typed_relationship_statement( + unquote(relationship), + edge_ast, + [label: label] ++ opts, + env, + meta + ) + end + + defp statement_steps({unquote(relationship), meta, [edge_ast, label]}, env) + when is_binary(label) do + typed_relationship_statement(unquote(relationship), edge_ast, [label: label], env, meta) + end + + defp statement_steps({unquote(relationship), meta, [edge_ast, opts]}, env) + when is_list(opts) do + typed_relationship_statement(unquote(relationship), edge_ast, opts, env, meta) + end + + defp statement_steps({unquote(relationship), meta, [edge_ast]}, env) do + typed_relationship_statement(unquote(relationship), edge_ast, [], env, meta) + end + end + + defp statement_steps({:|>, _meta, _args} = ast, env) do + {relationship, classes} = relationship_from_piped_ast(ast, env) + {relationship_declaration_steps(classes, relationship), env} + end + + defp statement_steps({:~>, meta, _args} = ast, env) do + {relationship, classes} = relationship_from_ast(ast, [], env, meta) + {relationship_declaration_steps(classes, relationship), env} + end + + defp statement_steps({name, meta, args} = ast, env) when is_atom(name) and is_list(args) do + if class_constructor?(ast) do + class = class_from_constructor(ast, nil, meta) + {[{:class, class}], env} + else + unsupported_statement!(ast, meta) + end + end + + defp statement_steps(other, _env), do: unsupported_statement!(other, nil) + + defp typed_relationship_statement(name, edge_ast, opts, env, meta) do + opts = opts |> normalize_relationship_opts() |> Keyword.put(:type, relationship_type!(name)) + {relationship, classes} = relationship_from_ast(edge_ast, opts, env, meta) + {relationship_declaration_steps(classes, relationship), env} + end + + defp relationship_declaration_steps(classes, relationship) do + classes + |> Enum.reduce([{:relationship, relationship}], fn class, steps -> + [{:class, class} | steps] + end) + |> Enum.reverse() + end + + defp relationship_from_piped_ast(ast, env) do + {base, modifiers} = unwrap_pipe(ast, []) + opts = modifiers |> Enum.reduce([], &modifier_opt/2) |> normalize_relationship_opts() + relationship_from_ast(base, opts, env, line_meta(base)) + end + + defp unwrap_pipe({:|>, _meta, [left, right]}, acc), do: unwrap_pipe(left, [right | acc]) + defp unwrap_pipe(base, acc), do: {base, acc} + + defp modifier_opt({name, _meta, [value]}, acc) when name in [:on, :label] do + Keyword.put(acc, :label, value) + end + + defp modifier_opt({name, _meta, []}, acc) do + if relationship_name?(name) do + Keyword.put(acc, :type, relationship_type!(name)) + else + unsupported_modifier!(name, []) + end + end + + defp modifier_opt({name, _meta, [label]}, acc) when is_binary(label) do + if relationship_name?(name) do + acc + |> Keyword.put(:type, relationship_type!(name)) + |> Keyword.put(:label, label) + else + unsupported_modifier!(name, [label]) + end + end + + defp modifier_opt(other, _acc) do + raise ArgumentError, + "unsupported UML relationship modifier: #{Macro.to_string(other)}; " <> + "use `on(value)`, `label(value)`, `depends(value)`, or `implements(value)`" + end + + defp unsupported_modifier!(name, args) do + rendered = Macro.to_string({name, [], args}) + + raise ArgumentError, + "unsupported UML relationship modifier: #{rendered}; " <> + "use `on(value)`, `label(value)`, `depends(value)`, or `implements(value)`" + end + + defp relationship_from_ast({:~>, meta, [from_ast, to_ast]}, opts, env, _statement_meta) do + {from, from_class} = endpoint_id(from_ast, env, meta) + {to, to_class} = endpoint_id(to_ast, env, meta) + classes = [from_class, to_class] |> Enum.reject(&is_nil/1) |> Enum.uniq_by(& &1.id) + opts = opts |> normalize_relationship_opts() |> Keyword.put_new(:type, :depends) + + {%{from: from, to: to, opts: opts}, classes} + end + + defp relationship_from_ast(other, _opts, _env, meta) do + raise ArgumentError, + "expected `from ~> to` in UML DSL, got #{Macro.to_string(other)}" <> line_suffix(meta) + end + + defp endpoint_id({var, _meta, context}, env, meta) when is_atom(var) and is_atom(context) do + case Map.fetch(env, var) do + {:ok, id} -> {id, nil} + :error -> raise ArgumentError, "unknown UML class variable `#{var}`#{line_suffix(meta)}" + end + end + + defp endpoint_id({name, meta, args} = constructor, _env, _statement_meta) + when is_atom(name) and is_list(args) do + if class_constructor?(constructor) do + class = class_from_constructor(constructor, nil, meta) + {class.id, class} + else + raise ArgumentError, "unknown UML class constructor `#{name}`#{line_suffix(meta)}" + end + end + + defp endpoint_id(other, _env, meta) do + raise ArgumentError, + "unsupported UML relationship endpoint #{Macro.to_string(other)}#{line_suffix(meta)}; " <> + "bind a class first, e.g. `user = struct(\"User\") do ... end`" + end + + defp class_from_constructor({name, meta, args}, var, _statement_meta) + when is_map_key(@node_types, name) and is_list(args) do + {block, args} = pop_do_block(args) + {opts, positional} = pop_trailing_opts(args) + {id, opts} = class_id_and_opts(var, positional, opts, meta) + {fields, functions} = members_from_block(block) + + opts = + opts + |> Keyword.put(:type, @node_types[name]) + |> Keyword.put_new(:fields, fields) + |> Keyword.put_new(:functions, functions) + + %{id: id, opts: opts} + end + + defp class_from_constructor(other, _var, meta) do + raise ArgumentError, + "expected UML class constructor, got #{Macro.to_string(other)}#{line_suffix(meta)}" + end + + defp class_constructor?({name, _meta, args}) + when is_map_key(@node_types, name) and is_list(args), do: true + + defp class_constructor?(_other), do: false + + defp pop_do_block(args) do + case List.last(args) do + [do: block] -> {block, Enum.drop(args, -1)} + _other -> {nil, args} + end + end + + defp pop_trailing_opts(args) do + case List.last(args) do + last when is_list(last) -> + if Keyword.keyword?(last), do: {last, Enum.drop(args, -1)}, else: {[], args} + + _other -> + {[], args} + end + end + + defp class_id_and_opts(var, positional, opts, meta) do + {explicit_id, opts} = Keyword.pop(opts, :id) + + cond do + length(positional) > 1 -> + raise ArgumentError, + "UML class constructors take at most one positional label/id#{line_suffix(meta)}" + + explicit_id != nil -> + {explicit_id, maybe_put_label(opts, List.first(positional))} + + var != nil -> + {var, maybe_put_label(opts, List.first(positional))} + + positional != [] -> + label_or_id = List.first(positional) + {id_from_label(label_or_id), maybe_put_label(opts, label_or_id)} + + true -> + raise ArgumentError, + "inline UML class constructors need a label/id or `id:` option#{line_suffix(meta)}" + end + end + + defp members_from_block(nil), do: {[], []} + + defp members_from_block(block) do + {fields, functions} = + block + |> statements() + |> Enum.reduce({[], []}, fn statement, {fields, functions} -> + case member_from_ast(statement) do + {:field, field} -> {[field | fields], functions} + {:function, function} -> {fields, [function | functions]} + end + end) + + {Enum.reverse(fields), Enum.reverse(functions)} + end + + defp member_from_ast({visibility, _meta, [inner]}) + when visibility in [:private, :protected, :public] do + {kind, member} = member_from_ast(inner) + {kind, Map.put(member, :visibility, visibility)} + end + + defp member_from_ast({name, meta, args}) when name in [:field, :attribute, :attr] do + {opts, positional} = pop_trailing_opts(args) + {:field, member_from_parts(:field, positional, opts, meta)} + end + + defp member_from_ast({name, meta, args}) when name in [:function, :method, :operation] do + {opts, positional} = pop_trailing_opts(args) + {:function, member_from_parts(:function, positional, opts, meta)} + end + + defp member_from_ast(other) do + raise ArgumentError, + "unsupported member declaration in UML DSL: #{Macro.to_string(other)}; " <> + "use `field name, type`, `function name, arity`, or visibility wrappers like `private field(...)`" + end + + defp member_from_parts(:field, [name], opts, _meta) do + opts + |> Keyword.put(:name, name) + |> Map.new() + end + + defp member_from_parts(:field, [name, type], opts, _meta) do + opts + |> Keyword.put(:name, name) + |> Keyword.put_new(:type, type) + |> Map.new() + end + + defp member_from_parts(:field, _positional, _opts, meta) do + raise ArgumentError, + "UML field declarations require name and optional type#{line_suffix(meta)}" + end + + defp member_from_parts(:function, [name], opts, _meta) do + opts + |> Keyword.put(:name, name) + |> Map.new() + end + + defp member_from_parts(:function, [name, arity], opts, _meta) do + opts + |> Keyword.put(:name, name) + |> Keyword.put_new(:arity, arity) + |> Map.new() + end + + defp member_from_parts(:function, _positional, _opts, meta) do + raise ArgumentError, + "UML function declarations require name and optional arity#{line_suffix(meta)}" + end + + defp maybe_put_label(opts, nil), do: opts + + defp maybe_put_label(opts, label) when is_binary(label), + do: Keyword.put_new(opts, :label, label) + + defp maybe_put_label(opts, label) when is_atom(label), + do: Keyword.put_new(opts, :label, to_string(label)) + + defp maybe_put_label(opts, _other), do: opts + + defp id_from_label(id) when is_atom(id), do: id + defp id_from_label(id) when is_binary(id), do: slug_atom(id) + + defp id_from_label(other) do + raise ArgumentError, + "inline UML class label/id must be a string or atom, got #{inspect(other)}" + end + + defp slug_atom(label) do + label + |> String.downcase() + |> String.replace(~r/[^a-z0-9]+/u, "_") + |> String.trim("_") + |> case do + "" -> raise ArgumentError, "cannot derive a UML class id from an empty label" + slug -> String.to_atom(slug) + end + end + + defp normalize_relationship_opts(opts) do + opts + |> normalize_label_alias(:with) + |> normalize_relationship_aliases() + end + + defp normalize_label_alias(opts, key) do + {value, opts} = Keyword.pop(opts, key) + if value == nil, do: opts, else: Keyword.put_new(opts, :label, value) + end + + defp normalize_relationship_aliases(opts) do + Enum.reduce(@relationship_aliases, opts, fn {key, type}, acc -> + {value, acc} = Keyword.pop(acc, key) + + if value == nil do + acc + else + acc + |> Keyword.put_new(:type, type) + |> Keyword.put_new(:label, value) + end + end) + end + + defp relationship_name?(name), do: Map.has_key?(@relationship_aliases, name) + defp relationship_type!(name), do: Map.fetch!(@relationship_aliases, name) + + defp pipe_step({:class, %{id: id, opts: opts}}, acc) do + quote do + Choreo.UML.add_class( + unquote(acc), + unquote(Macro.escape(id)), + unquote(Macro.escape(opts)) + ) + end + end + + defp pipe_step({:relationship, %{from: from, to: to, opts: opts}}, acc) do + quote do + Choreo.UML.add_relationship( + unquote(acc), + unquote(Macro.escape(from)), + unquote(Macro.escape(to)), + unquote(Macro.escape(opts)) + ) + end + end + + defp unsupported_statement!(ast, meta) do + raise ArgumentError, + "unsupported statement in UML DSL: #{Macro.to_string(ast)}#{line_suffix(meta)}" + end + + defp line_meta({_name, meta, _args}) when is_list(meta), do: meta + defp line_meta(_other), do: [] + + defp line_suffix(meta) when is_list(meta) do + case Keyword.get(meta, :line) do + nil -> "" + line -> " (line #{line})" + end + end + + defp line_suffix(_meta), do: "" +end diff --git a/test/choreo/lab/dsl/dataflow_test.exs b/test/choreo/lab/dsl/dataflow_test.exs new file mode 100644 index 0000000..452f70b --- /dev/null +++ b/test/choreo/lab/dsl/dataflow_test.exs @@ -0,0 +1,141 @@ +defmodule Choreo.Lab.DataflowDSLTest do + use ExUnit.Case, async: true + + import Choreo.Lab.DSL.Dataflow + + doctest Choreo.Lab.DSL.Dataflow + + test "taxonomy returns the Livebook discovery vocabulary" do + taxonomy = Choreo.Lab.DSL.Dataflow.taxonomy() + + assert :cluster in taxonomy.clusters + assert :source in taxonomy.nodes + assert :transform in taxonomy.nodes + assert :sink in taxonomy.nodes + assert :emits in taxonomy.edges + assert :dead_letter in taxonomy.edges + assert :data in taxonomy.modifiers + assert :path_type in taxonomy.options + assert Choreo.Lab.DSL.Dataflow.verbs() == taxonomy + end + + test "builds a dataflow pipeline with variable-bound nodes" do + pipeline = + dataflow do + ingest = source("Kafka Ingest", rate: "10k/s") + parser = transform("JSON Parser", latency_ms: 5) + valid = conditional("Valid?") + postgres = sink("Postgres") + dlq = sink("Dead Letter Queue") + + ingest ~> parser |> emits("raw events") + parser ~> valid |> emits("parsed events") + valid ~> postgres |> writes("valid records") + dead_letter valid ~> dlq, "invalid records" + end + + assert pipeline.graph.nodes[:ingest].node_type == :source + assert pipeline.graph.nodes[:ingest].rate == "10k/s" + assert pipeline.graph.nodes[:parser].node_type == :transform + assert pipeline.graph.nodes[:parser].latency_ms == 5 + assert pipeline.graph.nodes[:valid].node_type == :conditional + assert pipeline.graph.nodes[:postgres].node_type == :sink + + assert pipeline.edge_meta[{:ingest, :parser}].data_type == "raw events" + assert pipeline.edge_meta[{:ingest, :parser}].label == "raw events" + assert pipeline.edge_meta[{:valid, :dlq}].path_type == :dead_letter + assert pipeline.edge_meta[{:valid, :dlq}].label == "invalid records" + end + + test "supports clusters and cluster variables" do + pipeline = + dataflow do + ingest_stage = stage("Ingestion") + process_stage = cluster("Processing") + + kafka = source("Kafka", cluster: ingest_stage) + parser = transform("Parser", cluster: process_stage) + sink = sink("Warehouse", cluster: process_stage) + + kafka ~> parser |> emits("events") + parser ~> sink |> writes("rows") + end + + assert pipeline.clusters["cluster_ingest_stage"].label == "Ingestion" + assert pipeline.clusters["cluster_process_stage"].label == "Processing" + assert pipeline.graph.nodes[:kafka].cluster == "cluster_ingest_stage" + assert pipeline.graph.nodes[:parser].cluster == "cluster_process_stage" + end + + test "supports inline constructors for one-off sketches" do + pipeline = + dataflow do + source("Kafka") ~> transform("Parser") |> emits("events") + end + + assert pipeline.graph.nodes[:kafka].label == "Kafka" + assert pipeline.graph.nodes[:parser].node_type == :transform + assert [{:kafka, :parser, 1}] = Choreo.Dataflow.edges(pipeline) + end + + test "supports id option while keeping display label" do + pipeline = + dataflow do + src = source("Kafka Ingest", id: :kafka) + out = sink("Warehouse") + + edge src ~> out, "events" + end + + assert pipeline.graph.nodes[:kafka].label == "Kafka Ingest" + assert pipeline.edge_meta[{:kafka, :out}].label == "events" + end + + test "supports typed keyword edges and path types" do + pipeline = + dataflow do + parser = transform("Parser") + sink = sink("Warehouse") + retry_q = queue("Retry Queue") + errors = sink("Errors") + + edge parser ~> sink, writes: "valid rows" + retry parser ~> retry_q, "temporary failure" + error parser ~> errors, "invalid input" + end + + assert pipeline.edge_meta[{:parser, :sink}].data_type == "valid rows" + assert pipeline.edge_meta[{:parser, :sink}].path_type == :normal + assert pipeline.edge_meta[{:parser, :retry_q}].path_type == :retry + assert pipeline.edge_meta[{:parser, :errors}].path_type == :error + end + + test "supports explicit data and rate modifiers" do + pipeline = + dataflow do + in_stream = source("Input") + out_stream = sink("Output") + + in_stream ~> out_stream |> data("json") |> rate("100/s") + end + + assert pipeline.edge_meta[{:in_stream, :out_stream}].data_type == "json" + assert pipeline.edge_meta[{:in_stream, :out_stream}].rate == "100/s" + assert pipeline.edge_meta[{:in_stream, :out_stream}].label == "json" + end + + test "raises on unknown node variables" do + assert_raise ArgumentError, ~r/unknown dataflow node variable `sink`/, fn -> + Code.eval_quoted( + quote do + import Choreo.Lab.DSL.Dataflow + + dataflow do + src = source("Input") + src ~> sink + end + end + ) + end + end +end diff --git a/test/choreo/lab/dsl/uml_test.exs b/test/choreo/lab/dsl/uml_test.exs new file mode 100644 index 0000000..3847eeb --- /dev/null +++ b/test/choreo/lab/dsl/uml_test.exs @@ -0,0 +1,179 @@ +defmodule Choreo.Lab.UMLDSLTest do + use ExUnit.Case, async: true + + import Choreo.Lab.DSL.UML + + doctest Choreo.Lab.DSL.UML + + test "taxonomy returns the Livebook discovery vocabulary" do + taxonomy = Choreo.Lab.DSL.UML.taxonomy() + + assert :class in taxonomy.nodes + assert :struct in taxonomy.nodes + assert :protocol in taxonomy.nodes + assert :field in taxonomy.members + assert :function in taxonomy.members + assert :implements in taxonomy.edges + assert :depends in taxonomy.modifiers + assert :visibility in taxonomy.options + assert Choreo.Lab.DSL.UML.verbs() == taxonomy + end + + test "builds a UML diagram with block-based class declarations" do + diagram = + uml do + user = + struct("User") do + field :id, :integer + private(field(:email, :string)) + function :authenticate, 2, return: :boolean + end + + auth = + behavior("AuthProvider") do + function :verify, 1, return: :ok_error + end + + realizes user ~> auth, "implements" + end + + assert diagram.graph.nodes[:user].type == :struct + assert diagram.graph.nodes[:user].label == "User" + + assert Enum.map(diagram.graph.nodes[:user].fields, &Map.new/1) == [ + %{name: "id", type: :integer, visibility: :public}, + %{name: "email", type: :string, visibility: :private} + ] + + assert Enum.map(diagram.graph.nodes[:user].functions, &Map.new/1) == [ + %{name: "authenticate", arity: 2, return: :boolean, visibility: :public} + ] + + assert diagram.graph.nodes[:auth].type == :behavior + assert [meta] = Map.values(diagram.edge_meta) + assert meta.type == :realizes + assert meta.label == "implements" + end + + test "supports inline constructors for one-off sketches" do + diagram = + uml do + class("Controller") ~> class("Repo") |> depends("calls") + end + + assert Map.has_key?(diagram.graph.nodes, :controller) + assert Map.has_key?(diagram.graph.nodes, :repo) + assert [meta] = Map.values(diagram.edge_meta) + assert meta.type == :depends + assert meta.label == "calls" + end + + test "supports id option while keeping display label" do + diagram = + uml do + impl = + struct("PostgresRepo", id: :repo) do + function :get, 1 + end + + contract = + protocol("Repository") do + function :get, 1 + end + + implements impl ~> contract, "satisfies" + end + + assert diagram.graph.nodes[:repo].label == "PostgresRepo" + assert [meta] = Map.values(diagram.edge_meta) + assert meta.type == :realizes + assert meta.label == "satisfies" + end + + test "supports typed relationship aliases and keyword edge forms" do + diagram = + uml do + base = class("Base") + child = class("Child") + service = class("Service") + repo = class("Repo") + profile = struct("Profile") + + extends child ~> base, "inherits behavior" + edge service ~> repo, uses: "queries" + has service ~> profile, "owns" + end + + metas = diagram.edge_meta |> Map.values() |> Enum.sort_by(& &1.label) + + assert Enum.map(metas, & &1.type) == [:inherits, :associates, :depends] + assert Enum.map(metas, & &1.label) == ["inherits behavior", "owns", "queries"] + end + + test "supports relationship pipe modifiers" do + diagram = + uml do + controller = class("Controller") + repo = class("Repo") + behaviour = behavior("RepoBehaviour") + + controller ~> repo |> depends("calls") + repo ~> behaviour |> implements("contract") + end + + metas = diagram.edge_meta |> Map.values() |> Enum.sort_by(& &1.label) + + assert Enum.map(metas, & &1.type) == [:depends, :realizes] + assert Enum.map(metas, & &1.label) == ["calls", "contract"] + end + + test "supports protected and public visibility wrappers" do + diagram = + uml do + service = + class("Service") do + protected(field(:state, :map)) + public(method(:call, 1, return: :ok)) + end + end + + assert Enum.map(diagram.graph.nodes[:service].fields, &Map.new/1) == [ + %{name: "state", type: :map, visibility: :protected} + ] + + assert Enum.map(diagram.graph.nodes[:service].functions, &Map.new/1) == [ + %{name: "call", arity: 1, return: :ok, visibility: :public} + ] + end + + test "raises on unknown class variables" do + assert_raise ArgumentError, ~r/unknown UML class variable `repo`/, fn -> + Code.eval_quoted( + quote do + import Choreo.Lab.DSL.UML + + uml do + service = class("Service") + service ~> repo + end + end + ) + end + end + + test "raises on unsupported member declarations" do + assert_raise ArgumentError, ~r/unsupported member declaration/, fn -> + Code.eval_quoted( + quote do + import Choreo.Lab.DSL.UML + + uml do + class("Service") do + callback(:call, 1) + end + end + end + ) + end + end +end From 16b360097465b0ad9e0a18bdf3e16ffd07a155d3 Mon Sep 17 00:00:00 2001 From: Mafinar Khan Date: Sun, 19 Jul 2026 17:37:30 -0400 Subject: [PATCH 09/13] Add Lab Sequence DSL --- .formatter.exs | 50 ++- CHANGELOG.md | 1 + lib/choreo/lab/dsl/sequence.ex | 611 ++++++++++++++++++++++++++ test/choreo/lab/dsl/sequence_test.exs | 169 +++++++ 4 files changed, 830 insertions(+), 1 deletion(-) create mode 100644 lib/choreo/lab/dsl/sequence.ex create mode 100644 test/choreo/lab/dsl/sequence_test.exs diff --git a/.formatter.exs b/.formatter.exs index 31f5507..33c1f72 100644 --- a/.formatter.exs +++ b/.formatter.exs @@ -135,6 +135,54 @@ dead_letter: 3, dlq: 1, dlq: 2, - dlq: 3 + dlq: 3, + actor: 1, + actor: 2, + participant: 1, + participant: 2, + service: 1, + service: 2, + system: 1, + system: 2, + message: 1, + message: 2, + message: 3, + call: 1, + call: 2, + call: 3, + request: 1, + request: 2, + request: 3, + sync: 1, + sync: 2, + sync: 3, + async: 1, + async: 2, + async: 3, + signal: 1, + signal: 2, + signal: 3, + publish: 1, + publish: 2, + publish: 3, + reply: 1, + reply: 2, + reply: 3, + return: 1, + return: 2, + return: 3, + response: 1, + response: 2, + response: 3, + activate: 1, + deactivate: 1, + over: 2, + left: 2, + right: 2, + between: 3, + note: 2, + otherwise: 1, + else: 1, + and: 1 ] ] diff --git a/CHANGELOG.md b/CHANGELOG.md index 7da0c11..b5854f1 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,6 +10,7 @@ - Added incubating `Choreo.Lab.DSL.ERD` syntax for Livebook-friendly schema sketches over the stable `Choreo.ERD` builders, including block-based table columns and typed cardinality edges. - Added incubating `Choreo.Lab.DSL.UML` syntax for Livebook-friendly class/struct sketches over the stable `Choreo.UML` builders, including block-based fields/functions and typed relationship edges. - Added incubating `Choreo.Lab.DSL.Dataflow` syntax for Livebook-friendly pipeline sketches over the stable `Choreo.Dataflow` builders, including stage clusters and typed normal/error/retry/dead-letter paths. +- Added incubating `Choreo.Lab.DSL.Sequence` syntax for Livebook-friendly sequence sketches over the stable `Choreo.Sequence` builders, including ordered messages, activations, notes, and block fragments. - Added `Choreo.Lab.View` pipe-friendly helpers for Livebook zoom, focus, filter, path, and collapse exploration over `Choreo.View`. - Added `Choreo.Lab.Compose` pipe-friendly helpers for Livebook cluster, embed, connect, and trace composition over `Choreo`. diff --git a/lib/choreo/lab/dsl/sequence.ex b/lib/choreo/lab/dsl/sequence.ex new file mode 100644 index 0000000..47ca6c4 --- /dev/null +++ b/lib/choreo/lab/dsl/sequence.ex @@ -0,0 +1,611 @@ +defmodule Choreo.Lab.DSL.Sequence do + @moduledoc """ + Experimental Livebook-friendly DSL for sketching sequence diagrams. + + Unlike most Choreo Lab DSLs, sequence diagrams are primarily ordered event + streams rather than static topology. This DSL still uses participant + constructors for nouns, but message, activation, note, and fragment statements + compile to ordered `Choreo.Sequence` events. + + ## Examples + + iex> import Choreo.Lab.DSL.Sequence + ...> diagram = sequence do + ...> user = actor("User") + ...> api = participant("API") + ...> db = participant("Database") + ...> + ...> user ~> api |> call("GET /accounts") + ...> activate api + ...> api ~> db |> call("SELECT accounts") + ...> reply db ~> api, "rows" + ...> deactivate api + ...> reply api ~> user, "200 OK" + ...> end + iex> Choreo.Sequence.participants(diagram) + [:user, :api, :db] + iex> Choreo.Sequence.messages(diagram) |> Enum.map(& &1[:label]) + ["GET /accounts", "SELECT accounts", "rows", "200 OK"] + + Message edges can use pipe modifiers, typed constructors, or generic `edge`: + + user ~> api |> call("GET /accounts") + async api ~> worker, "enqueue job" + reply db ~> api, "rows" + edge api ~> db, async: "fire and forget" + + Notes and fragments are event statements: + + over api, "Validates bearer token" + between api, db, "Tenant scoped query" + + loop "retry up to 3 times" do + api ~> worker |> async("process job") + end + + alt "authorized" do + api ~> db |> call("read tenant") + otherwise "denied" + api ~> user |> reply("403") + end + """ + + @type participant_decl :: %{id: atom(), builder: atom(), opts: keyword()} + @type step :: + {:participant, participant_decl()} + | {:message, map()} + | {:activation, atom(), atom()} + | {:note, tuple(), String.t()} + | {:fragment, atom(), String.t() | nil} + | :end_fragment + + @participant_verbs [:actor, :participant, :service, :system, :user] + + @participant_builders %{ + actor: :add_actor, + user: :add_actor, + participant: :add_participant, + service: :add_participant, + system: :add_participant + } + + @message_verbs [ + :message, + :call, + :request, + :sync, + :async, + :signal, + :publish, + :reply, + :return, + :response + ] + + @message_types %{ + message: :sync, + call: :sync, + request: :sync, + sync: :sync, + async: :async, + signal: :async, + publish: :async, + reply: :return, + return: :return, + response: :return + } + + @fragment_verbs [:loop, :opt, :alt, :otherwise, :else, :and, :par, :break, :critical] + + @doc """ + Returns the vocabulary supported by the sequence DSL. + + This is meant as a lightweight Livebook discovery helper when autocomplete is + not enough. + + iex> taxonomy = Choreo.Lab.DSL.Sequence.taxonomy() + iex> :actor in taxonomy.participants + true + iex> :reply in taxonomy.messages + true + iex> :loop in taxonomy.fragments + true + """ + @spec taxonomy() :: %{ + participants: [atom()], + messages: [atom()], + events: [atom()], + notes: [atom()], + fragments: [atom()], + modifiers: [atom()], + options: [atom()] + } + def taxonomy do + %{ + participants: @participant_verbs, + messages: [:~>, :edge | @message_verbs], + events: [:activate, :deactivate], + notes: [:note, :over, :left, :right, :between], + fragments: @fragment_verbs, + modifiers: [:on, :label | @message_verbs], + options: [:label, :with, :id, :description, :type, :sync, :async, :reply, :return] + } + end + + @doc """ + Compatibility alias for `taxonomy/0`. + """ + @spec verbs() :: map() + def verbs, do: taxonomy() + + @doc """ + Builds a `%Choreo.Sequence{}` from a compact Lab DSL block. + """ + defmacro sequence(do: block), do: compile(block) + defmacro sequence(opts, do: block), do: compile(block, opts) + + defp compile(block, opts \\ []) do + {steps, _env} = compile_statements(statements(block), %{}) + Enum.reduce(steps, quote(do: Choreo.Sequence.new(unquote(Macro.escape(opts)))), &pipe_step/2) + end + + defp compile_statements(statements, env) do + Enum.reduce(statements, {[], env}, fn statement, {steps, env} -> + {statement_steps, env} = statement_steps(statement, env) + {steps ++ statement_steps, env} + end) + end + + defp statements({:__block__, _meta, list}), do: list + defp statements(nil), do: [] + defp statements(single), do: [single] + + defp statement_steps({:=, meta, [{var, _, context}, constructor]}, env) + when is_atom(var) and is_atom(context) do + participant = participant_from_constructor(constructor, var, meta) + {[{:participant, participant}], Map.put(env, var, participant.id)} + end + + defp statement_steps({:edge, meta, [edge_ast, label]}, env) when is_binary(label) do + {message, participants} = message_from_ast(edge_ast, [label: label], env, meta) + {message_declaration_steps(participants, message), env} + end + + defp statement_steps({:edge, meta, [edge_ast, opts]}, env) when is_list(opts) do + {message, participants} = message_from_ast(edge_ast, normalize_message_opts(opts), env, meta) + {message_declaration_steps(participants, message), env} + end + + defp statement_steps({:edge, meta, [edge_ast]}, env) do + {message, participants} = message_from_ast(edge_ast, [], env, meta) + {message_declaration_steps(participants, message), env} + end + + for message_name <- @message_verbs do + defp statement_steps({unquote(message_name), meta, [edge_ast, label, opts]}, env) + when is_binary(label) and is_list(opts) do + typed_message_statement(unquote(message_name), edge_ast, [label: label] ++ opts, env, meta) + end + + defp statement_steps({unquote(message_name), meta, [edge_ast, label]}, env) + when is_binary(label) do + typed_message_statement(unquote(message_name), edge_ast, [label: label], env, meta) + end + + defp statement_steps({unquote(message_name), meta, [edge_ast, opts]}, env) + when is_list(opts) do + typed_message_statement(unquote(message_name), edge_ast, opts, env, meta) + end + + defp statement_steps({unquote(message_name), meta, [edge_ast]}, env) do + typed_message_statement(unquote(message_name), edge_ast, [], env, meta) + end + end + + defp statement_steps({:|>, _meta, _args} = ast, env) do + {message, participants} = message_from_piped_ast(ast, env) + {message_declaration_steps(participants, message), env} + end + + defp statement_steps({:~>, meta, _args} = ast, env) do + {message, participants} = message_from_ast(ast, [], env, meta) + {message_declaration_steps(participants, message), env} + end + + defp statement_steps({:activate, meta, [participant_ast]}, env) do + {id, participant} = endpoint_id(participant_ast, env, meta) + {participant |> participant_steps() |> append_step({:activation, :activate, id}), env} + end + + defp statement_steps({:deactivate, meta, [participant_ast]}, env) do + {id, participant} = endpoint_id(participant_ast, env, meta) + {participant |> participant_steps() |> append_step({:activation, :deactivate, id}), env} + end + + defp statement_steps({name, meta, args}, env) when name in [:over, :left, :right] do + note_statement(name, args, env, meta) + end + + defp statement_steps({:between, meta, args}, env), do: between_note_statement(args, env, meta) + defp statement_steps({:note, meta, args}, env), do: explicit_note_statement(args, env, meta) + + defp statement_steps({name, meta, args}, env) + when name in [:loop, :opt, :alt, :par, :break, :critical] do + fragment_block_statement(name, args, env, meta) + end + + defp statement_steps({name, meta, args}, env) when name in [:otherwise, :else, :and] do + fragment_arm_statement(name, args, env, meta) + end + + defp statement_steps({name, meta, args} = ast, env) when is_atom(name) and is_list(args) do + if participant_constructor?(ast) do + participant = participant_from_constructor(ast, nil, meta) + {[{:participant, participant}], env} + else + unsupported_statement!(ast, meta) + end + end + + defp statement_steps(other, _env), do: unsupported_statement!(other, nil) + + defp typed_message_statement(name, edge_ast, opts, env, meta) do + opts = opts |> normalize_message_opts() |> Keyword.put(:type, message_type!(name)) + {message, participants} = message_from_ast(edge_ast, opts, env, meta) + {message_declaration_steps(participants, message), env} + end + + defp message_declaration_steps(participants, message) do + participants + |> Enum.reduce([{:message, message}], fn participant, steps -> + [{:participant, participant} | steps] + end) + |> Enum.reverse() + end + + defp participant_steps(nil), do: [] + defp participant_steps(participant), do: [{:participant, participant}] + + defp append_step(steps, step), + do: steps |> Enum.reverse() |> then(&[step | &1]) |> Enum.reverse() + + defp message_from_piped_ast(ast, env) do + {base, modifiers} = unwrap_pipe(ast, []) + opts = modifiers |> Enum.reduce([], &modifier_opt/2) |> normalize_message_opts() + message_from_ast(base, opts, env, line_meta(base)) + end + + defp unwrap_pipe({:|>, _meta, [left, right]}, acc), do: unwrap_pipe(left, [right | acc]) + defp unwrap_pipe(base, acc), do: {base, acc} + + defp modifier_opt({name, _meta, [value]}, acc) when name in [:on, :label] do + Keyword.put(acc, :label, value) + end + + defp modifier_opt({name, _meta, []}, acc) when name in @message_verbs do + Keyword.put(acc, :type, message_type!(name)) + end + + defp modifier_opt({name, _meta, [label]}, acc) + when name in @message_verbs and is_binary(label) do + acc + |> Keyword.put(:type, message_type!(name)) + |> Keyword.put(:label, label) + end + + defp modifier_opt(other, _acc) do + raise ArgumentError, + "unsupported sequence message modifier: #{Macro.to_string(other)}; " <> + "use `on(value)`, `call(value)`, `async(value)`, or `reply(value)`" + end + + defp message_from_ast({:~>, meta, [from_ast, to_ast]}, opts, env, _statement_meta) do + {from, from_participant} = endpoint_id(from_ast, env, meta) + {to, to_participant} = endpoint_id(to_ast, env, meta) + + participants = + [from_participant, to_participant] |> Enum.reject(&is_nil/1) |> Enum.uniq_by(& &1.id) + + opts = opts |> normalize_message_opts() |> Keyword.put_new(:type, :sync) + + {%{from: from, to: to, opts: opts}, participants} + end + + defp message_from_ast(other, _opts, _env, meta) do + raise ArgumentError, + "expected `from ~> to` in sequence DSL, got #{Macro.to_string(other)}" <> + line_suffix(meta) + end + + defp endpoint_id({var, _meta, context}, env, meta) when is_atom(var) and is_atom(context) do + case Map.fetch(env, var) do + {:ok, id} -> + {id, nil} + + :error -> + raise ArgumentError, "unknown sequence participant variable `#{var}`#{line_suffix(meta)}" + end + end + + defp endpoint_id({name, meta, args} = constructor, _env, _statement_meta) + when is_atom(name) and is_list(args) do + if participant_constructor?(constructor) do + participant = participant_from_constructor(constructor, nil, meta) + {participant.id, participant} + else + raise ArgumentError, + "unknown sequence participant constructor `#{name}`#{line_suffix(meta)}" + end + end + + defp endpoint_id(other, _env, meta) do + raise ArgumentError, + "unsupported sequence endpoint #{Macro.to_string(other)}#{line_suffix(meta)}; " <> + "bind a participant first, e.g. `api = participant(\"API\")`" + end + + defp participant_from_constructor({name, meta, args}, var, _statement_meta) + when is_atom(name) and is_list(args) do + builder = + Map.get(@participant_builders, name) || + raise ArgumentError, + "unknown sequence participant constructor `#{name}`#{line_suffix(meta)}" + + {opts, positional} = pop_trailing_opts(args) + {id, opts} = participant_id_and_opts(var, positional, opts, meta) + %{id: id, builder: builder, opts: opts} + end + + defp participant_constructor?({name, _meta, args}) when is_atom(name) and is_list(args), + do: Map.has_key?(@participant_builders, name) + + defp note_statement(position, [participant_ast, text], env, meta) when is_binary(text) do + {id, participant} = endpoint_id(participant_ast, env, meta) + {participant |> participant_steps() |> append_step({:note, {position, id}, text}), env} + end + + defp note_statement(position, args, _env, meta) do + raise ArgumentError, + "#{position}/2 notes require a participant and text, got #{inspect(args)}#{line_suffix(meta)}" + end + + defp between_note_statement([left_ast, right_ast, text], env, meta) when is_binary(text) do + {left, left_participant} = endpoint_id(left_ast, env, meta) + {right, right_participant} = endpoint_id(right_ast, env, meta) + + steps = + [left_participant, right_participant] + |> Enum.reject(&is_nil/1) + |> Enum.uniq_by(& &1.id) + |> Enum.map(&{:participant, &1}) + + {append_step(steps, {:note, {:between, left, right}, text}), env} + end + + defp between_note_statement(args, _env, meta) do + raise ArgumentError, + "between/3 notes require two participants and text, got #{inspect(args)}#{line_suffix(meta)}" + end + + defp explicit_note_statement([{:over, _, [participant_ast]}, text], env, meta) + when is_binary(text) do + note_statement(:over, [participant_ast, text], env, meta) + end + + defp explicit_note_statement([{:left, _, [participant_ast]}, text], env, meta) + when is_binary(text) do + note_statement(:left, [participant_ast, text], env, meta) + end + + defp explicit_note_statement([{:right, _, [participant_ast]}, text], env, meta) + when is_binary(text) do + note_statement(:right, [participant_ast, text], env, meta) + end + + defp explicit_note_statement([{:between, _, [left_ast, right_ast]}, text], env, meta) + when is_binary(text) do + between_note_statement([left_ast, right_ast, text], env, meta) + end + + defp explicit_note_statement(args, _env, meta) do + raise ArgumentError, + "note/2 expects `over(participant)`, `left(participant)`, `right(participant)`, or `between(a, b)`#{line_suffix(meta)}; got #{inspect(args)}" + end + + defp fragment_block_statement(kind, args, env, meta) do + {block, args} = pop_do_block(args) + label = fragment_label(args, meta) + + if is_nil(block) do + raise ArgumentError, "#{kind}/2 fragment requires a do-block#{line_suffix(meta)}" + end + + {nested_steps, _nested_env} = compile_statements(statements(block), env) + + steps = + nested_steps + |> List.insert_at(0, {:fragment, kind, label}) + |> append_step(:end_fragment) + + {steps, env} + end + + defp fragment_arm_statement(kind, args, env, meta) do + label = fragment_label(args, meta) + fragment_kind = if kind == :otherwise, do: :else, else: kind + {[{:fragment, fragment_kind, label}], env} + end + + defp fragment_label([], _meta), do: nil + defp fragment_label([label], _meta) when is_binary(label), do: label + + defp fragment_label(args, meta) do + raise ArgumentError, + "fragment label must be a string, got #{inspect(args)}#{line_suffix(meta)}" + end + + defp pop_do_block(args) do + case List.last(args) do + [do: block] -> {block, Enum.drop(args, -1)} + _other -> {nil, args} + end + end + + defp pop_trailing_opts(args) do + case List.last(args) do + last when is_list(last) -> + if Keyword.keyword?(last), do: {last, Enum.drop(args, -1)}, else: {[], args} + + _other -> + {[], args} + end + end + + defp participant_id_and_opts(var, positional, opts, meta) do + {explicit_id, opts} = Keyword.pop(opts, :id) + + cond do + length(positional) > 1 -> + raise ArgumentError, + "participant constructors take at most one positional label/id#{line_suffix(meta)}" + + explicit_id != nil -> + {explicit_id, maybe_put_label(opts, List.first(positional))} + + var != nil -> + {var, maybe_put_label(opts, List.first(positional))} + + positional != [] -> + label_or_id = List.first(positional) + {id_from_label(label_or_id), maybe_put_label(opts, label_or_id)} + + true -> + raise ArgumentError, + "inline sequence participant constructors need a label/id or `id:` option#{line_suffix(meta)}" + end + end + + defp maybe_put_label(opts, nil), do: opts + + defp maybe_put_label(opts, label) when is_binary(label), + do: Keyword.put_new(opts, :label, label) + + defp maybe_put_label(opts, label) when is_atom(label), + do: Keyword.put_new(opts, :label, to_string(label)) + + defp maybe_put_label(opts, _other), do: opts + + defp id_from_label(id) when is_atom(id), do: id + defp id_from_label(id) when is_binary(id), do: slug_atom(id) + + defp id_from_label(other) do + raise ArgumentError, + "inline sequence participant label/id must be a string or atom, got #{inspect(other)}" + end + + defp slug_atom(label) do + label + |> String.downcase() + |> String.replace(~r/[^a-z0-9]+/u, "_") + |> String.trim("_") + |> case do + "" -> raise ArgumentError, "cannot derive a sequence participant id from an empty label" + slug -> String.to_atom(slug) + end + end + + defp normalize_message_opts(opts) do + opts + |> normalize_label_alias(:with) + |> normalize_message_aliases() + end + + defp normalize_label_alias(opts, key) do + {value, opts} = Keyword.pop(opts, key) + if value == nil, do: opts, else: Keyword.put_new(opts, :label, value) + end + + defp normalize_message_aliases(opts) do + Enum.reduce(@message_verbs, opts, fn key, acc -> + {value, acc} = Keyword.pop(acc, key) + + if value == nil do + acc + else + acc + |> Keyword.put_new(:type, message_type!(key)) + |> Keyword.put_new(:label, value) + end + end) + end + + defp message_type!(name), do: Map.fetch!(@message_types, name) + + defp pipe_step({:participant, %{id: id, builder: builder, opts: opts}}, acc) do + quote do + apply(Choreo.Sequence, unquote(builder), [ + unquote(acc), + unquote(Macro.escape(id)), + unquote(Macro.escape(opts)) + ]) + end + end + + defp pipe_step({:message, %{from: from, to: to, opts: opts}}, acc) do + quote do + Choreo.Sequence.message( + unquote(acc), + unquote(Macro.escape(from)), + unquote(Macro.escape(to)), + unquote(Macro.escape(opts)) + ) + end + end + + defp pipe_step({:activation, :activate, participant}, acc) do + quote do + Choreo.Sequence.activate(unquote(acc), unquote(Macro.escape(participant))) + end + end + + defp pipe_step({:activation, :deactivate, participant}, acc) do + quote do + Choreo.Sequence.deactivate(unquote(acc), unquote(Macro.escape(participant))) + end + end + + defp pipe_step({:note, position, text}, acc) do + quote do + Choreo.Sequence.note(unquote(acc), unquote(Macro.escape(position)), unquote(text)) + end + end + + defp pipe_step({:fragment, kind, label}, acc) do + quote do + Choreo.Sequence.fragment(unquote(acc), unquote(kind), unquote(label)) + end + end + + defp pipe_step(:end_fragment, acc) do + quote do + Choreo.Sequence.end_fragment(unquote(acc)) + end + end + + defp unsupported_statement!(ast, meta) do + raise ArgumentError, + "unsupported statement in sequence DSL: #{Macro.to_string(ast)}#{line_suffix(meta)}" + end + + defp line_meta({_name, meta, _args}) when is_list(meta), do: meta + defp line_meta(_other), do: [] + + defp line_suffix(meta) when is_list(meta) do + case Keyword.get(meta, :line) do + nil -> "" + line -> " (line #{line})" + end + end + + defp line_suffix(_meta), do: "" +end diff --git a/test/choreo/lab/dsl/sequence_test.exs b/test/choreo/lab/dsl/sequence_test.exs new file mode 100644 index 0000000..5e2abf7 --- /dev/null +++ b/test/choreo/lab/dsl/sequence_test.exs @@ -0,0 +1,169 @@ +defmodule Choreo.Lab.SequenceDSLTest do + use ExUnit.Case, async: true + + import Choreo.Lab.DSL.Sequence + + doctest Choreo.Lab.DSL.Sequence + + test "taxonomy returns the Livebook discovery vocabulary" do + taxonomy = Choreo.Lab.DSL.Sequence.taxonomy() + + assert :actor in taxonomy.participants + assert :participant in taxonomy.participants + assert :reply in taxonomy.messages + assert :activate in taxonomy.events + assert :between in taxonomy.notes + assert :loop in taxonomy.fragments + assert :call in taxonomy.modifiers + assert Choreo.Lab.DSL.Sequence.verbs() == taxonomy + end + + test "builds ordered participant, message, and activation events" do + diagram = + sequence do + user = actor("User") + api = participant("API") + db = participant("Database") + + user ~> api |> call("GET /accounts") + activate api + api ~> db |> call("SELECT accounts") + reply db ~> api, "rows" + deactivate api + reply api ~> user, "200 OK" + end + + assert Choreo.Sequence.participants(diagram) == [:user, :api, :db] + assert diagram.graph.nodes[:user].node_type == :actor + assert diagram.graph.nodes[:api].node_type == :participant + + messages = Choreo.Sequence.messages(diagram) + + assert Enum.map(messages, & &1[:label]) == [ + "GET /accounts", + "SELECT accounts", + "rows", + "200 OK" + ] + + assert Enum.map(messages, & &1[:type]) == [:sync, :sync, :return, :return] + + activations = Enum.filter(Choreo.Sequence.events(diagram), &(&1.type == :activation)) + assert Enum.map(activations, & &1.action) == [:activate, :deactivate] + end + + test "supports inline participant constructors" do + diagram = + sequence do + actor("User") ~> participant("API") |> request("GET /health") + end + + assert Choreo.Sequence.participants(diagram) == [:user, :api] + assert [message] = Choreo.Sequence.messages(diagram) + assert message.from == :user + assert message.to == :api + assert message.label == "GET /health" + end + + test "supports id option while keeping display label" do + diagram = + sequence do + client = actor("Mobile App", id: :app) + api = service("API") + + async client ~> api, "prefetch" + end + + assert diagram.graph.nodes[:app].label == "Mobile App" + assert [message] = Choreo.Sequence.messages(diagram) + assert message.from == :app + assert message.type == :async + assert message.label == "prefetch" + end + + test "supports typed keyword edges and self messages" do + diagram = + sequence do + api = participant("API") + worker = participant("Worker") + + edge api ~> worker, async: "enqueue" + edge worker ~> api, return: "accepted" + api ~> api |> call("validate token") + end + + messages = Choreo.Sequence.messages(diagram) + assert Enum.map(messages, & &1.type) == [:async, :return, :self] + assert Enum.map(messages, & &1.label) == ["enqueue", "accepted", "validate token"] + end + + test "supports notes" do + diagram = + sequence do + user = actor("User") + api = participant("API") + + over api, "Validates bearer token" + left user, "External caller" + between user, api, "HTTPS boundary" + note over(api), "Rate limited" + end + + notes = Choreo.Sequence.events(diagram) |> Enum.filter(&(&1.type == :note)) + + assert Enum.map(notes, & &1.position) == [ + {:over, :api}, + {:left, :user}, + {:between, :user, :api}, + {:over, :api} + ] + + assert Enum.map(notes, & &1.text) == [ + "Validates bearer token", + "External caller", + "HTTPS boundary", + "Rate limited" + ] + end + + test "supports fragment blocks" do + diagram = + sequence do + api = participant("API") + worker = participant("Worker") + user = actor("User") + + loop "retry up to 3 times" do + api ~> worker |> async("process job") + end + + alt "authorized" do + api ~> user |> reply("200") + otherwise "denied" + api ~> user |> reply("403") + end + end + + fragments = Choreo.Sequence.events(diagram) |> Enum.filter(&(&1.type == :fragment)) + assert Enum.map(fragments, & &1.kind) == [:loop, nil, :alt, :else, nil] + assert Enum.map(fragments, & &1.action) == [:start, :end, :start, :arm, :end] + + messages = Choreo.Sequence.messages(diagram) + assert Enum.map(messages, & &1.label) == ["process job", "200", "403"] + end + + test "raises on unknown participant variables" do + assert_raise ArgumentError, ~r/unknown sequence participant variable `api`/, fn -> + Code.eval_quoted( + quote do + import Choreo.Lab.DSL.Sequence + + sequence do + user = actor("User") + user ~> api |> call("GET") + end + end + ) + end + end +end From ecf70b20b95ed8d070472a5d39db01caa64aee80 Mon Sep 17 00:00:00 2001 From: Mafinar Khan Date: Sun, 19 Jul 2026 19:35:30 -0400 Subject: [PATCH 10/13] Add Lab C4 DSL --- .formatter.exs | 34 +- CHANGELOG.md | 1 + lib/choreo/lab/dsl/c4.ex | 595 ++++++++++++++++++++++++++++++++ test/choreo/lab/dsl/c4_test.exs | 154 +++++++++ 4 files changed, 783 insertions(+), 1 deletion(-) create mode 100644 lib/choreo/lab/dsl/c4.ex create mode 100644 test/choreo/lab/dsl/c4_test.exs diff --git a/.formatter.exs b/.formatter.exs index 33c1f72..3cd8931 100644 --- a/.formatter.exs +++ b/.formatter.exs @@ -183,6 +183,38 @@ note: 2, otherwise: 1, else: 1, - and: 1 + and: 1, + person: 1, + person: 2, + software_system: 1, + software_system: 2, + external_system: 1, + external_system: 2, + container: 1, + container: 2, + application: 1, + application: 2, + app: 1, + app: 2, + database: 1, + database: 2, + datastore: 1, + datastore: 2, + component: 1, + component: 2, + module: 1, + module: 2, + boundary: 1, + boundary: 2, + group: 1, + group: 2, + scope: 1, + in_scope: 1, + relates: 1, + relates: 2, + relates: 3, + calls: 1, + calls: 2, + calls: 3 ] ] diff --git a/CHANGELOG.md b/CHANGELOG.md index b5854f1..6597fcf 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,6 +11,7 @@ - Added incubating `Choreo.Lab.DSL.UML` syntax for Livebook-friendly class/struct sketches over the stable `Choreo.UML` builders, including block-based fields/functions and typed relationship edges. - Added incubating `Choreo.Lab.DSL.Dataflow` syntax for Livebook-friendly pipeline sketches over the stable `Choreo.Dataflow` builders, including stage clusters and typed normal/error/retry/dead-letter paths. - Added incubating `Choreo.Lab.DSL.Sequence` syntax for Livebook-friendly sequence sketches over the stable `Choreo.Sequence` builders, including ordered messages, activations, notes, and block fragments. +- Added incubating `Choreo.Lab.DSL.C4` syntax for Livebook-friendly C4 sketches over the stable `Choreo.C4` builders, including hierarchy-aware constructors, scope statements, clusters, and relationship verbs. - Added `Choreo.Lab.View` pipe-friendly helpers for Livebook zoom, focus, filter, path, and collapse exploration over `Choreo.View`. - Added `Choreo.Lab.Compose` pipe-friendly helpers for Livebook cluster, embed, connect, and trace composition over `Choreo`. diff --git a/lib/choreo/lab/dsl/c4.ex b/lib/choreo/lab/dsl/c4.ex new file mode 100644 index 0000000..dd2103d --- /dev/null +++ b/lib/choreo/lab/dsl/c4.ex @@ -0,0 +1,595 @@ +defmodule Choreo.Lab.DSL.C4 do + @moduledoc """ + Experimental Livebook-friendly DSL for sketching C4 models. + + This Lab DSL compiles to the stable, pipe-first `Choreo.C4` builders and + returns an ordinary `%Choreo.C4{}`. It keeps C4 nouns explicit — people, + software systems, containers, and components — while relationship verbs make + quick architecture sketches read naturally in Livebook. + + ## Examples + + iex> import Choreo.Lab.DSL.C4 + ...> model = c4 do + ...> customer = person("Customer", description: "API consumer") + ...> gateway = system("API Gateway", scope: :in, description: "Routes tenant API traffic") + ...> api = container("Gateway API", parent: gateway, technology: "Phoenix") + ...> db = container("Tenant DB", parent: gateway, technology: "Postgres") + ...> + ...> customer ~> api |> uses("Submits API requests", technology: "HTTPS") + ...> api ~> db |> reads("Tenant config", technology: "SQL") + ...> scope gateway + ...> end + iex> Choreo.C4.scope(model) + :gateway + iex> model.graph.nodes[:api].parent + :gateway + iex> [{_, _, _, meta} | _] = Choreo.C4.edges_with_meta(model) + iex> meta.label + "Submits API requests" + + Relationship edges can use generic labels, typed verbs, or explicit `edge`: + + user ~> system |> uses("Uses") + api ~> db |> reads("Reads tenant config", technology: "SQL") + edge api ~> worker, calls: "Dispatches job" + sends api ~> queue, "Publishes event", technology: "Kafka" + + Parent and scope options can use variables bound earlier in the block: + + app = system("Application", scope: :in) + api = container("API", parent: app) + auth = component("Auth Controller", parent: api) + scope app + """ + + @type cluster_decl :: %{id: String.t(), opts: keyword()} + @type node_decl :: %{id: Yog.node_id(), builder: atom(), opts: keyword()} + @type edge_decl :: %{from: Yog.node_id(), to: Yog.node_id(), opts: keyword()} + + @cluster_verbs [:cluster, :boundary, :group] + + @node_verbs [ + :person, + :user, + :actor, + :software_system, + :system, + :external_system, + :container, + :application, + :app, + :service, + :database, + :datastore, + :component, + :module + ] + + @node_builders %{ + person: :add_person, + user: :add_person, + actor: :add_person, + software_system: :add_software_system, + system: :add_software_system, + external_system: :add_software_system, + container: :add_container, + application: :add_container, + app: :add_container, + service: :add_container, + database: :add_container, + datastore: :add_container, + component: :add_component, + module: :add_component + } + + @edge_verbs [ + :relates, + :uses, + :calls, + :sends, + :publishes, + :consumes, + :reads, + :writes, + :routes, + :depends + ] + + @doc """ + Returns the vocabulary supported by the C4 DSL. + + This is meant as a lightweight Livebook discovery helper when autocomplete is + not enough. + + iex> taxonomy = Choreo.Lab.DSL.C4.taxonomy() + iex> :person in taxonomy.nodes + true + iex> :container in taxonomy.nodes + true + iex> :uses in taxonomy.edges + true + """ + @spec taxonomy() :: %{ + clusters: [atom()], + nodes: [atom()], + edges: [atom()], + events: [atom()], + modifiers: [atom()], + options: [atom()] + } + def taxonomy do + %{ + clusters: @cluster_verbs, + nodes: @node_verbs, + edges: [:~>, :edge | @edge_verbs], + events: [:scope, :in_scope], + modifiers: [:on, :label, :technology | @edge_verbs], + options: [:label, :with, :id, :description, :technology, :parent, :scope | @edge_verbs] + } + end + + @doc """ + Compatibility alias for `taxonomy/0`. + """ + @spec verbs() :: map() + def verbs, do: taxonomy() + + @doc """ + Builds a `%Choreo.C4{}` from a compact Lab DSL block. + """ + defmacro c4(do: block), do: compile(block) + defmacro c4(opts, do: block), do: compile(block, opts) + + defp compile(block, opts \\ []) do + {steps, _env} = + block + |> statements() + |> Enum.reduce({[], empty_env()}, fn statement, {steps, env} -> + {statement_steps, env} = statement_steps(statement, env) + {steps ++ statement_steps, env} + end) + + Enum.reduce(steps, quote(do: Choreo.C4.new(unquote(Macro.escape(opts)))), &pipe_step/2) + end + + defp statements({:__block__, _meta, list}), do: list + defp statements(nil), do: [] + defp statements(single), do: [single] + + defp empty_env, do: %{nodes: %{}, clusters: %{}} + + defp statement_steps({:=, meta, [{var, _, context}, constructor]}, env) + when is_atom(var) and is_atom(context) do + cond do + cluster_constructor?(constructor) -> + cluster = cluster_from_constructor(constructor, var, env, meta) + {[{:cluster, cluster}], put_in(env.clusters[var], cluster.id)} + + node_constructor?(constructor) -> + node = node_from_constructor(constructor, var, env, meta) + {[{:node, node}], put_in(env.nodes[var], node.id)} + + true -> + raise ArgumentError, + "expected C4 constructor, got #{Macro.to_string(constructor)}#{line_suffix(meta)}" + end + end + + defp statement_steps({:scope, meta, [node_ast]}, env), do: scope_statement(node_ast, env, meta) + + defp statement_steps({:in_scope, meta, [node_ast]}, env), + do: scope_statement(node_ast, env, meta) + + defp statement_steps({:edge, meta, [edge_ast, label]}, env) when is_binary(label) do + {edge, nodes} = edge_from_ast(edge_ast, [label: label], env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({:edge, meta, [edge_ast, opts]}, env) when is_list(opts) do + {edge, nodes} = edge_from_ast(edge_ast, normalize_edge_opts(opts), env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({:edge, meta, [edge_ast]}, env) do + {edge, nodes} = edge_from_ast(edge_ast, [], env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + for edge_name <- @edge_verbs do + defp statement_steps({unquote(edge_name), meta, [edge_ast, label, opts]}, env) + when is_binary(label) and is_list(opts) do + typed_edge_statement(unquote(edge_name), edge_ast, [label: label] ++ opts, env, meta) + end + + defp statement_steps({unquote(edge_name), meta, [edge_ast, label]}, env) + when is_binary(label) do + typed_edge_statement(unquote(edge_name), edge_ast, [label: label], env, meta) + end + + defp statement_steps({unquote(edge_name), meta, [edge_ast, opts]}, env) when is_list(opts) do + typed_edge_statement(unquote(edge_name), edge_ast, opts, env, meta) + end + + defp statement_steps({unquote(edge_name), meta, [edge_ast]}, env) do + typed_edge_statement(unquote(edge_name), edge_ast, [], env, meta) + end + end + + defp statement_steps({:|>, _meta, _args} = ast, env) do + {edge, nodes} = edge_from_piped_ast(ast, env) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({:~>, meta, _args} = ast, env) do + {edge, nodes} = edge_from_ast(ast, [], env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({name, meta, args} = ast, env) when is_atom(name) and is_list(args) do + cond do + Map.has_key?(cluster_builders(), name) -> + cluster = cluster_from_constructor(ast, nil, env, meta) + {[{:cluster, cluster}], env} + + Map.has_key?(@node_builders, name) -> + node = node_from_constructor(ast, nil, env, meta) + {[{:node, node}], env} + + true -> + unsupported_statement!(ast, meta) + end + end + + defp statement_steps(other, _env), do: unsupported_statement!(other, nil) + + defp scope_statement(node_ast, env, meta) do + {id, node} = endpoint_id(node_ast, env, meta) + {node |> node_steps() |> append_step({:scope, id}), env} + end + + defp typed_edge_statement(name, edge_ast, opts, env, meta) do + opts = opts |> normalize_edge_opts() |> put_edge_label_for(name, nil) + {edge, nodes} = edge_from_ast(edge_ast, opts, env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + defp edge_declaration_steps(nodes, edge) do + nodes + |> Enum.reduce([{:edge, edge}], fn node, steps -> [{:node, node} | steps] end) + |> Enum.reverse() + end + + defp node_steps(nil), do: [] + defp node_steps(node), do: [{:node, node}] + + defp append_step(steps, step), + do: steps |> Enum.reverse() |> then(&[step | &1]) |> Enum.reverse() + + defp edge_from_piped_ast(ast, env) do + {base, modifiers} = unwrap_pipe(ast, []) + opts = modifiers |> Enum.reduce([], &modifier_opt/2) |> normalize_edge_opts() + edge_from_ast(base, opts, env, line_meta(base)) + end + + defp unwrap_pipe({:|>, _meta, [left, right]}, acc), do: unwrap_pipe(left, [right | acc]) + defp unwrap_pipe(base, acc), do: {base, acc} + + defp modifier_opt({name, _meta, [value]}, acc) when name in [:on, :label] do + Keyword.put(acc, :label, value) + end + + defp modifier_opt({:technology, _meta, [value]}, acc), do: Keyword.put(acc, :technology, value) + + defp modifier_opt({name, _meta, []}, acc) when name in @edge_verbs do + put_edge_label_for(acc, name, nil) + end + + defp modifier_opt({name, _meta, [value]}, acc) when name in @edge_verbs do + put_edge_label_for(acc, name, value) + end + + defp modifier_opt({name, _meta, [value, opts]}, acc) + when name in @edge_verbs and is_list(opts) do + acc + |> Keyword.merge(opts) + |> put_edge_label_for(name, value) + end + + defp modifier_opt(other, _acc) do + raise ArgumentError, + "unsupported C4 relationship modifier: #{Macro.to_string(other)}; " <> + "use `on(value)`, `uses(value)`, `calls(value)`, or `technology(value)`" + end + + defp edge_from_ast({:~>, meta, [from_ast, to_ast]}, opts, env, _statement_meta) do + {from, from_node} = endpoint_id(from_ast, env, meta) + {to, to_node} = endpoint_id(to_ast, env, meta) + nodes = [from_node, to_node] |> Enum.reject(&is_nil/1) |> Enum.uniq_by(& &1.id) + {%{from: from, to: to, opts: normalize_edge_opts(opts)}, nodes} + end + + defp edge_from_ast(other, _opts, _env, meta) do + raise ArgumentError, + "expected `from ~> to` in C4 DSL, got #{Macro.to_string(other)}#{line_suffix(meta)}" + end + + defp endpoint_id({var, _meta, context}, env, meta) when is_atom(var) and is_atom(context) do + case Map.fetch(env.nodes, var) do + {:ok, id} -> {id, nil} + :error -> raise ArgumentError, "unknown C4 node variable `#{var}`#{line_suffix(meta)}" + end + end + + defp endpoint_id({name, meta, args} = constructor, env, _statement_meta) + when is_atom(name) and is_list(args) do + if Map.has_key?(@node_builders, name) do + node = node_from_constructor(constructor, nil, env, meta) + {node.id, node} + else + raise ArgumentError, "unknown C4 node constructor `#{name}`#{line_suffix(meta)}" + end + end + + defp endpoint_id(other, _env, meta) do + raise ArgumentError, + "unsupported C4 relationship endpoint #{Macro.to_string(other)}#{line_suffix(meta)}; " <> + "bind a node first, e.g. `api = container(\"API\")`" + end + + defp node_from_constructor({name, meta, args}, var, env, _statement_meta) + when is_atom(name) and is_list(args) do + builder = + Map.get(@node_builders, name) || + raise ArgumentError, "unknown C4 node constructor `#{name}`#{line_suffix(meta)}" + + {opts, positional} = pop_trailing_opts(args) + opts = resolve_node_references(opts, env, meta) + {id, opts} = node_id_and_opts(var, positional, opts, meta) + %{id: id, builder: builder, opts: opts} + end + + defp cluster_from_constructor({name, meta, args}, var, env, _statement_meta) + when is_atom(name) and is_list(args) do + builder = Map.fetch!(cluster_builders(), name) + {opts, positional} = pop_trailing_opts(args) + opts = resolve_cluster_option(opts, :parent, env, meta) + {id, opts} = cluster_id_and_opts(var, positional, opts, meta) + %{id: id, builder: builder, opts: opts} + end + + defp pop_trailing_opts(args) do + case List.last(args) do + last when is_list(last) -> + if Keyword.keyword?(last), do: {last, Enum.drop(args, -1)}, else: {[], args} + + _other -> + {[], args} + end + end + + defp node_id_and_opts(var, positional, opts, meta) do + {explicit_id, opts} = Keyword.pop(opts, :id) + + cond do + length(positional) > 1 -> + raise ArgumentError, + "node constructors take at most one positional label/id#{line_suffix(meta)}" + + explicit_id != nil -> + {explicit_id, maybe_put_label(opts, List.first(positional))} + + var != nil -> + {var, maybe_put_label(opts, List.first(positional))} + + positional != [] -> + label_or_id = List.first(positional) + {id_from_label(label_or_id), maybe_put_label(opts, label_or_id)} + + true -> + raise ArgumentError, + "inline C4 node constructors need a label/id or `id:` option#{line_suffix(meta)}" + end + end + + defp cluster_id_and_opts(var, positional, opts, meta) do + {explicit_id, opts} = Keyword.pop(opts, :id) + + cond do + length(positional) > 1 -> + raise ArgumentError, + "cluster constructors take at most one positional label/id#{line_suffix(meta)}" + + explicit_id != nil -> + {ensure_cluster_prefix(explicit_id), maybe_put_label(opts, List.first(positional))} + + var != nil -> + {ensure_cluster_prefix(var), maybe_put_label(opts, List.first(positional))} + + positional != [] -> + label_or_id = List.first(positional) + + {label_or_id |> cluster_id_from_label() |> ensure_cluster_prefix(), + maybe_put_label(opts, label_or_id)} + + true -> + raise ArgumentError, + "inline C4 cluster constructors need a label/id or `id:` option#{line_suffix(meta)}" + end + end + + defp maybe_put_label(opts, nil), do: opts + + defp maybe_put_label(opts, label) when is_binary(label), + do: Keyword.put_new(opts, :label, label) + + defp maybe_put_label(opts, label) when is_atom(label), + do: Keyword.put_new(opts, :label, to_string(label)) + + defp maybe_put_label(opts, _other), do: opts + + defp id_from_label(id) when is_atom(id), do: id + defp id_from_label(id) when is_binary(id), do: slug_atom(id) + + defp id_from_label(other), + do: + raise( + ArgumentError, + "inline C4 node label/id must be a string or atom, got #{inspect(other)}" + ) + + defp cluster_id_from_label(id) when is_atom(id), do: to_string(id) + defp cluster_id_from_label(id) when is_binary(id), do: id |> slug_atom() |> to_string() + + defp cluster_id_from_label(other), + do: + raise( + ArgumentError, + "inline C4 cluster label/id must be a string or atom, got #{inspect(other)}" + ) + + defp ensure_cluster_prefix(id) do + id = to_string(id) + if String.starts_with?(id, "cluster_"), do: id, else: "cluster_" <> id + end + + defp slug_atom(label) do + label + |> String.downcase() + |> String.replace(~r/[^a-z0-9]+/u, "_") + |> String.trim("_") + |> case do + "" -> raise ArgumentError, "cannot derive a C4 node id from an empty label" + slug -> String.to_atom(slug) + end + end + + defp resolve_node_references(opts, env, meta) do + resolve_node_option(opts, :parent, env, meta) + end + + defp resolve_node_option(opts, key, env, meta) do + Keyword.update(opts, key, nil, &resolve_node_reference(&1, env, key, meta)) + |> Keyword.reject(fn {_key, value} -> is_nil(value) end) + end + + defp resolve_node_reference({var, _meta, context}, env, key, meta) + when is_atom(var) and is_atom(context) do + case Map.fetch(env.nodes, var) do + {:ok, id} -> + id + + :error -> + raise ArgumentError, "unknown C4 node variable `#{var}` in `#{key}:`#{line_suffix(meta)}" + end + end + + defp resolve_node_reference(value, _env, _key, _meta), do: value + + defp resolve_cluster_option(opts, key, env, meta) do + Keyword.update(opts, key, nil, &resolve_cluster_reference(&1, env, key, meta)) + |> Keyword.reject(fn {_key, value} -> is_nil(value) end) + end + + defp resolve_cluster_reference({var, _meta, context}, env, key, meta) + when is_atom(var) and is_atom(context) do + case Map.fetch(env.clusters, var) do + {:ok, id} -> + id + + :error -> + raise ArgumentError, + "unknown C4 cluster variable `#{var}` in `#{key}:`#{line_suffix(meta)}" + end + end + + defp resolve_cluster_reference(value, _env, _key, _meta), do: value + + defp normalize_edge_opts(opts) do + opts + |> normalize_label_alias(:with) + |> normalize_edge_aliases() + end + + defp normalize_label_alias(opts, key) do + {value, opts} = Keyword.pop(opts, key) + if value == nil, do: opts, else: Keyword.put_new(opts, :label, value) + end + + defp normalize_edge_aliases(opts) do + Enum.reduce(@edge_verbs, opts, fn key, acc -> + {value, acc} = Keyword.pop(acc, key) + if value == nil, do: acc, else: put_edge_label_for(acc, key, value) + end) + end + + defp put_edge_label_for(opts, :relates, nil), do: opts + defp put_edge_label_for(opts, _name, nil), do: opts + defp put_edge_label_for(opts, _name, value), do: Keyword.put_new(opts, :label, value) + + defp cluster_builders, do: %{cluster: :add_cluster, boundary: :add_cluster, group: :add_cluster} + + defp cluster_constructor?({name, _meta, args}) when is_atom(name) and is_list(args), + do: Map.has_key?(cluster_builders(), name) + + defp cluster_constructor?(_other), do: false + + defp node_constructor?({name, _meta, args}) when is_atom(name) and is_list(args), + do: Map.has_key?(@node_builders, name) + + defp node_constructor?(_other), do: false + + defp pipe_step({:cluster, %{id: id, builder: builder, opts: opts}}, acc) do + quote do + apply(Choreo.C4, unquote(builder), [ + unquote(acc), + unquote(Macro.escape(id)), + unquote(Macro.escape(opts)) + ]) + end + end + + defp pipe_step({:node, %{id: id, builder: builder, opts: opts}}, acc) do + quote do + apply(Choreo.C4, unquote(builder), [ + unquote(acc), + unquote(Macro.escape(id)), + unquote(Macro.escape(opts)) + ]) + end + end + + defp pipe_step({:edge, %{from: from, to: to, opts: opts}}, acc) do + quote do + Choreo.C4.add_relationship( + unquote(acc), + unquote(Macro.escape(from)), + unquote(Macro.escape(to)), + unquote(Macro.escape(opts)) + ) + end + end + + defp pipe_step({:scope, id}, acc) do + quote do + Choreo.C4.set_scope(unquote(acc), unquote(Macro.escape(id))) + end + end + + defp unsupported_statement!(ast, meta) do + raise ArgumentError, + "unsupported statement in C4 DSL: #{Macro.to_string(ast)}#{line_suffix(meta)}" + end + + defp line_meta({_name, meta, _args}) when is_list(meta), do: meta + defp line_meta(_other), do: [] + + defp line_suffix(meta) when is_list(meta) do + case Keyword.get(meta, :line) do + nil -> "" + line -> " (line #{line})" + end + end + + defp line_suffix(_meta), do: "" +end diff --git a/test/choreo/lab/dsl/c4_test.exs b/test/choreo/lab/dsl/c4_test.exs new file mode 100644 index 0000000..cec73dd --- /dev/null +++ b/test/choreo/lab/dsl/c4_test.exs @@ -0,0 +1,154 @@ +defmodule Choreo.Lab.C4DSLTest do + use ExUnit.Case, async: true + + import Choreo.Lab.DSL.C4 + + doctest Choreo.Lab.DSL.C4 + + test "taxonomy returns the Livebook discovery vocabulary" do + taxonomy = Choreo.Lab.DSL.C4.taxonomy() + + assert :person in taxonomy.nodes + assert :system in taxonomy.nodes + assert :container in taxonomy.nodes + assert :component in taxonomy.nodes + assert :uses in taxonomy.edges + assert :calls in taxonomy.edges + assert :scope in taxonomy.events + assert :technology in taxonomy.modifiers + assert Choreo.Lab.DSL.C4.verbs() == taxonomy + end + + test "builds a C4 model with variable-bound hierarchy and relationships" do + model = + c4 do + customer = person("Customer", description: "API consumer") + gateway = system("API Gateway", scope: :in, description: "Routes tenant API traffic") + api = container("Gateway API", parent: gateway, technology: "Phoenix") + db = database("Tenant DB", parent: gateway, technology: "Postgres") + auth = component("Auth Controller", parent: api, technology: "Phoenix") + + customer ~> api |> uses("Submits API requests", technology: "HTTPS") + api ~> auth |> calls("Delegates authentication") + auth ~> db |> reads("Tenant config", technology: "SQL") + scope gateway + end + + assert Choreo.C4.scope(model) == :gateway + assert model.graph.nodes[:customer].node_type == :person + assert model.graph.nodes[:gateway].node_type == :software_system + assert model.graph.nodes[:gateway].scope == :in + assert model.graph.nodes[:api].node_type == :container + assert model.graph.nodes[:api].parent == :gateway + assert model.graph.nodes[:db].node_type == :container + assert model.graph.nodes[:auth].node_type == :component + assert model.graph.nodes[:auth].parent == :api + + edges = Choreo.C4.edges_with_meta(model) + + assert Enum.map(edges, fn {from, to, _w, meta} -> + {from, to, meta.label, meta[:technology]} + end) == [ + {:customer, :api, "Submits API requests", "HTTPS"}, + {:api, :auth, "Delegates authentication", nil}, + {:auth, :db, "Tenant config", "SQL"} + ] + end + + test "supports inline constructors for one-off sketches" do + model = + c4 do + person("Customer") ~> system("Banking") |> uses("Uses") + end + + assert model.graph.nodes[:customer].node_type == :person + assert model.graph.nodes[:banking].node_type == :software_system + assert [{:customer, :banking, 1}] = Choreo.C4.edges(model) + end + + test "supports id option while keeping display label" do + model = + c4 do + app = system("Internet Banking", id: :banking) + api = container("API", parent: app) + + edge app ~> api, "Contains runnable API" + in_scope app + end + + assert model.graph.nodes[:banking].label == "Internet Banking" + assert model.graph.nodes[:api].parent == :banking + assert Choreo.C4.scope(model) == :banking + assert [{:banking, :api, _weight, meta}] = Choreo.C4.edges_with_meta(model) + assert meta.label == "Contains runnable API" + end + + test "supports clusters and parent-derived grouping" do + model = + c4 do + platform = boundary("Platform") + internal = boundary("Internal Systems", parent: platform) + gateway = system("API Gateway") + api = container("API", parent: gateway) + worker = container("Worker", parent: gateway) + + api ~> worker |> sends("Jobs", technology: "Kafka") + end + + assert model.clusters["cluster_platform"].label == "Platform" + assert model.clusters["cluster_internal"].parent == "cluster_platform" + assert model.graph.nodes[:api].cluster == "cluster_gateway" + assert model.graph.nodes[:worker].cluster == "cluster_gateway" + assert [{:api, :worker, _weight, meta}] = Choreo.C4.edges_with_meta(model) + assert meta.label == "Jobs" + assert meta.technology == "Kafka" + end + + test "supports typed keyword edges" do + model = + c4 do + api = service("API", technology: "Phoenix") + db = datastore("Database", technology: "Postgres") + queue = container("Events", technology: "Kafka") + + edge api ~> db, reads: "Tenant config" + edge api ~> queue, publishes: "Audit event" + end + + labels = + model + |> Choreo.C4.edges_with_meta() + |> Enum.map(fn {_from, _to, _w, meta} -> meta.label end) + + assert labels == ["Tenant config", "Audit event"] + end + + test "raises on unknown parent variables" do + assert_raise ArgumentError, ~r/unknown C4 node variable `gateawy` in `parent:`/, fn -> + Code.eval_quoted( + quote do + import Choreo.Lab.DSL.C4 + + c4 do + container("API", parent: gateawy) + end + end + ) + end + end + + test "raises on unknown relationship variables" do + assert_raise ArgumentError, ~r/unknown C4 node variable `api`/, fn -> + Code.eval_quoted( + quote do + import Choreo.Lab.DSL.C4 + + c4 do + user = person("User") + user ~> api |> uses("Uses") + end + end + ) + end + end +end From c0a56fe335fdccf4645e549040741f309fdb56ba Mon Sep 17 00:00:00 2001 From: Mafinar Khan Date: Sun, 19 Jul 2026 19:52:10 -0400 Subject: [PATCH 11/13] Add Lab DecisionTree DSL --- .formatter.exs | 14 +- CHANGELOG.md | 1 + lib/choreo/lab/dsl/decision_tree.ex | 356 +++++++++++++++++++++ test/choreo/lab/dsl/decision_tree_test.exs | 121 +++++++ 4 files changed, 491 insertions(+), 1 deletion(-) create mode 100644 lib/choreo/lab/dsl/decision_tree.ex create mode 100644 test/choreo/lab/dsl/decision_tree_test.exs diff --git a/.formatter.exs b/.formatter.exs index 3cd8931..f29e230 100644 --- a/.formatter.exs +++ b/.formatter.exs @@ -215,6 +215,18 @@ relates: 3, calls: 1, calls: 2, - calls: 3 + calls: 3, + question: 1, + question: 2, + outcome: 1, + outcome: 2, + result: 1, + result: 2, + leaf: 1, + leaf: 2, + branch: 1, + branch: 2, + condition: 1, + when_: 1 ] ] diff --git a/CHANGELOG.md b/CHANGELOG.md index 6597fcf..5ff4035 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -12,6 +12,7 @@ - Added incubating `Choreo.Lab.DSL.Dataflow` syntax for Livebook-friendly pipeline sketches over the stable `Choreo.Dataflow` builders, including stage clusters and typed normal/error/retry/dead-letter paths. - Added incubating `Choreo.Lab.DSL.Sequence` syntax for Livebook-friendly sequence sketches over the stable `Choreo.Sequence` builders, including ordered messages, activations, notes, and block fragments. - Added incubating `Choreo.Lab.DSL.C4` syntax for Livebook-friendly C4 sketches over the stable `Choreo.C4` builders, including hierarchy-aware constructors, scope statements, clusters, and relationship verbs. +- Added incubating `Choreo.Lab.DSL.DecisionTree` syntax for Livebook-friendly decision policy sketches over the stable `Choreo.DecisionTree` builders, including condition-labeled branch helpers. - Added `Choreo.Lab.View` pipe-friendly helpers for Livebook zoom, focus, filter, path, and collapse exploration over `Choreo.View`. - Added `Choreo.Lab.Compose` pipe-friendly helpers for Livebook cluster, embed, connect, and trace composition over `Choreo`. diff --git a/lib/choreo/lab/dsl/decision_tree.ex b/lib/choreo/lab/dsl/decision_tree.ex new file mode 100644 index 0000000..0fa187d --- /dev/null +++ b/lib/choreo/lab/dsl/decision_tree.ex @@ -0,0 +1,356 @@ +defmodule Choreo.Lab.DSL.DecisionTree do + @moduledoc """ + Experimental Livebook-friendly DSL for sketching decision trees. + + This Lab DSL compiles to the stable, pipe-first `Choreo.DecisionTree` builders + and returns an ordinary `%Choreo.DecisionTree{}`. It is useful for interview + decision policies, routing rules, fallback strategies, and tradeoff walkthroughs. + + ## Examples + + iex> import Choreo.Lab.DSL.DecisionTree + ...> tree = decision_tree do + ...> traffic = root("Traffic Source", feature: "source") + ...> authenticated = decision("Authenticated?", feature: "auth") + ...> reject = outcome("Reject", class: "403") + ...> route = outcome("Route Request", class: "route") + ...> + ...> traffic ~> authenticated |> when_("api") + ...> edge authenticated ~> reject, "no" + ...> branch authenticated ~> route, "yes" + ...> end + iex> Choreo.DecisionTree.root(tree) + :traffic + iex> Choreo.DecisionTree.condition(tree, :authenticated, :route) + "yes" + + Branch conditions can use pipe modifiers or explicit branch forms: + + root ~> decision |> when_("api") + decision ~> outcome |> condition("yes") + edge decision ~> outcome, "yes" + branch decision ~> outcome, "yes" + """ + + @type node_decl :: %{id: Yog.node_id(), builder: atom(), opts: keyword()} + @type branch_decl :: %{from: Yog.node_id(), to: Yog.node_id(), condition: String.t()} + + @node_verbs [:root, :decision, :question, :outcome, :result, :leaf] + + @node_builders %{ + root: :set_root, + decision: :add_decision, + question: :add_decision, + outcome: :add_outcome, + result: :add_outcome, + leaf: :add_outcome + } + + @doc """ + Returns the vocabulary supported by the decision-tree DSL. + + iex> taxonomy = Choreo.Lab.DSL.DecisionTree.taxonomy() + iex> :root in taxonomy.nodes + true + iex> :branch in taxonomy.edges + true + iex> :when_ in taxonomy.modifiers + true + """ + @spec taxonomy() :: %{ + nodes: [atom()], + edges: [atom()], + modifiers: [atom()], + options: [atom()] + } + def taxonomy do + %{ + nodes: @node_verbs, + edges: [:~>, :edge, :branch], + modifiers: [:when_, :condition, :on, :label], + options: [:label, :with, :id, :feature, :class, :probability] + } + end + + @doc """ + Compatibility alias for `taxonomy/0`. + """ + @spec verbs() :: map() + def verbs, do: taxonomy() + + @doc """ + Builds a `%Choreo.DecisionTree{}` from a compact Lab DSL block. + """ + defmacro decision_tree(do: block), do: compile(block) + defmacro decision_tree(opts, do: block), do: compile(block, opts) + + defp compile(block, opts \\ []) do + {steps, _env} = + block + |> statements() + |> Enum.reduce({[], %{}}, fn statement, {steps, env} -> + {statement_steps, env} = statement_steps(statement, env) + {steps ++ statement_steps, env} + end) + + Enum.reduce( + steps, + quote(do: Choreo.DecisionTree.new(unquote(Macro.escape(opts)))), + &pipe_step/2 + ) + end + + defp statements({:__block__, _meta, list}), do: list + defp statements(nil), do: [] + defp statements(single), do: [single] + + defp statement_steps({:=, meta, [{var, _, context}, constructor]}, env) + when is_atom(var) and is_atom(context) do + node = node_from_constructor(constructor, var, meta) + {[{:node, node}], Map.put(env, var, node.id)} + end + + defp statement_steps({:edge, meta, [edge_ast, condition]}, env) when is_binary(condition) do + {branch, nodes} = branch_from_ast(edge_ast, condition, env, meta) + {branch_declaration_steps(nodes, branch), env} + end + + defp statement_steps({:edge, meta, [edge_ast, opts]}, env) when is_list(opts) do + condition = condition_from_opts(opts, meta) + {branch, nodes} = branch_from_ast(edge_ast, condition, env, meta) + {branch_declaration_steps(nodes, branch), env} + end + + defp statement_steps({:branch, meta, [edge_ast, condition]}, env) when is_binary(condition) do + {branch, nodes} = branch_from_ast(edge_ast, condition, env, meta) + {branch_declaration_steps(nodes, branch), env} + end + + defp statement_steps({:branch, meta, [edge_ast, opts]}, env) when is_list(opts) do + condition = condition_from_opts(opts, meta) + {branch, nodes} = branch_from_ast(edge_ast, condition, env, meta) + {branch_declaration_steps(nodes, branch), env} + end + + defp statement_steps({:|>, _meta, _args} = ast, env) do + {branch, nodes} = branch_from_piped_ast(ast, env) + {branch_declaration_steps(nodes, branch), env} + end + + defp statement_steps({:~>, meta, _args}, _env) do + raise ArgumentError, + "decision-tree branches require a condition; use `edge parent ~> child, \"yes\"` or `parent ~> child |> when_(\"yes\")`#{line_suffix(meta)}" + end + + defp statement_steps({name, meta, args} = ast, env) when is_atom(name) and is_list(args) do + if Map.has_key?(@node_builders, name) do + node = node_from_constructor(ast, nil, meta) + {[{:node, node}], env} + else + unsupported_statement!(ast, meta) + end + end + + defp statement_steps(other, _env), do: unsupported_statement!(other, nil) + + defp branch_declaration_steps(nodes, branch) do + nodes + |> Enum.reduce([{:branch, branch}], fn node, steps -> [{:node, node} | steps] end) + |> Enum.reverse() + end + + defp branch_from_piped_ast(ast, env) do + {base, modifiers} = unwrap_pipe(ast, []) + + condition = + modifiers |> Enum.reduce(nil, &condition_modifier/2) |> require_condition!(line_meta(base)) + + branch_from_ast(base, condition, env, line_meta(base)) + end + + defp unwrap_pipe({:|>, _meta, [left, right]}, acc), do: unwrap_pipe(left, [right | acc]) + defp unwrap_pipe(base, acc), do: {base, acc} + + defp condition_modifier({name, _meta, [value]}, _acc) + when name in [:when_, :condition, :on, :label] do + value + end + + defp condition_modifier(other, _acc) do + raise ArgumentError, + "unsupported decision-tree branch modifier: #{Macro.to_string(other)}; " <> + "use `when_(value)`, `condition(value)`, `on(value)`, or `label(value)`" + end + + defp branch_from_ast({:~>, meta, [from_ast, to_ast]}, condition, env, _statement_meta) do + {from, from_node} = endpoint_id(from_ast, env, meta) + {to, to_node} = endpoint_id(to_ast, env, meta) + nodes = [from_node, to_node] |> Enum.reject(&is_nil/1) |> Enum.uniq_by(& &1.id) + {%{from: from, to: to, condition: condition}, nodes} + end + + defp branch_from_ast(other, _condition, _env, meta) do + raise ArgumentError, + "expected `parent ~> child` in decision-tree DSL, got #{Macro.to_string(other)}" <> + line_suffix(meta) + end + + defp endpoint_id({var, _meta, context}, env, meta) when is_atom(var) and is_atom(context) do + case Map.fetch(env, var) do + {:ok, id} -> + {id, nil} + + :error -> + raise ArgumentError, "unknown decision-tree node variable `#{var}`#{line_suffix(meta)}" + end + end + + defp endpoint_id({name, meta, args} = constructor, _env, _statement_meta) + when is_atom(name) and is_list(args) do + if Map.has_key?(@node_builders, name) do + node = node_from_constructor(constructor, nil, meta) + {node.id, node} + else + raise ArgumentError, "unknown decision-tree node constructor `#{name}`#{line_suffix(meta)}" + end + end + + defp endpoint_id(other, _env, meta) do + raise ArgumentError, + "unsupported decision-tree branch endpoint #{Macro.to_string(other)}#{line_suffix(meta)}; " <> + "bind a node first, e.g. `eligible = decision(\"Eligible?\")`" + end + + defp node_from_constructor({name, meta, args}, var, _statement_meta) + when is_atom(name) and is_list(args) do + builder = + Map.get(@node_builders, name) || + raise ArgumentError, + "unknown decision-tree node constructor `#{name}`#{line_suffix(meta)}" + + {opts, positional} = pop_trailing_opts(args) + {id, opts} = node_id_and_opts(var, positional, opts, meta) + opts = maybe_put_feature(builder, opts) + %{id: id, builder: builder, opts: opts} + end + + defp pop_trailing_opts(args) do + case List.last(args) do + last when is_list(last) -> + if Keyword.keyword?(last), do: {last, Enum.drop(args, -1)}, else: {[], args} + + _other -> + {[], args} + end + end + + defp node_id_and_opts(var, positional, opts, meta) do + {explicit_id, opts} = Keyword.pop(opts, :id) + + cond do + length(positional) > 1 -> + raise ArgumentError, + "decision-tree node constructors take at most one positional label/id#{line_suffix(meta)}" + + explicit_id != nil -> + {explicit_id, maybe_put_label(opts, List.first(positional))} + + var != nil -> + {var, maybe_put_label(opts, List.first(positional))} + + positional != [] -> + label_or_id = List.first(positional) + {id_from_label(label_or_id), maybe_put_label(opts, label_or_id)} + + true -> + raise ArgumentError, + "inline decision-tree node constructors need a label/id or `id:` option#{line_suffix(meta)}" + end + end + + defp maybe_put_feature(:add_outcome, opts), do: opts + + defp maybe_put_feature(_builder, opts) do + Keyword.put_new(opts, :feature, Keyword.get(opts, :label, "")) + end + + defp maybe_put_label(opts, nil), do: opts + + defp maybe_put_label(opts, label) when is_binary(label), + do: Keyword.put_new(opts, :label, label) + + defp maybe_put_label(opts, label) when is_atom(label), + do: Keyword.put_new(opts, :label, to_string(label)) + + defp maybe_put_label(opts, _other), do: opts + + defp id_from_label(id) when is_atom(id), do: id + defp id_from_label(id) when is_binary(id), do: slug_atom(id) + + defp id_from_label(other) do + raise ArgumentError, + "inline decision-tree node label/id must be a string or atom, got #{inspect(other)}" + end + + defp slug_atom(label) do + label + |> String.downcase() + |> String.replace(~r/[^a-z0-9]+/u, "_") + |> String.trim("_") + |> case do + "" -> raise ArgumentError, "cannot derive a decision-tree node id from an empty label" + slug -> String.to_atom(slug) + end + end + + defp condition_from_opts(opts, meta) do + opts + |> Keyword.get(:condition, Keyword.get(opts, :label, Keyword.get(opts, :with))) + |> require_condition!(meta) + end + + defp require_condition!(condition, _meta) when is_binary(condition), do: condition + + defp require_condition!(_condition, meta) do + raise ArgumentError, + "decision-tree branches require a string condition#{line_suffix(meta)}" + end + + defp pipe_step({:node, %{id: id, builder: builder, opts: opts}}, acc) do + quote do + apply(Choreo.DecisionTree, unquote(builder), [ + unquote(acc), + unquote(Macro.escape(id)), + unquote(Macro.escape(opts)) + ]) + end + end + + defp pipe_step({:branch, %{from: from, to: to, condition: condition}}, acc) do + quote do + Choreo.DecisionTree.branch( + unquote(acc), + unquote(Macro.escape(from)), + unquote(Macro.escape(to)), + unquote(condition) + ) + end + end + + defp unsupported_statement!(ast, meta) do + raise ArgumentError, + "unsupported statement in decision-tree DSL: #{Macro.to_string(ast)}#{line_suffix(meta)}" + end + + defp line_meta({_name, meta, _args}) when is_list(meta), do: meta + defp line_meta(_other), do: [] + + defp line_suffix(meta) when is_list(meta) do + case Keyword.get(meta, :line) do + nil -> "" + line -> " (line #{line})" + end + end + + defp line_suffix(_meta), do: "" +end diff --git a/test/choreo/lab/dsl/decision_tree_test.exs b/test/choreo/lab/dsl/decision_tree_test.exs new file mode 100644 index 0000000..8f28bc7 --- /dev/null +++ b/test/choreo/lab/dsl/decision_tree_test.exs @@ -0,0 +1,121 @@ +defmodule Choreo.Lab.DecisionTreeDSLTest do + use ExUnit.Case, async: true + + import Choreo.Lab.DSL.DecisionTree + + doctest Choreo.Lab.DSL.DecisionTree + + test "taxonomy returns the Livebook discovery vocabulary" do + taxonomy = Choreo.Lab.DSL.DecisionTree.taxonomy() + + assert :root in taxonomy.nodes + assert :decision in taxonomy.nodes + assert :outcome in taxonomy.nodes + assert :branch in taxonomy.edges + assert :when_ in taxonomy.modifiers + assert :feature in taxonomy.options + assert Choreo.Lab.DSL.DecisionTree.verbs() == taxonomy + end + + test "builds a decision tree with variable-bound nodes" do + tree = + decision_tree do + traffic = root("Traffic Source", feature: "source") + authenticated = decision("Authenticated?", feature: "auth") + reject = outcome("Reject", class: "403") + route = outcome("Route Request", class: "route") + + traffic ~> authenticated |> when_("api") + edge authenticated ~> reject, "no" + branch authenticated ~> route, "yes" + end + + assert Choreo.DecisionTree.root(tree) == :traffic + assert Yog.node(tree.graph, :traffic).node_type == :root + assert Yog.node(tree.graph, :traffic).feature == "source" + assert Yog.node(tree.graph, :authenticated).node_type == :decision + assert Yog.node(tree.graph, :reject).node_type == :outcome + assert Yog.node(tree.graph, :reject).class == "403" + + assert Choreo.DecisionTree.condition(tree, :traffic, :authenticated) == "api" + assert Choreo.DecisionTree.condition(tree, :authenticated, :reject) == "no" + assert Choreo.DecisionTree.condition(tree, :authenticated, :route) == "yes" + end + + test "supports inline constructors for one-off sketches" do + tree = + decision_tree do + root("Cache Hit?", feature: "cache_hit") + ~> outcome("Serve Cache", class: "cache") + |> when_("yes") + end + + assert Choreo.DecisionTree.root(tree) == :cache_hit + assert Yog.node(tree.graph, :serve_cache).node_type == :outcome + assert Choreo.DecisionTree.condition(tree, :cache_hit, :serve_cache) == "yes" + end + + test "supports id option while keeping display label" do + tree = + decision_tree do + entry = root("Traffic Source", id: :source) + api = result("Route API", id: :route_api, class: "api") + + edge entry ~> api, condition: "api" + end + + assert Choreo.DecisionTree.root(tree) == :source + assert Yog.node(tree.graph, :source).label == "Traffic Source" + assert Yog.node(tree.graph, :route_api).label == "Route API" + assert Choreo.DecisionTree.condition(tree, :source, :route_api) == "api" + end + + test "supports condition aliases" do + tree = + decision_tree do + eligible = root("Eligible?", feature: "eligible") + manual = question("Manual Review?", feature: "manual_review") + accept = leaf("Accept", class: "accept") + reject = leaf("Reject", class: "reject") + + eligible ~> manual |> condition("maybe") + manual ~> accept |> on("approved") + edge manual ~> reject, with: "denied" + end + + assert Choreo.DecisionTree.condition(tree, :eligible, :manual) == "maybe" + assert Choreo.DecisionTree.condition(tree, :manual, :accept) == "approved" + assert Choreo.DecisionTree.condition(tree, :manual, :reject) == "denied" + end + + test "raises on missing branch condition" do + assert_raise ArgumentError, ~r/branches require a condition/, fn -> + Code.eval_quoted( + quote do + import Choreo.Lab.DSL.DecisionTree + + decision_tree do + a = root("A") + b = outcome("B") + a ~> b + end + end + ) + end + end + + test "raises on unknown node variables" do + assert_raise ArgumentError, ~r/unknown decision-tree node variable `b`/, fn -> + Code.eval_quoted( + quote do + import Choreo.Lab.DSL.DecisionTree + + decision_tree do + a = root("A") + a ~> b |> when_("yes") + end + end + ) + end + end +end From 6519efab71a0dde8d6ca6791d01a1b5feb55c2f9 Mon Sep 17 00:00:00 2001 From: Mafinar Khan Date: Sun, 19 Jul 2026 20:44:40 -0400 Subject: [PATCH 12/13] Add Lab Workflow DSL --- .formatter.exs | 46 +- CHANGELOG.md | 1 + lib/choreo/lab/dsl/workflow.ex | 584 ++++++++++++++++++++++++++ test/choreo/lab/dsl/workflow_test.exs | 171 ++++++++ 4 files changed, 801 insertions(+), 1 deletion(-) create mode 100644 lib/choreo/lab/dsl/workflow.ex create mode 100644 test/choreo/lab/dsl/workflow_test.exs diff --git a/.formatter.exs b/.formatter.exs index f29e230..a34ea9c 100644 --- a/.formatter.exs +++ b/.formatter.exs @@ -227,6 +227,50 @@ branch: 1, branch: 2, condition: 1, - when_: 1 + when_: 1, + begin: 1, + begin: 2, + step: 1, + step: 2, + gateway: 1, + gateway: 2, + fork: 1, + fork: 2, + split: 1, + split: 2, + join: 1, + join: 2, + merge: 1, + merge: 2, + compensation: 1, + compensation: 2, + compensation: 3, + rollback: 1, + rollback: 2, + event: 1, + event: 2, + timer: 1, + timer: 2, + signal: 1, + signal: 2, + finish: 1, + finish: 2, + done: 1, + done: 2, + end_event: 1, + end_event: 2, + terminal: 1, + terminal: 2, + swimlane: 1, + swimlane: 2, + lane: 1, + lane: 2, + then: 1, + then: 2, + then: 3, + compensates: 1, + compensates: 2, + compensates: 3, + weight: 1 ] ] diff --git a/CHANGELOG.md b/CHANGELOG.md index 5ff4035..d13dd37 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -13,6 +13,7 @@ - Added incubating `Choreo.Lab.DSL.Sequence` syntax for Livebook-friendly sequence sketches over the stable `Choreo.Sequence` builders, including ordered messages, activations, notes, and block fragments. - Added incubating `Choreo.Lab.DSL.C4` syntax for Livebook-friendly C4 sketches over the stable `Choreo.C4` builders, including hierarchy-aware constructors, scope statements, clusters, and relationship verbs. - Added incubating `Choreo.Lab.DSL.DecisionTree` syntax for Livebook-friendly decision policy sketches over the stable `Choreo.DecisionTree` builders, including condition-labeled branch helpers. +- Added incubating `Choreo.Lab.DSL.Workflow` syntax for Livebook-friendly process sketches over the stable `Choreo.Workflow` builders, including swimlanes, typed execution edges, conditions, and Saga compensation helpers. - Added `Choreo.Lab.View` pipe-friendly helpers for Livebook zoom, focus, filter, path, and collapse exploration over `Choreo.View`. - Added `Choreo.Lab.Compose` pipe-friendly helpers for Livebook cluster, embed, connect, and trace composition over `Choreo`. diff --git a/lib/choreo/lab/dsl/workflow.ex b/lib/choreo/lab/dsl/workflow.ex new file mode 100644 index 0000000..71f2184 --- /dev/null +++ b/lib/choreo/lab/dsl/workflow.ex @@ -0,0 +1,584 @@ +defmodule Choreo.Lab.DSL.Workflow do + @moduledoc """ + Experimental Livebook-friendly DSL for sketching workflows. + + This Lab DSL compiles to the stable, pipe-first `Choreo.Workflow` builders and + returns an ordinary `%Choreo.Workflow{}`. It is useful for business processes, + approvals, Sagas, CI/CD flows, and system-design walkthroughs where the shape of + execution matters more than builder ceremony. + + ## Examples + + iex> import Choreo.Lab.DSL.Workflow + ...> flow = workflow do + ...> backend = swimlane("Backend") + ...> start = begin("Request received") + ...> validate = task("Validate token", swimlane: backend, timeout_ms: 100) + ...> authorized = decision("Authorized?") + ...> accepted = finish("Return 200") + ...> rejected = finish("Return 403") + ...> + ...> start ~> validate + ...> validate ~> authorized + ...> authorized ~> accepted |> condition("yes") + ...> failure authorized ~> rejected, "no" + ...> end + iex> Enum.sort(Choreo.Workflow.starts(flow)) + [:start] + iex> Enum.sort(Choreo.Workflow.ends(flow)) + [:accepted, :rejected] + + Edges can use generic, typed, or pipe-modified forms: + + start ~> validate + decision ~> approved |> condition("yes") + edge task ~> retry_step, retry: "temporary failure" + failure task ~> rollback, "validation failed" + compensation rollback ~> done, "cleanup finished" + """ + + @type node_decl :: %{id: Yog.node_id(), builder: atom(), opts: keyword()} + @type swimlane_decl :: %{id: String.t(), opts: keyword()} + @type edge_decl :: %{from: Yog.node_id(), to: Yog.node_id(), opts: keyword()} + + @node_verbs [ + :begin, + :start, + :task, + :step, + :decision, + :gateway, + :fork, + :split, + :join, + :merge, + :compensation, + :rollback, + :event, + :timer, + :signal, + :finish, + :done, + :end_event, + :terminal + ] + + @node_builders %{ + begin: :add_start, + start: :add_start, + task: :add_task, + step: :add_task, + decision: :add_decision, + gateway: :add_decision, + fork: :add_fork, + split: :add_fork, + join: :add_join, + merge: :add_join, + compensation: :add_compensation, + rollback: :add_compensation, + event: :add_event, + timer: :add_event, + signal: :add_event, + finish: :add_end, + done: :add_end, + end_event: :add_end, + terminal: :add_end + } + + @swimlane_verbs [:swimlane, :lane] + @edge_verbs [:sequence, :then, :compensation, :compensates, :retry, :failure, :timeout, :error] + + @edge_type_aliases %{ + sequence: :sequence, + then: :sequence, + compensation: :compensation, + compensates: :compensation, + retry: :retry, + failure: :failure, + timeout: :timeout, + error: :error + } + + @doc """ + Returns the vocabulary supported by the workflow DSL. + + iex> taxonomy = Choreo.Lab.DSL.Workflow.taxonomy() + iex> :task in taxonomy.nodes + true + iex> :swimlane in taxonomy.swimlanes + true + iex> :failure in taxonomy.edges + true + """ + @spec taxonomy() :: %{ + swimlanes: [atom()], + nodes: [atom()], + edges: [atom()], + modifiers: [atom()], + options: [atom()] + } + def taxonomy do + %{ + swimlanes: @swimlane_verbs, + nodes: @node_verbs, + edges: [:~>, :edge | @edge_verbs], + modifiers: [:on, :label, :condition, :when_, :weight | @edge_verbs], + options: [ + :label, + :with, + :id, + :description, + :swimlane, + :timeout_ms, + :retry, + :retry_backoff_ms, + :handler, + :for, + :condition, + :edge_type, + :weight | @edge_verbs + ] + } + end + + @doc """ + Compatibility alias for `taxonomy/0`. + """ + @spec verbs() :: map() + def verbs, do: taxonomy() + + @doc """ + Builds a `%Choreo.Workflow{}` from a compact Lab DSL block. + """ + defmacro workflow(do: block), do: compile(block) + defmacro workflow(opts, do: block), do: compile(block, opts) + + defp compile(block, opts \\ []) do + {steps, _env} = + block + |> statements() + |> Enum.reduce({[], empty_env()}, fn statement, {steps, env} -> + {statement_steps, env} = statement_steps(statement, env) + {steps ++ statement_steps, env} + end) + + Enum.reduce(steps, quote(do: Choreo.Workflow.new(unquote(Macro.escape(opts)))), &pipe_step/2) + end + + defp statements({:__block__, _meta, list}), do: list + defp statements(nil), do: [] + defp statements(single), do: [single] + + defp empty_env, do: %{nodes: %{}, swimlanes: %{}} + + defp statement_steps({:=, meta, [{var, _, context}, constructor]}, env) + when is_atom(var) and is_atom(context) do + cond do + swimlane_constructor?(constructor) -> + swimlane = swimlane_from_constructor(constructor, var, meta) + {[{:swimlane, swimlane}], put_in(env.swimlanes[var], swimlane.id)} + + node_constructor?(constructor) -> + node = node_from_constructor(constructor, var, env, meta) + {[{:node, node}], put_in(env.nodes[var], node.id)} + + true -> + raise ArgumentError, + "expected workflow constructor, got #{Macro.to_string(constructor)}#{line_suffix(meta)}" + end + end + + defp statement_steps({:edge, meta, [edge_ast, label]}, env) when is_binary(label) do + {edge, nodes} = edge_from_ast(edge_ast, [label: label], env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({:edge, meta, [edge_ast, opts]}, env) when is_list(opts) do + {edge, nodes} = edge_from_ast(edge_ast, normalize_edge_opts(opts), env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({:edge, meta, [edge_ast]}, env) do + {edge, nodes} = edge_from_ast(edge_ast, [], env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({:|>, _meta, _args} = ast, env) do + {edge, nodes} = edge_from_piped_ast(ast, env) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({:~>, meta, _args} = ast, env) do + {edge, nodes} = edge_from_ast(ast, [], env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({name, meta, args} = ast, env) when is_atom(name) and is_list(args) do + cond do + name in @edge_verbs -> + typed_edge_statement(name, typed_edge_args!(name, args, meta), env, meta) + + name in @swimlane_verbs -> + swimlane = swimlane_from_constructor(ast, nil, meta) + {[{:swimlane, swimlane}], env} + + Map.has_key?(@node_builders, name) -> + node = node_from_constructor(ast, nil, env, meta) + {[{:node, node}], env} + + true -> + unsupported_statement!(ast, meta) + end + end + + defp statement_steps(other, _env), do: unsupported_statement!(other, nil) + + defp typed_edge_args!(_name, [edge_ast, label, opts], _meta) + when is_binary(label) and is_list(opts), + do: {edge_ast, [label: label] ++ opts} + + defp typed_edge_args!(_name, [edge_ast, label], _meta) when is_binary(label), + do: {edge_ast, [label: label]} + + defp typed_edge_args!(_name, [edge_ast, opts], _meta) when is_list(opts), + do: {edge_ast, opts} + + defp typed_edge_args!(_name, [edge_ast], _meta), do: {edge_ast, []} + + defp typed_edge_args!(name, args, meta) do + raise ArgumentError, + "unsupported workflow edge form `#{name}/#{length(args)}`#{line_suffix(meta)}; " <> + "use `#{name} from ~> to`, `#{name} from ~> to, label`, or `#{name} from ~> to, opts`" + end + + defp typed_edge_statement(name, {edge_ast, opts}, env, meta) do + opts = opts |> normalize_edge_opts() |> edge_type_opts(name) + {edge, nodes} = edge_from_ast(edge_ast, opts, env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + defp edge_declaration_steps(nodes, edge) do + nodes + |> Enum.reduce([{:edge, edge}], fn node, steps -> [{:node, node} | steps] end) + |> Enum.reverse() + end + + defp edge_from_piped_ast(ast, env) do + {base, modifiers} = unwrap_pipe(ast, []) + opts = modifiers |> Enum.reduce([], &modifier_opt/2) |> normalize_edge_opts() + edge_from_ast(base, opts, env, line_meta(base)) + end + + defp unwrap_pipe({:|>, _meta, [left, right]}, acc), do: unwrap_pipe(left, [right | acc]) + defp unwrap_pipe(base, acc), do: {base, acc} + + defp modifier_opt({name, _meta, [value]}, acc) when name in [:on, :label] do + Keyword.put(acc, :label, value) + end + + defp modifier_opt({name, _meta, [value]}, acc) when name in [:condition, :when_] do + Keyword.put(acc, :condition, value) + end + + defp modifier_opt({:weight, _meta, [value]}, acc), do: Keyword.put(acc, :weight, value) + + defp modifier_opt({name, _meta, []}, acc) when name in @edge_verbs do + edge_type_opts(acc, name) + end + + defp modifier_opt({name, _meta, [value]}, acc) when name in @edge_verbs do + acc + |> edge_type_opts(name) + |> Keyword.put_new(:label, value) + end + + defp modifier_opt(other, _acc) do + raise ArgumentError, + "unsupported workflow edge modifier: #{Macro.to_string(other)}; " <> + "use `on(value)`, `condition(value)`, `retry(value)`, `failure(value)`, or `weight(value)`" + end + + defp edge_from_ast({:~>, meta, [from_ast, to_ast]}, opts, env, _statement_meta) do + {from, from_node} = endpoint_id(from_ast, env, meta) + {to, to_node} = endpoint_id(to_ast, env, meta) + nodes = [from_node, to_node] |> Enum.reject(&is_nil/1) |> Enum.uniq_by(& &1.id) + {%{from: from, to: to, opts: normalize_edge_opts(opts)}, nodes} + end + + defp edge_from_ast(other, _opts, _env, meta) do + raise ArgumentError, + "expected `from ~> to` in workflow DSL, got #{Macro.to_string(other)}" <> + line_suffix(meta) + end + + defp endpoint_id({var, _meta, context}, env, meta) when is_atom(var) and is_atom(context) do + case Map.fetch(env.nodes, var) do + {:ok, id} -> {id, nil} + :error -> raise ArgumentError, "unknown workflow node variable `#{var}`#{line_suffix(meta)}" + end + end + + defp endpoint_id({name, meta, args} = constructor, env, _statement_meta) + when is_atom(name) and is_list(args) do + if Map.has_key?(@node_builders, name) do + node = node_from_constructor(constructor, nil, env, meta) + {node.id, node} + else + raise ArgumentError, "unknown workflow node constructor `#{name}`#{line_suffix(meta)}" + end + end + + defp endpoint_id(other, _env, meta) do + raise ArgumentError, + "unsupported workflow edge endpoint #{Macro.to_string(other)}#{line_suffix(meta)}; " <> + "bind a node first, e.g. `validate = task(\"Validate\")`" + end + + defp node_from_constructor({name, meta, args}, var, env, _statement_meta) + when is_atom(name) and is_list(args) do + builder = + Map.get(@node_builders, name) || + raise ArgumentError, "unknown workflow node constructor `#{name}`#{line_suffix(meta)}" + + {opts, positional} = pop_trailing_opts(args) + + opts = + opts + |> resolve_swimlane_option(:swimlane, env, meta) + |> resolve_node_option(:for, env, meta) + + {id, opts} = node_id_and_opts(var, positional, opts, meta) + %{id: id, builder: builder, opts: opts} + end + + defp swimlane_from_constructor({name, meta, args}, var, _statement_meta) + when name in @swimlane_verbs and is_list(args) do + {opts, positional} = pop_trailing_opts(args) + {id, opts} = swimlane_id_and_opts(var, positional, opts, meta) + %{id: id, opts: opts} + end + + defp pop_trailing_opts(args) do + case List.last(args) do + last when is_list(last) -> + if Keyword.keyword?(last), do: {last, Enum.drop(args, -1)}, else: {[], args} + + _other -> + {[], args} + end + end + + defp node_id_and_opts(var, positional, opts, meta) do + {explicit_id, opts} = Keyword.pop(opts, :id) + + cond do + length(positional) > 1 -> + raise ArgumentError, + "workflow node constructors take at most one positional label/id#{line_suffix(meta)}" + + explicit_id != nil -> + {explicit_id, maybe_put_label(opts, List.first(positional))} + + var != nil -> + {var, maybe_put_label(opts, List.first(positional))} + + positional != [] -> + label_or_id = List.first(positional) + {id_from_label(label_or_id), maybe_put_label(opts, label_or_id)} + + true -> + raise ArgumentError, + "inline workflow node constructors need a label/id or `id:` option#{line_suffix(meta)}" + end + end + + defp swimlane_id_and_opts(var, positional, opts, meta) do + {explicit_id, opts} = Keyword.pop(opts, :id) + + cond do + length(positional) > 1 -> + raise ArgumentError, + "workflow swimlane constructors take at most one positional label/id#{line_suffix(meta)}" + + explicit_id != nil -> + {to_string(explicit_id), maybe_put_label(opts, List.first(positional))} + + var != nil -> + {to_string(var), maybe_put_label(opts, List.first(positional))} + + positional != [] -> + label_or_id = List.first(positional) + {swimlane_id_from_label(label_or_id), maybe_put_label(opts, label_or_id)} + + true -> + raise ArgumentError, + "inline workflow swimlane constructors need a label/id or `id:` option#{line_suffix(meta)}" + end + end + + defp maybe_put_label(opts, nil), do: opts + + defp maybe_put_label(opts, label) when is_binary(label), + do: Keyword.put_new(opts, :label, label) + + defp maybe_put_label(opts, label) when is_atom(label), + do: Keyword.put_new(opts, :label, to_string(label)) + + defp maybe_put_label(opts, _other), do: opts + + defp id_from_label(id) when is_atom(id), do: id + defp id_from_label(id) when is_binary(id), do: slug_atom(id) + + defp id_from_label(other) do + raise ArgumentError, + "inline workflow node label/id must be a string or atom, got #{inspect(other)}" + end + + defp swimlane_id_from_label(id) when is_atom(id), do: to_string(id) + defp swimlane_id_from_label(id) when is_binary(id), do: id |> slug_atom() |> to_string() + + defp swimlane_id_from_label(other) do + raise ArgumentError, + "inline workflow swimlane label/id must be a string or atom, got #{inspect(other)}" + end + + defp slug_atom(label) do + label + |> String.downcase() + |> String.replace(~r/[^a-z0-9]+/u, "_") + |> String.trim("_") + |> case do + "" -> raise ArgumentError, "cannot derive a workflow node id from an empty label" + slug -> String.to_atom(slug) + end + end + + defp resolve_swimlane_option(opts, key, env, meta) do + Keyword.update(opts, key, nil, &resolve_swimlane_reference(&1, env, key, meta)) + |> Keyword.reject(fn {_key, value} -> is_nil(value) end) + end + + defp resolve_swimlane_reference({var, _meta, context}, env, key, meta) + when is_atom(var) and is_atom(context) do + case Map.fetch(env.swimlanes, var) do + {:ok, id} -> + id + + :error -> + raise ArgumentError, + "unknown workflow swimlane variable `#{var}` in `#{key}:`#{line_suffix(meta)}" + end + end + + defp resolve_swimlane_reference(value, _env, _key, _meta), do: value + + defp resolve_node_option(opts, key, env, meta) do + Keyword.update(opts, key, nil, &resolve_node_reference(&1, env, key, meta)) + |> Keyword.reject(fn {_key, value} -> is_nil(value) end) + end + + defp resolve_node_reference({var, _meta, context}, env, key, meta) + when is_atom(var) and is_atom(context) do + case Map.fetch(env.nodes, var) do + {:ok, id} -> + id + + :error -> + raise ArgumentError, + "unknown workflow node variable `#{var}` in `#{key}:`#{line_suffix(meta)}" + end + end + + defp resolve_node_reference(value, _env, _key, _meta), do: value + + defp normalize_edge_opts(opts) do + opts + |> normalize_label_alias(:with) + |> normalize_condition_alias(:when_) + |> normalize_edge_aliases() + end + + defp normalize_label_alias(opts, key) do + {value, opts} = Keyword.pop(opts, key) + if value == nil, do: opts, else: Keyword.put_new(opts, :label, value) + end + + defp normalize_condition_alias(opts, key) do + {value, opts} = Keyword.pop(opts, key) + if value == nil, do: opts, else: Keyword.put_new(opts, :condition, value) + end + + defp normalize_edge_aliases(opts) do + Enum.reduce(@edge_verbs, opts, fn key, acc -> + {value, acc} = Keyword.pop(acc, key) + + if value == nil do + acc + else + acc |> edge_type_opts(key) |> Keyword.put_new(:label, value) + end + end) + end + + defp edge_type_opts(opts, name) do + Keyword.put(opts, :edge_type, Map.fetch!(@edge_type_aliases, name)) + end + + defp swimlane_constructor?({name, _meta, args}) when is_atom(name) and is_list(args), + do: name in @swimlane_verbs + + defp swimlane_constructor?(_other), do: false + + defp node_constructor?({name, _meta, args}) when is_atom(name) and is_list(args), + do: Map.has_key?(@node_builders, name) + + defp node_constructor?(_other), do: false + + defp pipe_step({:swimlane, %{id: id, opts: opts}}, acc) do + quote do + Choreo.Workflow.add_swimlane( + unquote(acc), + unquote(Macro.escape(id)), + unquote(Macro.escape(opts)) + ) + end + end + + defp pipe_step({:node, %{id: id, builder: builder, opts: opts}}, acc) do + quote do + apply(Choreo.Workflow, unquote(builder), [ + unquote(acc), + unquote(Macro.escape(id)), + unquote(Macro.escape(opts)) + ]) + end + end + + defp pipe_step({:edge, %{from: from, to: to, opts: opts}}, acc) do + quote do + Choreo.Workflow.connect( + unquote(acc), + unquote(Macro.escape(from)), + unquote(Macro.escape(to)), + unquote(Macro.escape(opts)) + ) + end + end + + defp unsupported_statement!(ast, meta) do + raise ArgumentError, + "unsupported statement in workflow DSL: #{Macro.to_string(ast)}#{line_suffix(meta)}" + end + + defp line_meta({_name, meta, _args}) when is_list(meta), do: meta + defp line_meta(_other), do: [] + + defp line_suffix(meta) when is_list(meta) do + case Keyword.get(meta, :line) do + nil -> "" + line -> " (line #{line})" + end + end + + defp line_suffix(_meta), do: "" +end diff --git a/test/choreo/lab/dsl/workflow_test.exs b/test/choreo/lab/dsl/workflow_test.exs new file mode 100644 index 0000000..fb433fe --- /dev/null +++ b/test/choreo/lab/dsl/workflow_test.exs @@ -0,0 +1,171 @@ +defmodule Choreo.Lab.WorkflowDSLTest do + use ExUnit.Case + + doctest Choreo.Lab.DSL.Workflow + + import Choreo.Lab.DSL.Workflow + + alias Choreo.Workflow + + test "taxonomy returns the Livebook discovery vocabulary" do + taxonomy = Choreo.Lab.DSL.Workflow.taxonomy() + + assert :task in taxonomy.nodes + assert :finish in taxonomy.nodes + assert :swimlane in taxonomy.swimlanes + assert :~> in taxonomy.edges + assert :failure in taxonomy.edges + assert :condition in taxonomy.modifiers + assert :with in taxonomy.options + assert Choreo.Lab.DSL.Workflow.verbs() == taxonomy + end + + test "builds a workflow with variable-bound swimlanes, nodes, and edges" do + flow = + workflow do + backend = swimlane("Backend") + start = begin("Request received") + validate = task("Validate token", swimlane: backend, timeout_ms: 100, retry: 2) + authorized = decision("Authorized?") + accepted = finish("Return 200") + rejected = finish("Return 403") + + start ~> validate + validate ~> authorized + authorized ~> accepted |> condition("yes") + failure(authorized ~> rejected, "no") + end + + assert Workflow.starts(flow) == [:start] + assert Enum.sort(Workflow.ends(flow)) == [:accepted, :rejected] + assert :validate in Workflow.tasks(flow) + assert Map.get(flow.graph.nodes, :validate).cluster == "cluster_backend" + assert Map.get(flow.graph.nodes, :validate).timeout_ms == 100 + assert Map.get(flow.graph.nodes, :validate).retry == 2 + + edges = Workflow.edges_with_meta(flow) + + assert Enum.any?(edges, fn + {:authorized, :accepted, _weight, meta} -> meta.condition == "yes" + _other -> false + end) + + assert Enum.any?(edges, fn + {:authorized, :rejected, _weight, meta} -> meta.edge_type == :failure + _other -> false + end) + end + + test "supports inline constructors for one-off sketches" do + flow = + workflow do + begin("Start") ~> task("Process") + task("Process") ~> done("Done") + end + + assert :start in Workflow.starts(flow) + assert :process in Workflow.tasks(flow) + assert :done in Workflow.ends(flow) + end + + test "supports id option while keeping display label" do + flow = + workflow do + entry = start("HTTP Request", id: :request) + process = step("Route Tenant") + terminal = end_event("Response Sent", id: :response) + + edge entry ~> process, "dispatch" + edge process ~> terminal, with: "return" + end + + assert Workflow.starts(flow) == [:request] + assert Workflow.ends(flow) == [:response] + assert Map.get(flow.graph.nodes, :request).label == "HTTP Request" + assert Map.get(flow.graph.nodes, :response).label == "Response Sent" + + labels = + Enum.map(Workflow.edges_with_meta(flow), fn {_from, _to, _weight, meta} -> meta.label end) + + assert "dispatch" in labels + assert "return" in labels + end + + test "supports typed edge aliases and keyword edge forms" do + flow = + workflow do + process = task("Process Payment", retry: 3) + retry_step = task("Retry Payment") + rollback = compensation("Refund Payment", for: process) + timeout_handler = task("Timeout Handler") + done = finish("Done") + + retry process ~> retry_step, "temporary failure" + edge process ~> timeout_handler, timeout: "gateway timeout" + process ~> rollback |> compensates("payment failed") + compensation(rollback ~> done, "refunded") + end + + assert Map.get(flow.graph.nodes, :rollback).target_task == :process + + edge_types = + Enum.map(Workflow.edges_with_meta(flow), fn {_from, _to, _weight, meta} -> + meta.edge_type + end) + + assert :retry in edge_types + assert :timeout in edge_types + assert :compensation in edge_types + end + + test "supports condition and weight modifiers" do + flow = + workflow do + choose = gateway("Choose route") + fast = task("Fast Path") + slow = task("Slow Path") + + choose ~> fast |> when_("cache hit") |> weight(10) + choose ~> slow |> condition("cache miss") |> weight(100) + end + + assert Enum.any?(Workflow.edges_with_meta(flow), fn + {:choose, :fast, weight, meta} -> weight == 10 and meta.condition == "cache hit" + _other -> false + end) + + assert Enum.any?(Workflow.edges_with_meta(flow), fn + {:choose, :slow, weight, meta} -> weight == 100 and meta.condition == "cache miss" + _other -> false + end) + end + + test "raises on unknown node variables" do + assert_raise ArgumentError, ~r/unknown workflow node variable `missing`/, fn -> + Code.eval_quoted( + quote do + import Choreo.Lab.DSL.Workflow + + workflow do + entry = start("Start") + entry ~> missing + end + end + ) + end + end + + test "raises on unknown swimlane variables" do + assert_raise ArgumentError, ~r/unknown workflow swimlane variable `backend`/, fn -> + Code.eval_quoted( + quote do + import Choreo.Lab.DSL.Workflow + + workflow do + task("Validate", swimlane: backend) + end + end + ) + end + end +end From f932f0133d288c3e185f7c9a96a0f56a8a108add Mon Sep 17 00:00:00 2001 From: Mafinar Khan Date: Sun, 19 Jul 2026 21:08:14 -0400 Subject: [PATCH 13/13] Add Lab domain traceability DSLs --- .formatter.exs | 144 ++++- CHANGELOG.md | 3 + lib/choreo/lab/dsl/dependency.ex | 540 +++++++++++++++++++ lib/choreo/lab/dsl/domain.ex | 660 +++++++++++++++++++++++ lib/choreo/lab/dsl/requirement.ex | 513 ++++++++++++++++++ test/choreo/lab/dsl/dependency_test.exs | 153 ++++++ test/choreo/lab/dsl/domain_test.exs | 182 +++++++ test/choreo/lab/dsl/requirement_test.exs | 134 +++++ 8 files changed, 2328 insertions(+), 1 deletion(-) create mode 100644 lib/choreo/lab/dsl/dependency.ex create mode 100644 lib/choreo/lab/dsl/domain.ex create mode 100644 lib/choreo/lab/dsl/requirement.ex create mode 100644 test/choreo/lab/dsl/dependency_test.exs create mode 100644 test/choreo/lab/dsl/domain_test.exs create mode 100644 test/choreo/lab/dsl/requirement_test.exs diff --git a/.formatter.exs b/.formatter.exs index a34ea9c..4a62b2a 100644 --- a/.formatter.exs +++ b/.formatter.exs @@ -271,6 +271,148 @@ compensates: 1, compensates: 2, compensates: 3, - weight: 1 + weight: 1, + dependency: 1, + dependency: 2, + library: 1, + library: 2, + lib: 1, + lib: 2, + package: 1, + package: 2, + interface: 1, + interface: 2, + contract: 1, + contract: 2, + protocol: 1, + protocol: 2, + spec: 1, + spec: 2, + test_suite: 1, + test_suite: 2, + layer: 1, + layer: 2, + imports: 1, + imports: 2, + imports: 3, + depends_on: 1, + depends_on: 2, + depends_on: 3, + req: 1, + req: 2, + functional: 1, + functional: 2, + interface_requirement: 1, + interface_requirement: 2, + performance: 1, + performance: 2, + physical: 1, + physical: 2, + constraint: 1, + constraint: 2, + design_constraint: 1, + design_constraint: 2, + test_case: 1, + test_case: 2, + verification: 1, + verification: 2, + stakeholder: 1, + stakeholder: 2, + owner: 1, + owner: 2, + team: 1, + team: 2, + satisfies: 1, + satisfies: 2, + satisfies: 3, + verifies: 1, + verifies: 2, + verifies: 3, + refines: 1, + refines: 2, + refines: 3, + contains: 1, + contains: 2, + contains: 3, + derives: 1, + derives: 2, + derives: 3, + bounded_context: 1, + bounded_context: 2, + context_boundary: 1, + context_boundary: 2, + context_cluster: 1, + context_cluster: 2, + user: 1, + user: 2, + command: 1, + command: 2, + aggregate: 1, + aggregate: 2, + entity: 1, + entity: 2, + domain_event: 1, + domain_event: 2, + read_model: 1, + read_model: 2, + projection: 1, + projection: 2, + policy: 1, + policy: 2, + saga: 1, + saga: 2, + external_system: 1, + external_system: 2, + external: 1, + external: 2, + data_type: 1, + data_type: 2, + process: 1, + process: 2, + acl: 1, + acl: 2, + anti_corruption_layer: 1, + anti_corruption_layer: 2, + scenario: 2, + scenario: 3, + initiates: 1, + initiates: 2, + initiates: 3, + handles: 1, + handles: 2, + handles: 3, + triggers: 1, + triggers: 2, + triggers: 3, + projects_to: 1, + projects_to: 2, + projects_to: 3, + notifies: 1, + notifies: 2, + notifies: 3, + translates_via: 1, + translates_via: 2, + translates_via: 3, + shared_kernel: 1, + shared_kernel: 2, + shared_kernel: 3, + customer_supplier: 1, + customer_supplier: 2, + customer_supplier: 3, + conformist: 1, + conformist: 2, + conformist: 3, + open_host_service: 1, + open_host_service: 2, + open_host_service: 3, + published_language: 1, + published_language: 2, + published_language: 3, + anti_corruption: 1, + anti_corruption: 2, + anti_corruption: 3, + connects: 1, + connects: 2, + connects: 3 ] ] diff --git a/CHANGELOG.md b/CHANGELOG.md index d13dd37..a94d559 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,6 +14,9 @@ - Added incubating `Choreo.Lab.DSL.C4` syntax for Livebook-friendly C4 sketches over the stable `Choreo.C4` builders, including hierarchy-aware constructors, scope statements, clusters, and relationship verbs. - Added incubating `Choreo.Lab.DSL.DecisionTree` syntax for Livebook-friendly decision policy sketches over the stable `Choreo.DecisionTree` builders, including condition-labeled branch helpers. - Added incubating `Choreo.Lab.DSL.Workflow` syntax for Livebook-friendly process sketches over the stable `Choreo.Workflow` builders, including swimlanes, typed execution edges, conditions, and Saga compensation helpers. +- Added incubating `Choreo.Lab.DSL.Dependency` syntax for Livebook-friendly software dependency sketches over the stable `Choreo.Dependency` builders, including clusters and typed dependency edges. +- Added incubating `Choreo.Lab.DSL.Requirement` syntax for Livebook-friendly requirements traceability sketches over the stable `Choreo.Requirement` builders, including requirement-kind constructors and typed traceability edges. +- Added incubating `Choreo.Lab.DSL.Domain` syntax for Livebook-friendly DDD and event-storming sketches over the stable `Choreo.Domain` builders, including context maps, tactical domain flows, and named scenarios. - Added `Choreo.Lab.View` pipe-friendly helpers for Livebook zoom, focus, filter, path, and collapse exploration over `Choreo.View`. - Added `Choreo.Lab.Compose` pipe-friendly helpers for Livebook cluster, embed, connect, and trace composition over `Choreo`. diff --git a/lib/choreo/lab/dsl/dependency.ex b/lib/choreo/lab/dsl/dependency.ex new file mode 100644 index 0000000..323d8d3 --- /dev/null +++ b/lib/choreo/lab/dsl/dependency.ex @@ -0,0 +1,540 @@ +defmodule Choreo.Lab.DSL.Dependency do + @moduledoc """ + Experimental Livebook-friendly DSL for sketching software dependency graphs. + + This Lab DSL compiles to the stable, pipe-first `Choreo.Dependency` builders and + returns an ordinary `%Choreo.Dependency{}`. It is useful for quick architecture + sketches, refactoring conversations, onboarding maps, and interview explanations + of coupling between applications, modules, libraries, interfaces, and tests. + + ## Examples + + iex> import Choreo.Lab.DSL.Dependency + ...> deps = dependency do + ...> core = cluster("Core") + ...> api = application("API Gateway") + ...> auth = module("Auth", cluster: core) + ...> contract = interface("Auth Behaviour") + ...> phoenix = library("Phoenix") + ...> + ...> api ~> phoenix |> uses("HTTP stack") + ...> api ~> auth |> calls("validates token") + ...> auth ~> contract |> implements("implements callbacks") + ...> end + iex> Enum.sort(Choreo.Dependency.nodes(deps)) + [:api, :auth, :contract, :phoenix] + + Edges can use generic, typed, or pipe-modified forms: + + api ~> auth + api ~> auth |> calls("validates token") + edge api ~> phoenix, uses: "framework" + imports module_a ~> module_b, "alias/import" + dev app ~> test_lib, "test helper" + """ + + @type node_decl :: %{id: Yog.node_id(), builder: atom(), opts: keyword()} + @type cluster_decl :: %{id: String.t(), opts: keyword()} + @type edge_decl :: %{from: Yog.node_id(), to: Yog.node_id(), opts: keyword()} + + @node_verbs [ + :application, + :app, + :service, + :library, + :lib, + :package, + :dependency, + :module, + :component, + :interface, + :contract, + :protocol, + :test, + :spec, + :test_suite + ] + + @node_builders %{ + application: :add_application, + app: :add_application, + service: :add_application, + library: :add_library, + lib: :add_library, + package: :add_library, + dependency: :add_library, + module: :add_module, + component: :add_module, + interface: :add_interface, + contract: :add_interface, + protocol: :add_interface, + test: :add_test, + spec: :add_test, + test_suite: :add_test + } + + @cluster_verbs [:cluster, :group, :layer] + @edge_verbs [:depends, :depends_on, :uses, :imports, :calls, :inherits, :implements, :dev] + + @edge_type_aliases %{ + depends: :uses, + depends_on: :uses, + uses: :uses, + imports: :imports, + calls: :calls, + inherits: :inherits, + implements: :inherits, + dev: :dev + } + + @doc """ + Returns the vocabulary supported by the dependency DSL. + + iex> taxonomy = Choreo.Lab.DSL.Dependency.taxonomy() + iex> :application in taxonomy.nodes + true + iex> :cluster in taxonomy.clusters + true + iex> :calls in taxonomy.edges + true + """ + @spec taxonomy() :: %{ + clusters: [atom()], + nodes: [atom()], + edges: [atom()], + modifiers: [atom()], + options: [atom()] + } + def taxonomy do + %{ + clusters: @cluster_verbs, + nodes: @node_verbs, + edges: [:~>, :edge | @edge_verbs], + modifiers: [:on, :label | @edge_verbs], + options: [:label, :with, :id, :description, :cluster, :parent, :type | @edge_verbs] + } + end + + @doc """ + Compatibility alias for `taxonomy/0`. + """ + @spec verbs() :: map() + def verbs, do: taxonomy() + + @doc """ + Builds a `%Choreo.Dependency{}` from a compact Lab DSL block. + """ + defmacro dependency(do: block), do: compile(block) + defmacro dependency(opts, do: block), do: compile(block, opts) + + defp compile(block, opts \\ []) do + {steps, _env} = + block + |> statements() + |> Enum.reduce({[], empty_env()}, fn statement, {steps, env} -> + {statement_steps, env} = statement_steps(statement, env) + {steps ++ statement_steps, env} + end) + + Enum.reduce( + steps, + quote(do: Choreo.Dependency.new(unquote(Macro.escape(opts)))), + &pipe_step/2 + ) + end + + defp statements({:__block__, _meta, list}), do: list + defp statements(nil), do: [] + defp statements(single), do: [single] + + defp empty_env, do: %{nodes: %{}, clusters: %{}} + + defp statement_steps({:=, meta, [{var, _, context}, constructor]}, env) + when is_atom(var) and is_atom(context) do + cond do + cluster_constructor?(constructor) -> + cluster = cluster_from_constructor(constructor, var, env, meta) + {[{:cluster, cluster}], put_in(env.clusters[var], cluster.id)} + + node_constructor?(constructor) -> + node = node_from_constructor(constructor, var, env, meta) + {[{:node, node}], put_in(env.nodes[var], node.id)} + + true -> + raise ArgumentError, + "expected dependency constructor, got #{Macro.to_string(constructor)}#{line_suffix(meta)}" + end + end + + defp statement_steps({:edge, meta, [edge_ast, label]}, env) when is_binary(label) do + {edge, nodes} = edge_from_ast(edge_ast, [label: label], env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({:edge, meta, [edge_ast, opts]}, env) when is_list(opts) do + {edge, nodes} = edge_from_ast(edge_ast, normalize_edge_opts(opts), env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({:edge, meta, [edge_ast]}, env) do + {edge, nodes} = edge_from_ast(edge_ast, [], env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({:|>, _meta, _args} = ast, env) do + {edge, nodes} = edge_from_piped_ast(ast, env) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({:~>, meta, _args} = ast, env) do + {edge, nodes} = edge_from_ast(ast, [], env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({name, meta, args} = ast, env) when is_atom(name) and is_list(args) do + cond do + name in @edge_verbs -> + typed_edge_statement(name, typed_edge_args!(name, args, meta), env, meta) + + name in @cluster_verbs -> + cluster = cluster_from_constructor(ast, nil, env, meta) + {[{:cluster, cluster}], env} + + Map.has_key?(@node_builders, name) -> + node = node_from_constructor(ast, nil, env, meta) + {[{:node, node}], env} + + true -> + unsupported_statement!(ast, meta) + end + end + + defp statement_steps(other, _env), do: unsupported_statement!(other, nil) + + defp typed_edge_args!(_name, [edge_ast, label, opts], _meta) + when is_binary(label) and is_list(opts), + do: {edge_ast, [label: label] ++ opts} + + defp typed_edge_args!(_name, [edge_ast, label], _meta) when is_binary(label), + do: {edge_ast, [label: label]} + + defp typed_edge_args!(_name, [edge_ast, opts], _meta) when is_list(opts), + do: {edge_ast, opts} + + defp typed_edge_args!(_name, [edge_ast], _meta), do: {edge_ast, []} + + defp typed_edge_args!(name, args, meta) do + raise ArgumentError, + "unsupported dependency edge form `#{name}/#{length(args)}`#{line_suffix(meta)}; " <> + "use `#{name} from ~> to`, `#{name} from ~> to, label`, or `#{name} from ~> to, opts`" + end + + defp typed_edge_statement(name, {edge_ast, opts}, env, meta) do + opts = opts |> normalize_edge_opts() |> edge_type_opts(name) + {edge, nodes} = edge_from_ast(edge_ast, opts, env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + defp edge_declaration_steps(nodes, edge) do + nodes + |> Enum.reduce([{:edge, edge}], fn node, steps -> [{:node, node} | steps] end) + |> Enum.reverse() + end + + defp edge_from_piped_ast(ast, env) do + {base, modifiers} = unwrap_pipe(ast, []) + opts = modifiers |> Enum.reduce([], &modifier_opt/2) |> normalize_edge_opts() + edge_from_ast(base, opts, env, line_meta(base)) + end + + defp unwrap_pipe({:|>, _meta, [left, right]}, acc), do: unwrap_pipe(left, [right | acc]) + defp unwrap_pipe(base, acc), do: {base, acc} + + defp modifier_opt({name, _meta, [value]}, acc) when name in [:on, :label] do + Keyword.put(acc, :label, value) + end + + defp modifier_opt({name, _meta, []}, acc) when name in @edge_verbs do + edge_type_opts(acc, name) + end + + defp modifier_opt({name, _meta, [value]}, acc) when name in @edge_verbs do + acc + |> edge_type_opts(name) + |> Keyword.put_new(:label, value) + end + + defp modifier_opt(other, _acc) do + raise ArgumentError, + "unsupported dependency edge modifier: #{Macro.to_string(other)}; " <> + "use `on(value)`, `uses(value)`, `imports(value)`, `calls(value)`, or `dev(value)`" + end + + defp edge_from_ast({:~>, meta, [from_ast, to_ast]}, opts, env, _statement_meta) do + {from, to, declared_nodes} = dependency_endpoints(from_ast, to_ast, env, meta) + {%{from: from, to: to, opts: normalize_edge_opts(opts)}, declared_nodes} + end + + defp edge_from_ast(other, _opts, _env, meta) do + raise ArgumentError, + "expected `from ~> to` in dependency DSL, got #{Macro.to_string(other)}" <> + line_suffix(meta) + end + + defp dependency_endpoints(from_ast, to_ast, env, meta) do + {from, maybe_from_node} = endpoint_id(from_ast, env, meta) + {to, maybe_to_node} = endpoint_id(to_ast, env, meta) + {from, to, declared_endpoint_nodes(maybe_from_node, maybe_to_node)} + end + + defp declared_endpoint_nodes(from_node, to_node) do + [from_node, to_node] + |> Enum.reject(&is_nil/1) + |> Enum.uniq_by(& &1.id) + end + + defp endpoint_id({var, _meta, context}, env, meta) when is_atom(var) and is_atom(context) do + case Map.fetch(env.nodes, var) do + {:ok, id} -> + {id, nil} + + :error -> + raise ArgumentError, "unknown dependency node variable `#{var}`#{line_suffix(meta)}" + end + end + + defp endpoint_id({name, meta, args} = constructor, env, _statement_meta) + when is_atom(name) and is_list(args) do + if Map.has_key?(@node_builders, name) do + node = node_from_constructor(constructor, nil, env, meta) + {node.id, node} + else + raise ArgumentError, "unknown dependency node constructor `#{name}`#{line_suffix(meta)}" + end + end + + defp endpoint_id(other, _env, meta) do + raise ArgumentError, + "unsupported dependency edge endpoint #{Macro.to_string(other)}#{line_suffix(meta)}; " <> + "bind a node first, e.g. `api = application(\"API\")`" + end + + defp node_from_constructor({name, meta, args}, var, env, _statement_meta) + when is_atom(name) and is_list(args) do + builder = + Map.get(@node_builders, name) || + raise ArgumentError, "unknown dependency node constructor `#{name}`#{line_suffix(meta)}" + + {opts, positional} = pop_trailing_opts(args) + opts = resolve_cluster_option(opts, :cluster, env, meta) + {id, opts} = node_id_and_opts(var, positional, opts, meta) + %{id: id, builder: builder, opts: opts} + end + + defp cluster_from_constructor({name, meta, args}, var, env, _statement_meta) + when name in @cluster_verbs and is_list(args) do + {opts, positional} = pop_trailing_opts(args) + opts = resolve_cluster_option(opts, :parent, env, meta) + {id, opts} = cluster_id_and_opts(var, positional, opts, meta) + %{id: id, opts: opts} + end + + defp pop_trailing_opts(args) do + case List.last(args) do + last when is_list(last) -> + if Keyword.keyword?(last), do: {last, Enum.drop(args, -1)}, else: {[], args} + + _other -> + {[], args} + end + end + + defp node_id_and_opts(var, positional, opts, meta) do + {explicit_id, opts} = Keyword.pop(opts, :id) + + cond do + length(positional) > 1 -> + raise ArgumentError, + "dependency node constructors take at most one positional label/id#{line_suffix(meta)}" + + explicit_id != nil -> + {explicit_id, maybe_put_label(opts, List.first(positional))} + + var != nil -> + {var, maybe_put_label(opts, List.first(positional))} + + positional != [] -> + label_or_id = List.first(positional) + {id_from_label(label_or_id), maybe_put_label(opts, label_or_id)} + + true -> + raise ArgumentError, + "inline dependency node constructors need a label/id or `id:` option#{line_suffix(meta)}" + end + end + + defp cluster_id_and_opts(var, positional, opts, meta) do + {explicit_id, opts} = Keyword.pop(opts, :id) + + cond do + length(positional) > 1 -> + raise ArgumentError, + "dependency cluster constructors take at most one positional label/id#{line_suffix(meta)}" + + explicit_id != nil -> + {to_string(explicit_id), maybe_put_label(opts, List.first(positional))} + + var != nil -> + {to_string(var), maybe_put_label(opts, List.first(positional))} + + positional != [] -> + label_or_id = List.first(positional) + {cluster_id_from_label(label_or_id), maybe_put_label(opts, label_or_id)} + + true -> + raise ArgumentError, + "inline dependency cluster constructors need a label/id or `id:` option#{line_suffix(meta)}" + end + end + + defp maybe_put_label(opts, nil), do: opts + + defp maybe_put_label(opts, label) when is_binary(label), + do: Keyword.put_new(opts, :label, label) + + defp maybe_put_label(opts, label) when is_atom(label), + do: Keyword.put_new(opts, :label, to_string(label)) + + defp maybe_put_label(opts, _other), do: opts + + defp id_from_label(id) when is_atom(id), do: id + defp id_from_label(id) when is_binary(id), do: slug_atom(id) + + defp id_from_label(other) do + raise ArgumentError, + "inline dependency node label/id must be a string or atom, got #{inspect(other)}" + end + + defp cluster_id_from_label(id) when is_atom(id), do: to_string(id) + defp cluster_id_from_label(id) when is_binary(id), do: id |> slug_atom() |> to_string() + + defp cluster_id_from_label(other) do + raise ArgumentError, + "inline dependency cluster label/id must be a string or atom, got #{inspect(other)}" + end + + defp slug_atom(label) do + label + |> String.downcase() + |> String.replace(~r/[^a-z0-9]+/u, "_") + |> String.trim("_") + |> case do + "" -> raise ArgumentError, "cannot derive a dependency node id from an empty label" + slug -> String.to_atom(slug) + end + end + + defp resolve_cluster_option(opts, key, env, meta) do + Keyword.update(opts, key, nil, &resolve_cluster_reference(&1, env, key, meta)) + |> Keyword.reject(fn {_key, value} -> is_nil(value) end) + end + + defp resolve_cluster_reference({var, _meta, context}, env, key, meta) + when is_atom(var) and is_atom(context) do + case Map.fetch(env.clusters, var) do + {:ok, id} -> + id + + :error -> + raise ArgumentError, + "unknown dependency cluster variable `#{var}` in `#{key}:`#{line_suffix(meta)}" + end + end + + defp resolve_cluster_reference(value, _env, _key, _meta), do: value + + defp normalize_edge_opts(opts) do + opts + |> normalize_label_alias(:with) + |> normalize_edge_aliases() + end + + defp normalize_label_alias(opts, key) do + {value, opts} = Keyword.pop(opts, key) + if value == nil, do: opts, else: Keyword.put_new(opts, :label, value) + end + + defp normalize_edge_aliases(opts) do + Enum.reduce(@edge_verbs, opts, fn key, acc -> + {value, acc} = Keyword.pop(acc, key) + + if value == nil do + acc + else + acc |> edge_type_opts(key) |> Keyword.put_new(:label, value) + end + end) + end + + defp edge_type_opts(opts, name) do + Keyword.put(opts, :type, Map.fetch!(@edge_type_aliases, name)) + end + + defp cluster_constructor?({name, _meta, args}) when is_atom(name) and is_list(args), + do: name in @cluster_verbs + + defp cluster_constructor?(_other), do: false + + defp node_constructor?({name, _meta, args}) when is_atom(name) and is_list(args), + do: Map.has_key?(@node_builders, name) + + defp node_constructor?(_other), do: false + + defp pipe_step({:cluster, %{id: id, opts: opts}}, acc) do + quote do + Choreo.Dependency.add_cluster( + unquote(acc), + unquote(Macro.escape(id)), + unquote(Macro.escape(opts)) + ) + end + end + + defp pipe_step({:node, %{id: id, builder: builder, opts: opts}}, acc) do + quote do + apply(Choreo.Dependency, unquote(builder), [ + unquote(acc), + unquote(Macro.escape(id)), + unquote(Macro.escape(opts)) + ]) + end + end + + defp pipe_step({:edge, %{from: from, to: to, opts: opts}}, acc) do + quote do + Choreo.Dependency.depends_on( + unquote(acc), + unquote(Macro.escape(from)), + unquote(Macro.escape(to)), + unquote(Macro.escape(opts)) + ) + end + end + + defp unsupported_statement!(ast, meta) do + raise ArgumentError, + "unsupported statement in dependency DSL: #{Macro.to_string(ast)}#{line_suffix(meta)}" + end + + defp line_meta({_name, meta, _args}) when is_list(meta), do: meta + defp line_meta(_other), do: [] + + defp line_suffix(meta) when is_list(meta) do + case Keyword.get(meta, :line) do + nil -> "" + line -> " (line #{line})" + end + end + + defp line_suffix(_meta), do: "" +end diff --git a/lib/choreo/lab/dsl/domain.ex b/lib/choreo/lab/dsl/domain.ex new file mode 100644 index 0000000..a035c96 --- /dev/null +++ b/lib/choreo/lab/dsl/domain.ex @@ -0,0 +1,660 @@ +defmodule Choreo.Lab.DSL.Domain do + @moduledoc """ + Experimental Livebook-friendly DSL for sketching DDD domain models. + + This Lab DSL compiles to the stable, pipe-first `Choreo.Domain` builders and + returns an ordinary `%Choreo.Domain{}`. It supports strategic context maps, + tactical event-storming flows, Wlaschin-style workflow/type sketches, and named + scenarios for Event Modeling projections. + + ## Examples + + iex> import Choreo.Lab.DSL.Domain + ...> model = domain do + ...> checkout = context_boundary("Checkout") + ...> customer = actor("Customer") + ...> place_order = command("Place Order", cluster: checkout) + ...> order = aggregate("Order", cluster: checkout, invariants: ["Cannot place an empty order."]) + ...> placed = event("Order Placed", cluster: checkout) + ...> summary = read_model("Order Summary", cluster: checkout) + ...> + ...> customer ~> place_order |> initiates("starts") + ...> place_order ~> order |> handles("validates") + ...> order ~> placed |> emits("records") + ...> placed ~> summary |> projects_to("updates") + ...> end + iex> Choreo.Domain.nodes(model).order.type + :aggregate + + Strategic context maps can use context nodes and context-mapping relationships: + + ordering = context("Ordering", subdomain: :core) + billing = context("Billing", subdomain: :supporting) + customer_supplier ordering ~> billing, "Invoice requests" + + Tactical edges can use generic, typed, or pipe-modified forms: + + actor ~> command |> initiates("submits") + command ~> aggregate |> handles("validates") + aggregate ~> event |> emits("records") + event ~> policy |> triggers("reacts") + event ~> read_model |> projects_to("updates") + edge upstream ~> downstream, translates_via: "ACL" + """ + + @type node_decl :: %{id: Yog.node_id(), builder: atom(), opts: keyword()} + @type cluster_decl :: %{id: String.t(), builder: atom(), opts: keyword()} + @type edge_decl :: %{from: Yog.node_id(), to: Yog.node_id(), opts: keyword(), builder: atom()} + @type scenario_decl :: %{name: atom(), opts: keyword()} + + @node_verbs [ + :context, + :bounded_context, + :actor, + :user, + :command, + :aggregate, + :entity, + :event, + :domain_event, + :read_model, + :projection, + :policy, + :saga, + :external_system, + :external, + :type, + :data_type, + :workflow, + :process, + :acl, + :anti_corruption_layer + ] + + @node_builders %{ + context: :add_context, + bounded_context: :add_context, + actor: :add_actor, + user: :add_actor, + command: :add_command, + aggregate: :add_aggregate, + entity: :add_aggregate, + event: :add_event, + domain_event: :add_event, + read_model: :add_read_model, + projection: :add_read_model, + policy: :add_policy, + saga: :add_policy, + external_system: :add_external_system, + external: :add_external_system, + type: :add_type, + data_type: :add_type, + workflow: :add_workflow, + process: :add_workflow, + acl: :add_acl, + anti_corruption_layer: :add_acl + } + + @cluster_verbs [:context_boundary, :boundary, :context_cluster] + @domain_edge_verbs [ + :initiates, + :handles, + :emits, + :triggers, + :projects_to, + :notifies, + :translates_via + ] + + @context_edge_verbs [ + :shared_kernel, + :customer_supplier, + :conformist, + :open_host_service, + :published_language, + :anti_corruption + ] + + @edge_verbs [ + :initiates, + :handles, + :emits, + :triggers, + :projects_to, + :notifies, + :translates_via, + :connects, + :shared_kernel, + :customer_supplier, + :conformist, + :open_host_service, + :published_language, + :anti_corruption + ] + + @context_relationships %{ + shared_kernel: :shared_kernel, + customer_supplier: :customer_supplier, + conformist: :conformist, + open_host_service: :open_host_service, + published_language: :published_language, + anti_corruption: :acl + } + + @doc """ + Returns the vocabulary supported by the domain DSL. + + iex> taxonomy = Choreo.Lab.DSL.Domain.taxonomy() + iex> :aggregate in taxonomy.nodes + true + iex> :context_boundary in taxonomy.clusters + true + iex> :emits in taxonomy.edges + true + """ + @spec taxonomy() :: %{ + clusters: [atom()], + nodes: [atom()], + edges: [atom()], + events: [atom()], + modifiers: [atom()], + options: [atom()] + } + def taxonomy do + %{ + clusters: @cluster_verbs, + nodes: @node_verbs, + edges: [:~>, :edge | @edge_verbs], + events: [:scenario], + modifiers: [:on, :label | @edge_verbs], + options: [ + :label, + :with, + :id, + :description, + :cluster, + :parent, + :fields, + :subdomain, + :owner, + :invariants, + :path | @edge_verbs + ] + } + end + + @doc """ + Compatibility alias for `taxonomy/0`. + """ + @spec verbs() :: map() + def verbs, do: taxonomy() + + @doc """ + Builds a `%Choreo.Domain{}` from a compact Lab DSL block. + """ + defmacro domain(do: block), do: compile(block) + defmacro domain(opts, do: block), do: compile(block, opts) + + defp compile(block, opts \\ []) do + {steps, _env} = + block + |> statements() + |> Enum.reduce({[], empty_env()}, fn statement, {steps, env} -> + {statement_steps, env} = statement_steps(statement, env) + {steps ++ statement_steps, env} + end) + + Enum.reduce(steps, quote(do: Choreo.Domain.new(unquote(Macro.escape(opts)))), &pipe_step/2) + end + + defp statements({:__block__, _meta, list}), do: list + defp statements(nil), do: [] + defp statements(single), do: [single] + + defp empty_env, do: %{nodes: %{}, clusters: %{}} + + defp statement_steps({:=, meta, [{var, _, context}, constructor]}, env) + when is_atom(var) and is_atom(context) do + cond do + cluster_constructor?(constructor) -> + cluster = cluster_from_constructor(constructor, var, env, meta) + {[{:cluster, cluster}], put_in(env.clusters[var], cluster.id)} + + node_constructor?(constructor) -> + node = node_from_constructor(constructor, var, env, meta) + {[{:node, node}], put_in(env.nodes[var], node.id)} + + true -> + raise ArgumentError, + "expected domain constructor, got #{Macro.to_string(constructor)}#{line_suffix(meta)}" + end + end + + defp statement_steps({:edge, meta, [edge_ast, label]}, env) when is_binary(label) do + {edge, nodes} = edge_from_ast(edge_ast, [label: label], env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({:edge, meta, [edge_ast, opts]}, env) when is_list(opts) do + {edge, nodes} = edge_from_ast(edge_ast, normalize_edge_opts(opts), env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({:edge, meta, [edge_ast]}, env) do + {edge, nodes} = edge_from_ast(edge_ast, [], env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({:scenario, meta, [name, opts]}, env) + when is_atom(name) and is_list(opts) do + scenario = scenario_from_opts(name, opts, env, meta) + {[{:scenario, scenario}], env} + end + + defp statement_steps({:scenario, meta, [name, label, opts]}, env) + when is_atom(name) and is_binary(label) and is_list(opts) do + scenario = scenario_from_opts(name, Keyword.put_new(opts, :label, label), env, meta) + {[{:scenario, scenario}], env} + end + + defp statement_steps({:|>, _meta, _args} = ast, env) do + {edge, nodes} = edge_from_piped_ast(ast, env) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({:~>, meta, _args} = ast, env) do + {edge, nodes} = edge_from_ast(ast, [], env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({name, meta, args} = ast, env) when is_atom(name) and is_list(args) do + cond do + name in @edge_verbs -> + typed_edge_statement(name, typed_edge_args!(name, args, meta), env, meta) + + name in @cluster_verbs -> + cluster = cluster_from_constructor(ast, nil, env, meta) + {[{:cluster, cluster}], env} + + Map.has_key?(@node_builders, name) -> + node = node_from_constructor(ast, nil, env, meta) + {[{:node, node}], env} + + true -> + unsupported_statement!(ast, meta) + end + end + + defp statement_steps(other, _env), do: unsupported_statement!(other, nil) + + defp typed_edge_args!(_name, [edge_ast, label, opts], _meta) + when is_binary(label) and is_list(opts), + do: {edge_ast, [label: label] ++ opts} + + defp typed_edge_args!(_name, [edge_ast, label], _meta) when is_binary(label), + do: {edge_ast, [label: label]} + + defp typed_edge_args!(_name, [edge_ast, opts], _meta) when is_list(opts), + do: {edge_ast, opts} + + defp typed_edge_args!(_name, [edge_ast], _meta), do: {edge_ast, []} + + defp typed_edge_args!(name, args, meta) do + raise ArgumentError, + "unsupported domain edge form `#{name}/#{length(args)}`#{line_suffix(meta)}; " <> + "use `#{name} from ~> to`, `#{name} from ~> to, label`, or `#{name} from ~> to, opts`" + end + + defp typed_edge_statement(name, {edge_ast, opts}, env, meta) do + opts = opts |> normalize_edge_opts() |> edge_type_opts(name) + {edge, nodes} = edge_from_ast(edge_ast, opts, env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + defp edge_declaration_steps(nodes, edge) do + nodes + |> Enum.reverse() + |> Enum.reduce([{:edge, edge}], fn node, steps -> [{:node, node} | steps] end) + end + + defp edge_from_piped_ast(ast, env) do + {base, modifiers} = unwrap_pipe(ast, []) + opts = modifiers |> Enum.reduce([], &modifier_opt/2) |> normalize_edge_opts() + edge_from_ast(base, opts, env, line_meta(base)) + end + + defp unwrap_pipe({:|>, _meta, [left, right]}, acc), do: unwrap_pipe(left, [right | acc]) + defp unwrap_pipe(base, acc), do: {base, acc} + + defp modifier_opt({name, _meta, [value]}, acc) when name in [:on, :label] do + Keyword.put(acc, :label, value) + end + + defp modifier_opt({name, _meta, []}, acc) when name in @edge_verbs do + edge_type_opts(acc, name) + end + + defp modifier_opt({name, _meta, [value]}, acc) when name in @edge_verbs do + acc + |> edge_type_opts(name) + |> Keyword.put_new(:label, value) + end + + defp modifier_opt(other, _acc) do + raise ArgumentError, + "unsupported domain edge modifier: #{Macro.to_string(other)}; " <> + "use `initiates(value)`, `handles(value)`, `emits(value)`, `triggers(value)`, or `projects_to(value)`" + end + + defp edge_from_ast({:~>, meta, [from_ast, to_ast]}, opts, env, _statement_meta) do + {from, to, declared_nodes} = domain_endpoints(from_ast, to_ast, env, meta) + {%{from: from, to: to, opts: normalize_edge_opts(opts)}, declared_nodes} + end + + defp edge_from_ast(other, _opts, _env, meta) do + raise ArgumentError, + "expected `from ~> to` in domain DSL, got #{Macro.to_string(other)}" <> + line_suffix(meta) + end + + defp domain_endpoints(from_ast, to_ast, env, meta) do + {from, from_node} = endpoint_id(from_ast, env, meta) + {to, to_node} = endpoint_id(to_ast, env, meta) + {from, to, declared_endpoint_nodes(from_node, to_node)} + end + + defp declared_endpoint_nodes(from_node, to_node) do + [from_node, to_node] + |> Enum.reject(&is_nil/1) + |> Enum.uniq_by(& &1.id) + end + + defp endpoint_id({var, _meta, context}, env, meta) when is_atom(var) and is_atom(context) do + case Map.fetch(env.nodes, var) do + {:ok, id} -> {id, nil} + :error -> raise ArgumentError, "unknown domain node variable `#{var}`#{line_suffix(meta)}" + end + end + + defp endpoint_id({name, meta, args} = constructor, env, _statement_meta) + when is_atom(name) and is_list(args) do + if Map.has_key?(@node_builders, name) do + node = node_from_constructor(constructor, nil, env, meta) + {node.id, node} + else + raise ArgumentError, "unknown domain node constructor `#{name}`#{line_suffix(meta)}" + end + end + + defp endpoint_id(other, _env, meta) do + raise ArgumentError, + "unsupported domain edge endpoint #{Macro.to_string(other)}#{line_suffix(meta)}; " <> + "bind a node first, e.g. `order = aggregate(\"Order\")`" + end + + defp node_from_constructor({name, meta, args}, var, env, _statement_meta) + when is_atom(name) and is_list(args) do + builder = + Map.get(@node_builders, name) || + raise ArgumentError, "unknown domain node constructor `#{name}`#{line_suffix(meta)}" + + {opts, positional} = pop_trailing_opts(args) + opts = resolve_cluster_option(opts, :cluster, env, meta) + {id, opts} = node_id_and_opts(var, positional, opts, meta) + %{id: id, builder: builder, opts: opts} + end + + defp cluster_from_constructor({name, meta, args}, var, env, _statement_meta) + when name in @cluster_verbs and is_list(args) do + {opts, positional} = pop_trailing_opts(args) + opts = resolve_cluster_option(opts, :parent, env, meta) + {id, opts} = cluster_id_and_opts(var, positional, opts, meta) + %{id: id, builder: :add_context_boundary, opts: opts} + end + + defp pop_trailing_opts(args) do + case List.last(args) do + last when is_list(last) -> + if Keyword.keyword?(last), do: {last, Enum.drop(args, -1)}, else: {[], args} + + _other -> + {[], args} + end + end + + defp node_id_and_opts(var, positional, opts, meta) do + {explicit_id, opts} = Keyword.pop(opts, :id) + + cond do + length(positional) > 1 -> + raise ArgumentError, + "domain node constructors take at most one positional label/id#{line_suffix(meta)}" + + explicit_id != nil -> + {explicit_id, maybe_put_label(opts, List.first(positional))} + + var != nil -> + {var, maybe_put_label(opts, List.first(positional))} + + positional != [] -> + label_or_id = List.first(positional) + {id_from_label(label_or_id), maybe_put_label(opts, label_or_id)} + + true -> + raise ArgumentError, + "inline domain node constructors need a label/id or `id:` option#{line_suffix(meta)}" + end + end + + defp cluster_id_and_opts(var, positional, opts, meta) do + {explicit_id, opts} = Keyword.pop(opts, :id) + + cond do + length(positional) > 1 -> + raise ArgumentError, + "domain cluster constructors take at most one positional label/id#{line_suffix(meta)}" + + explicit_id != nil -> + {to_string(explicit_id), maybe_put_label(opts, List.first(positional))} + + var != nil -> + {to_string(var), maybe_put_label(opts, List.first(positional))} + + positional != [] -> + label_or_id = List.first(positional) + {cluster_id_from_label(label_or_id), maybe_put_label(opts, label_or_id)} + + true -> + raise ArgumentError, + "inline domain cluster constructors need a label/id or `id:` option#{line_suffix(meta)}" + end + end + + defp maybe_put_label(opts, nil), do: opts + + defp maybe_put_label(opts, label) when is_binary(label), + do: Keyword.put_new(opts, :label, label) + + defp maybe_put_label(opts, label) when is_atom(label), + do: Keyword.put_new(opts, :label, to_string(label)) + + defp maybe_put_label(opts, _other), do: opts + + defp id_from_label(id) when is_atom(id), do: id + defp id_from_label(id) when is_binary(id), do: slug_atom(id) + + defp id_from_label(other) do + raise ArgumentError, + "inline domain node label/id must be a string or atom, got #{inspect(other)}" + end + + defp cluster_id_from_label(id) when is_atom(id), do: to_string(id) + defp cluster_id_from_label(id) when is_binary(id), do: id |> slug_atom() |> to_string() + + defp cluster_id_from_label(other) do + raise ArgumentError, + "inline domain cluster label/id must be a string or atom, got #{inspect(other)}" + end + + defp slug_atom(label) do + label + |> String.downcase() + |> String.replace(~r/[^a-z0-9]+/u, "_") + |> String.trim("_") + |> case do + "" -> raise ArgumentError, "cannot derive a domain node id from an empty label" + slug -> String.to_atom(slug) + end + end + + defp resolve_cluster_option(opts, key, env, meta) do + Keyword.update(opts, key, nil, &resolve_cluster_reference(&1, env, key, meta)) + |> Keyword.reject(fn {_key, value} -> is_nil(value) end) + end + + defp resolve_cluster_reference({var, _meta, context}, env, key, meta) + when is_atom(var) and is_atom(context) do + case Map.fetch(env.clusters, var) do + {:ok, id} -> + id + + :error -> + raise ArgumentError, + "unknown domain cluster variable `#{var}` in `#{key}:`#{line_suffix(meta)}" + end + end + + defp resolve_cluster_reference(value, _env, _key, _meta), do: value + + defp scenario_from_opts(name, opts, env, meta) do + path = + opts + |> Keyword.fetch!(:path) + |> Enum.map(&resolve_node_reference(&1, env, :path, meta)) + + %{name: name, opts: Keyword.put(opts, :path, path)} + end + + defp resolve_node_reference({var, _meta, context}, env, key, meta) + when is_atom(var) and is_atom(context) do + case Map.fetch(env.nodes, var) do + {:ok, id} -> + id + + :error -> + raise ArgumentError, + "unknown domain node variable `#{var}` in `#{key}:`#{line_suffix(meta)}" + end + end + + defp resolve_node_reference(value, _env, _key, _meta), do: value + + defp normalize_edge_opts(opts) do + opts + |> normalize_label_alias(:with) + |> normalize_edge_aliases() + end + + defp normalize_label_alias(opts, key) do + {value, opts} = Keyword.pop(opts, key) + if value == nil, do: opts, else: Keyword.put_new(opts, :label, value) + end + + defp normalize_edge_aliases(opts) do + Enum.reduce(@edge_verbs, opts, fn key, acc -> + {value, acc} = Keyword.pop(acc, key) + + if value == nil do + acc + else + acc |> edge_type_opts(key) |> Keyword.put_new(:label, value) + end + end) + end + + defp edge_type_opts(opts, name) when name in @domain_edge_verbs do + opts + |> Keyword.put(:builder, name) + |> Keyword.put(:type, :domain_relationship) + |> Keyword.put(:relationship, name) + end + + defp edge_type_opts(opts, name) when name in @context_edge_verbs do + opts + |> Keyword.put(:builder, :connect_contexts) + |> Keyword.put(:relationship, Map.fetch!(@context_relationships, name)) + end + + defp edge_type_opts(opts, :connects), do: Keyword.put(opts, :builder, :connect) + + defp cluster_constructor?({name, _meta, args}) when is_atom(name) and is_list(args), + do: name in @cluster_verbs + + defp cluster_constructor?(_other), do: false + + defp node_constructor?({name, _meta, args}) when is_atom(name) and is_list(args), + do: Map.has_key?(@node_builders, name) + + defp node_constructor?(_other), do: false + + defp pipe_step({:cluster, %{id: id, builder: builder, opts: opts}}, acc) do + quote do + apply(Choreo.Domain, unquote(builder), [ + unquote(acc), + unquote(Macro.escape(id)), + unquote(Macro.escape(opts)) + ]) + end + end + + defp pipe_step({:node, %{id: id, builder: builder, opts: opts}}, acc) do + quote do + apply(Choreo.Domain, unquote(builder), [ + unquote(acc), + unquote(Macro.escape(id)), + unquote(Macro.escape(opts)) + ]) + end + end + + defp pipe_step({:edge, %{from: from, to: to, opts: opts}}, acc) do + builder = Keyword.get(opts, :builder, :connect) + opts = Keyword.delete(opts, :builder) + + quote do + apply(Choreo.Domain, unquote(builder), [ + unquote(acc), + unquote(Macro.escape(from)), + unquote(Macro.escape(to)), + unquote(Macro.escape(opts)) + ]) + end + end + + defp pipe_step({:scenario, %{name: name, opts: opts}}, acc) do + quote do + Choreo.Domain.add_scenario( + unquote(acc), + unquote(Macro.escape(name)), + unquote(Macro.escape(opts)) + ) + end + end + + defp unsupported_statement!(ast, meta) do + raise ArgumentError, + "unsupported statement in domain DSL: #{Macro.to_string(ast)}#{line_suffix(meta)}" + end + + defp line_meta({_name, meta, _args}) when is_list(meta), do: meta + defp line_meta(_other), do: [] + + defp line_suffix(meta) when is_list(meta) do + case Keyword.get(meta, :line) do + nil -> "" + line -> " (line #{line})" + end + end + + defp line_suffix(_meta), do: "" +end diff --git a/lib/choreo/lab/dsl/requirement.ex b/lib/choreo/lab/dsl/requirement.ex new file mode 100644 index 0000000..ed4aa0d --- /dev/null +++ b/lib/choreo/lab/dsl/requirement.ex @@ -0,0 +1,513 @@ +defmodule Choreo.Lab.DSL.Requirement do + @moduledoc """ + Experimental Livebook-friendly DSL for sketching requirements traceability models. + + This Lab DSL compiles to the stable, pipe-first `Choreo.Requirement` builders and + returns an ordinary `%Choreo.Requirement{}`. It is useful for quickly connecting + requirements to stakeholders, implementation components, tests, and traceability + links in design notebooks. + + ## Examples + + iex> import Choreo.Lab.DSL.Requirement + ...> model = requirements "Auth v2" do + ...> security = stakeholder("Security Team") + ...> mfa = functional("Users must authenticate with MFA", id: "REQ-001", risk: :high) + ...> auth = component("Auth Service") + ...> mfa_test = test_case("MFA login test") + ...> + ...> security ~> mfa |> traces("owns") + ...> auth ~> mfa |> satisfies("implements") + ...> mfa_test ~> mfa |> verifies("proves") + ...> end + iex> model.name + "Auth v2" + iex> Enum.sort(Choreo.Requirement.requirements(model)) + [:mfa] + + Requirement constructors accept a text/label and can infer stable options for + quick sketches: + + mfa = requirement("Users must authenticate with MFA", id: "REQ-001") + perf = performance("p95 latency below 100ms", risk: :high) + + Edges can use generic, typed, or pipe-modified forms: + + auth ~> mfa |> satisfies("implements") + test ~> mfa |> verifies("covers") + child ~> parent |> refines("elaborates") + edge req_a ~> req_b, depends: "requires first" + contains parent ~> child, "breaks down" + """ + + @type node_decl :: %{id: Yog.node_id(), builder: atom(), opts: keyword()} + @type edge_decl :: %{from: Yog.node_id(), to: Yog.node_id(), opts: keyword(), builder: atom()} + + @requirement_verbs [ + :requirement, + :req, + :functional, + :interface_requirement, + :performance, + :physical, + :constraint, + :design_constraint + ] + + @other_node_verbs [ + :component, + :service, + :module, + :system, + :test_case, + :test, + :verification, + :stakeholder, + :owner, + :team, + :actor + ] + + @node_verbs @requirement_verbs ++ @other_node_verbs + + @node_builders %{ + requirement: :add_requirement, + req: :add_requirement, + functional: :add_requirement, + interface_requirement: :add_requirement, + performance: :add_requirement, + physical: :add_requirement, + constraint: :add_requirement, + design_constraint: :add_requirement, + component: :add_component, + service: :add_component, + module: :add_component, + system: :add_component, + test_case: :add_test, + test: :add_test, + verification: :add_test, + stakeholder: :add_stakeholder, + owner: :add_stakeholder, + team: :add_stakeholder, + actor: :add_stakeholder + } + + @requirement_kinds %{ + requirement: :requirement, + req: :requirement, + functional: :functional, + interface_requirement: :interface, + performance: :performance, + physical: :physical, + constraint: :design_constraint, + design_constraint: :design_constraint + } + + @edge_verbs [:satisfies, :verifies, :refines, :depends, :traces, :contains, :derives, :relates] + + @edge_builders %{ + satisfies: :satisfies, + verifies: :verifies, + refines: :refines, + depends: :depends, + traces: :traces, + contains: :contains, + derives: :derives, + relates: :relate + } + + @doc """ + Returns the vocabulary supported by the requirement DSL. + + iex> taxonomy = Choreo.Lab.DSL.Requirement.taxonomy() + iex> :functional in taxonomy.requirements + true + iex> :component in taxonomy.nodes + true + iex> :satisfies in taxonomy.edges + true + """ + @spec taxonomy() :: %{ + requirements: [atom()], + nodes: [atom()], + edges: [atom()], + modifiers: [atom()], + options: [atom()] + } + def taxonomy do + %{ + requirements: @requirement_verbs, + nodes: @node_verbs, + edges: [:~>, :edge | @edge_verbs], + modifiers: [:on, :label | @edge_verbs], + options: [ + :label, + :with, + :id, + :text, + :risk, + :verification, + :kind, + :type, + :docref | @edge_verbs + ] + } + end + + @doc """ + Compatibility alias for `taxonomy/0`. + """ + @spec verbs() :: map() + def verbs, do: taxonomy() + + @doc """ + Builds a `%Choreo.Requirement{}` from a compact Lab DSL block. + """ + defmacro requirements(do: block), do: compile(block) + defmacro requirements(name_or_opts, do: block), do: compile(block, name_or_opts) + + defp compile(block, name_or_opts \\ []) do + {steps, _env} = + block + |> statements() + |> Enum.reduce({[], %{}}, fn statement, {steps, env} -> + {statement_steps, env} = statement_steps(statement, env) + {steps ++ statement_steps, env} + end) + + Enum.reduce( + steps, + quote(do: Choreo.Requirement.new(unquote(Macro.escape(name_or_opts)))), + &pipe_step/2 + ) + end + + defp statements({:__block__, _meta, list}), do: list + defp statements(nil), do: [] + defp statements(single), do: [single] + + defp statement_steps({:=, meta, [{var, _, context}, constructor]}, env) + when is_atom(var) and is_atom(context) do + node = node_from_constructor(constructor, var, meta) + {[{:node, node}], Map.put(env, var, node.id)} + end + + defp statement_steps({:edge, meta, [edge_ast, label]}, env) when is_binary(label) do + {edge, nodes} = edge_from_ast(edge_ast, [label: label], env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({:edge, meta, [edge_ast, opts]}, env) when is_list(opts) do + {edge, nodes} = edge_from_ast(edge_ast, normalize_edge_opts(opts), env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({:edge, meta, [edge_ast]}, env) do + {edge, nodes} = edge_from_ast(edge_ast, [], env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({:|>, _meta, _args} = ast, env) do + {edge, nodes} = edge_from_piped_ast(ast, env) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({:~>, meta, _args} = ast, env) do + {edge, nodes} = edge_from_ast(ast, [], env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + defp statement_steps({name, meta, args} = ast, env) when is_atom(name) and is_list(args) do + cond do + name in @edge_verbs -> + typed_edge_statement(name, typed_edge_args!(name, args, meta), env, meta) + + Map.has_key?(@node_builders, name) -> + node = node_from_constructor(ast, nil, meta) + {[{:node, node}], env} + + true -> + unsupported_statement!(ast, meta) + end + end + + defp statement_steps(other, _env), do: unsupported_statement!(other, nil) + + defp typed_edge_args!(_name, [edge_ast, label, opts], _meta) + when is_binary(label) and is_list(opts), + do: {edge_ast, [label: label] ++ opts} + + defp typed_edge_args!(_name, [edge_ast, label], _meta) when is_binary(label), + do: {edge_ast, [label: label]} + + defp typed_edge_args!(_name, [edge_ast, opts], _meta) when is_list(opts), + do: {edge_ast, opts} + + defp typed_edge_args!(_name, [edge_ast], _meta), do: {edge_ast, []} + + defp typed_edge_args!(name, args, meta) do + raise ArgumentError, + "unsupported requirement edge form `#{name}/#{length(args)}`#{line_suffix(meta)}; " <> + "use `#{name} from ~> to`, `#{name} from ~> to, label`, or `#{name} from ~> to, opts`" + end + + defp typed_edge_statement(name, {edge_ast, opts}, env, meta) do + opts = opts |> normalize_edge_opts() |> edge_type_opts(name) + {edge, nodes} = edge_from_ast(edge_ast, opts, env, meta) + {edge_declaration_steps(nodes, edge), env} + end + + defp edge_declaration_steps(nodes, edge) do + nodes + |> Enum.reduce([{:edge, edge}], fn node, steps -> [{:node, node} | steps] end) + |> Enum.reverse() + end + + defp edge_from_piped_ast(ast, env) do + {base, modifiers} = unwrap_pipe(ast, []) + opts = modifiers |> Enum.reduce([], &modifier_opt/2) |> normalize_edge_opts() + edge_from_ast(base, opts, env, line_meta(base)) + end + + defp unwrap_pipe({:|>, _meta, [left, right]}, acc), do: unwrap_pipe(left, [right | acc]) + defp unwrap_pipe(base, acc), do: {base, acc} + + defp modifier_opt({name, _meta, [value]}, acc) when name in [:on, :label] do + Keyword.put(acc, :label, value) + end + + defp modifier_opt({name, _meta, []}, acc) when name in @edge_verbs do + edge_type_opts(acc, name) + end + + defp modifier_opt({name, _meta, [value]}, acc) when name in @edge_verbs do + acc + |> edge_type_opts(name) + |> Keyword.put_new(:label, value) + end + + defp modifier_opt(other, _acc) do + raise ArgumentError, + "unsupported requirement edge modifier: #{Macro.to_string(other)}; " <> + "use `satisfies(value)`, `verifies(value)`, `refines(value)`, or `traces(value)`" + end + + defp edge_from_ast({:~>, meta, [from_ast, to_ast]}, opts, env, _statement_meta) do + {from, to, declared_nodes} = requirement_endpoints(from_ast, to_ast, env, meta) + {%{from: from, to: to, opts: normalize_edge_opts(opts)}, declared_nodes} + end + + defp edge_from_ast(other, _opts, _env, meta) do + raise ArgumentError, + "expected `from ~> to` in requirement DSL, got #{Macro.to_string(other)}" <> + line_suffix(meta) + end + + defp requirement_endpoints(from_ast, to_ast, env, meta) do + {from, from_node} = endpoint_id(from_ast, env, meta) + {to, to_node} = endpoint_id(to_ast, env, meta) + {from, to, declared_endpoint_nodes(from_node, to_node)} + end + + defp declared_endpoint_nodes(from_node, to_node) do + [from_node, to_node] + |> Enum.reject(&is_nil/1) + |> Enum.uniq_by(& &1.id) + end + + defp endpoint_id({var, _meta, context}, env, meta) when is_atom(var) and is_atom(context) do + case Map.fetch(env, var) do + {:ok, id} -> + {id, nil} + + :error -> + raise ArgumentError, "unknown requirement node variable `#{var}`#{line_suffix(meta)}" + end + end + + defp endpoint_id({name, meta, args} = constructor, _env, _statement_meta) + when is_atom(name) and is_list(args) do + if Map.has_key?(@node_builders, name) do + node = node_from_constructor(constructor, nil, meta) + {node.id, node} + else + raise ArgumentError, "unknown requirement node constructor `#{name}`#{line_suffix(meta)}" + end + end + + defp endpoint_id(other, _env, meta) do + raise ArgumentError, + "unsupported requirement edge endpoint #{Macro.to_string(other)}#{line_suffix(meta)}; " <> + "bind a node first, e.g. `mfa = requirement(\"MFA\")`" + end + + defp node_from_constructor({name, meta, args}, var, _statement_meta) + when is_atom(name) and is_list(args) do + builder = + Map.get(@node_builders, name) || + raise ArgumentError, "unknown requirement node constructor `#{name}`#{line_suffix(meta)}" + + {opts, positional} = pop_trailing_opts(args) + {id, opts} = node_id_and_opts(var, positional, opts, meta) + opts = normalize_node_opts(name, id, positional, opts) + %{id: id, builder: builder, opts: opts} + end + + defp pop_trailing_opts(args) do + case List.last(args) do + last when is_list(last) -> + if Keyword.keyword?(last), do: {last, Enum.drop(args, -1)}, else: {[], args} + + _other -> + {[], args} + end + end + + defp node_id_and_opts(var, positional, opts, meta) do + {explicit_id, opts} = Keyword.pop(opts, :node_id) + {explicit_node_id, opts} = Keyword.pop(opts, :node) + node_id = explicit_node_id || explicit_id + + cond do + length(positional) > 1 -> + raise ArgumentError, + "requirement node constructors take at most one positional label/text#{line_suffix(meta)}" + + node_id != nil -> + {node_id, opts} + + var != nil -> + {var, opts} + + positional != [] -> + {id_from_label(List.first(positional)), opts} + + true -> + raise ArgumentError, + "inline requirement node constructors need text/label, `node:`, or `node_id:`#{line_suffix(meta)}" + end + end + + defp normalize_node_opts(name, node_id, positional, opts) when name in @requirement_verbs do + text = Keyword.get(opts, :text) || text_from_positional(positional) || to_string(node_id) + human_id = Keyword.get(opts, :id) || human_id_from(node_id, text) + + opts + |> Keyword.put(:id, human_id) + |> Keyword.put(:text, text) + |> Keyword.put_new(:kind, Map.fetch!(@requirement_kinds, name)) + end + + defp normalize_node_opts(_name, node_id, positional, opts) do + opts + |> maybe_put_label(text_from_positional(positional) || Keyword.get(opts, :label) || node_id) + end + + defp text_from_positional([value]) when is_binary(value), do: value + defp text_from_positional([value]) when is_atom(value), do: to_string(value) + defp text_from_positional(_other), do: nil + + defp human_id_from(node_id, _text) when is_atom(node_id), + do: node_id |> to_string() |> String.upcase() + + defp human_id_from(node_id, _text) when is_binary(node_id), do: node_id + defp human_id_from(_node_id, text), do: text + + defp maybe_put_label(opts, nil), do: opts + + defp maybe_put_label(opts, label) when is_binary(label), + do: Keyword.put_new(opts, :label, label) + + defp maybe_put_label(opts, label) when is_atom(label), + do: Keyword.put_new(opts, :label, to_string(label)) + + defp maybe_put_label(opts, _other), do: opts + + defp id_from_label(id) when is_atom(id), do: id + defp id_from_label(id) when is_binary(id), do: slug_atom(id) + + defp id_from_label(other) do + raise ArgumentError, + "inline requirement node text/label must be a string or atom, got #{inspect(other)}" + end + + defp slug_atom(label) do + label + |> String.downcase() + |> String.replace(~r/[^a-z0-9]+/u, "_") + |> String.trim("_") + |> case do + "" -> raise ArgumentError, "cannot derive a requirement node id from an empty label" + slug -> String.to_atom(slug) + end + end + + defp normalize_edge_opts(opts) do + opts + |> normalize_label_alias(:with) + |> normalize_edge_aliases() + end + + defp normalize_label_alias(opts, key) do + {value, opts} = Keyword.pop(opts, key) + if value == nil, do: opts, else: Keyword.put_new(opts, :label, value) + end + + defp normalize_edge_aliases(opts) do + Enum.reduce(@edge_verbs, opts, fn key, acc -> + {value, acc} = Keyword.pop(acc, key) + + if value == nil do + acc + else + acc |> edge_type_opts(key) |> Keyword.put_new(:label, value) + end + end) + end + + defp edge_type_opts(opts, name) do + type = if name == :relates, do: :traces, else: name + Keyword.put(opts, :type, type) + end + + defp pipe_step({:node, %{id: id, builder: builder, opts: opts}}, acc) do + quote do + apply(Choreo.Requirement, unquote(builder), [ + unquote(acc), + unquote(Macro.escape(id)), + unquote(Macro.escape(opts)) + ]) + end + end + + defp pipe_step({:edge, %{from: from, to: to, opts: opts}}, acc) do + builder = Map.fetch!(@edge_builders, Keyword.get(opts, :type, :traces)) + opts = Keyword.delete(opts, :type) + + quote do + apply(Choreo.Requirement, unquote(builder), [ + unquote(acc), + unquote(Macro.escape(from)), + unquote(Macro.escape(to)), + unquote(Macro.escape(opts)) + ]) + end + end + + defp unsupported_statement!(ast, meta) do + raise ArgumentError, + "unsupported statement in requirement DSL: #{Macro.to_string(ast)}#{line_suffix(meta)}" + end + + defp line_meta({_name, meta, _args}) when is_list(meta), do: meta + defp line_meta(_other), do: [] + + defp line_suffix(meta) when is_list(meta) do + case Keyword.get(meta, :line) do + nil -> "" + line -> " (line #{line})" + end + end + + defp line_suffix(_meta), do: "" +end diff --git a/test/choreo/lab/dsl/dependency_test.exs b/test/choreo/lab/dsl/dependency_test.exs new file mode 100644 index 0000000..e18b3c3 --- /dev/null +++ b/test/choreo/lab/dsl/dependency_test.exs @@ -0,0 +1,153 @@ +defmodule Choreo.Lab.DependencyDSLTest do + use ExUnit.Case + + doctest Choreo.Lab.DSL.Dependency + + import Choreo.Lab.DSL.Dependency + + alias Choreo.Dependency + + test "taxonomy returns the Livebook discovery vocabulary" do + taxonomy = Choreo.Lab.DSL.Dependency.taxonomy() + + assert :application in taxonomy.nodes + assert :library in taxonomy.nodes + assert :module in taxonomy.nodes + assert :cluster in taxonomy.clusters + assert :uses in taxonomy.edges + assert :calls in taxonomy.modifiers + assert :with in taxonomy.options + assert Choreo.Lab.DSL.Dependency.verbs() == taxonomy + end + + test "builds a dependency graph with variable-bound clusters, nodes, and edges" do + deps = + dependency do + core = cluster("Core") + api = application("API Gateway") + auth = module("Auth", cluster: core) + contract = interface("Auth Behaviour") + phoenix = library("Phoenix") + + api ~> phoenix |> uses("HTTP stack") + api ~> auth |> calls("validates token") + auth ~> contract |> implements("callbacks") + end + + assert Enum.sort(Dependency.nodes(deps)) == [:api, :auth, :contract, :phoenix] + assert deps.clusters["cluster_core"].label == "Core" + assert Map.get(deps.graph.nodes, :auth).cluster == "cluster_core" + assert Map.get(deps.graph.nodes, :api).node_type == :application + assert Map.get(deps.graph.nodes, :phoenix).node_type == :library + assert Map.get(deps.graph.nodes, :contract).node_type == :interface + + edge_types = + Enum.map(Dependency.edges_with_meta(deps), fn {_from, _to, _weight, meta} -> meta.type end) + + assert :uses in edge_types + assert :calls in edge_types + assert :inherits in edge_types + end + + test "supports inline constructors for one-off sketches" do + deps = + dependency do + application("API") ~> library("Phoenix") |> uses("framework") + end + + assert :api in Dependency.nodes(deps) + assert :phoenix in Dependency.nodes(deps) + + assert [{:api, :phoenix, _weight, meta}] = Dependency.edges_with_meta(deps) + assert meta.type == :uses + assert meta.label == "framework" + end + + test "supports id option while keeping display label" do + deps = + dependency do + api = app("Public API", id: :api) + auth = component("Auth Module", id: :auth) + + edge api ~> auth, "uses auth" + end + + assert Map.get(deps.graph.nodes, :api).label == "Public API" + assert Map.get(deps.graph.nodes, :auth).label == "Auth Module" + assert [{:api, :auth, _weight, meta}] = Dependency.edges_with_meta(deps) + assert meta.label == "uses auth" + assert meta.type == :uses + end + + test "supports typed edge aliases and keyword edge forms" do + deps = + dependency do + web = application("Web") + api = service("API") + auth = module("Auth") + auth_test = test_suite("Auth Test") + mox = package("Mox") + + imports(web ~> api, "client") + edge api ~> auth, calls: "authenticate" + dev(auth_test ~> mox, "mock dependency") + depends_on(auth_test ~> auth, "exercises") + end + + edge_meta = Dependency.edges_with_meta(deps) + edge_types = Enum.map(edge_meta, fn {_from, _to, _weight, meta} -> meta.type end) + labels = Enum.map(edge_meta, fn {_from, _to, _weight, meta} -> meta.label end) + + assert :imports in edge_types + assert :calls in edge_types + assert :dev in edge_types + assert :uses in edge_types + assert "authenticate" in labels + assert "mock dependency" in labels + end + + test "supports cluster nesting and aliases" do + deps = + dependency do + backend = layer("Backend") + core = group("Core", parent: backend) + auth = module("Auth", cluster: core) + + module("Repo", cluster: core) ~> auth |> uses("domain API") + end + + assert Map.has_key?(deps.clusters, "cluster_backend") + assert deps.clusters["cluster_core"].parent == "backend" + assert Map.get(deps.graph.nodes, :auth).cluster == "cluster_core" + assert :repo in Dependency.nodes(deps) + end + + test "raises on unknown node variables" do + assert_raise ArgumentError, ~r/unknown dependency node variable `repo`/, fn -> + Code.eval_quoted( + quote do + import Choreo.Lab.DSL.Dependency + + dependency do + service = module("Service") + service ~> repo + end + end + ) + end + end + + test "raises on unknown cluster variables" do + assert_raise ArgumentError, ~r/unknown dependency cluster variable `core`/, fn -> + Code.eval_quoted( + quote do + import Choreo.Lab.DSL.Dependency + + dependency do + module("Auth", cluster: core) + end + end + ) + end + end +end diff --git a/test/choreo/lab/dsl/domain_test.exs b/test/choreo/lab/dsl/domain_test.exs new file mode 100644 index 0000000..5857d95 --- /dev/null +++ b/test/choreo/lab/dsl/domain_test.exs @@ -0,0 +1,182 @@ +defmodule Choreo.Lab.DomainDSLTest do + use ExUnit.Case + + doctest Choreo.Lab.DSL.Domain + + import Choreo.Lab.DSL.Domain + + alias Choreo.Domain + alias Choreo.Domain.Analysis + + test "taxonomy returns the Livebook discovery vocabulary" do + taxonomy = Choreo.Lab.DSL.Domain.taxonomy() + + assert :aggregate in taxonomy.nodes + assert :context in taxonomy.nodes + assert :context_boundary in taxonomy.clusters + assert :emits in taxonomy.edges + assert :scenario in taxonomy.events + assert :with in taxonomy.options + assert Choreo.Lab.DSL.Domain.verbs() == taxonomy + end + + test "builds a tactical event-storming model with variable-bound nodes" do + model = + domain do + checkout = context_boundary("Checkout") + customer = actor("Customer") + place_order = command("Place Order", cluster: checkout) + + order = + aggregate("Order", cluster: checkout, invariants: ["Cannot place an empty order."]) + + placed = event("Order Placed", cluster: checkout) + summary = read_model("Order Summary", cluster: checkout) + + customer ~> place_order |> initiates("starts") + place_order ~> order |> handles("validates") + order ~> placed |> emits("records") + placed ~> summary |> projects_to("updates") + end + + assert model.clusters["cluster_checkout"].label == "Checkout" + assert Domain.nodes(model).order.type == :aggregate + assert Domain.nodes(model).order.cluster == "cluster_checkout" + assert Domain.nodes(model).summary.type == :read_model + assert [] = Analysis.validate(model) + + edge_meta = Map.values(model.edge_meta) + assert Enum.any?(edge_meta, &(&1.relationship == :initiates and &1.label == "starts")) + assert Enum.any?(edge_meta, &(&1.relationship == :projects_to and &1.label == "updates")) + end + + test "builds strategic context maps with context relationships" do + model = + domain do + ordering = context("Ordering", subdomain: :core, owner: "Checkout Team") + billing = bounded_context("Billing", subdomain: :supporting) + shipping = context("Shipping", subdomain: :supporting) + + customer_supplier(ordering ~> billing, "Invoice requests") + anti_corruption(billing ~> shipping, "Shipment adapter") + end + + assert Domain.nodes(model).ordering.type == :context + assert Domain.nodes(model).ordering.subdomain == :core + + relationships = Enum.map(Map.values(model.edge_meta), & &1.relationship) + assert :customer_supplier in relationships + assert :acl in relationships + + labels = Enum.map(Map.values(model.edge_meta), & &1.label) + assert Enum.any?(labels, &String.contains?(&1, "Invoice requests")) + assert Enum.any?(labels, &String.contains?(&1, "Shipment adapter")) + end + + test "supports inline constructors for one-off sketches" do + model = + domain do + actor("Customer") ~> command("Place Order") |> initiates("submits") + end + + assert Map.has_key?(Domain.nodes(model), :customer) + assert Map.has_key?(Domain.nodes(model), :place_order) + assert [{:customer, :place_order, _weight}] = Domain.edges(model) + assert [%{relationship: :initiates, label: "submits"}] = Map.values(model.edge_meta) + end + + test "supports id options, type fields, and generic edges" do + model = + domain do + order = aggregate("Order Aggregate", id: :order, fields: [{:id, :uuid}]) + line = type("Order Line", id: :order_line, fields: [{:product_id, :string}]) + + edge order ~> line, "has lines" + end + + assert Domain.nodes(model).order.name == "Order Aggregate" + assert Domain.nodes(model).order_line.fields == [{:product_id, :string}] + assert [{:order, :order_line, _weight}] = Domain.edges(model) + assert [%{label: "has lines", type: :sequence}] = Map.values(model.edge_meta) + end + + test "supports named scenarios with variable-bound paths" do + model = + domain do + customer = actor("Customer") + place_order = command("Place Order") + order = aggregate("Order", invariants: ["Cannot place an empty order."]) + placed = domain_event("Order Placed") + summary = projection("Order Summary") + + customer ~> place_order |> initiates("starts") + place_order ~> order |> handles("validates") + order ~> placed |> emits("records") + placed ~> summary |> projects_to("updates") + + scenario(:happy_path, "Happy path", path: [customer, place_order, order, placed, summary]) + end + + assert Domain.scenario(model, :happy_path).label == "Happy path" + + assert Domain.scenario(model, :happy_path).path == [ + :customer, + :place_order, + :order, + :placed, + :summary + ] + + focused = Domain.focus_scenario(model, :happy_path) + assert focused.highlighted_nodes == [:customer, :place_order, :order, :placed, :summary] + end + + test "supports typed edge keyword forms" do + model = + domain do + order = aggregate("Order", invariants: ["Cannot place an empty order."]) + placed = event("Order Placed") + policy = policy("Payment Policy") + authorize = command("Authorize Payment") + customer = user("Customer") + + edge order ~> placed, emits: "records" + edge placed ~> policy, triggers: "reacts" + edge policy ~> authorize, triggers: "dispatches" + edge placed ~> customer, notifies: "email" + end + + edge_meta = Map.values(model.edge_meta) + assert Enum.any?(edge_meta, &(&1.relationship == :emits and &1.label == "records")) + assert Enum.any?(edge_meta, &(&1.relationship == :notifies and &1.label == "email")) + end + + test "raises on unknown node variables" do + assert_raise ArgumentError, ~r/unknown domain node variable `missing`/, fn -> + Code.eval_quoted( + quote do + import Choreo.Lab.DSL.Domain + + domain do + order = aggregate("Order") + order ~> missing + end + end + ) + end + end + + test "raises on unknown cluster variables" do + assert_raise ArgumentError, ~r/unknown domain cluster variable `checkout`/, fn -> + Code.eval_quoted( + quote do + import Choreo.Lab.DSL.Domain + + domain do + command("Place Order", cluster: checkout) + end + end + ) + end + end +end diff --git a/test/choreo/lab/dsl/requirement_test.exs b/test/choreo/lab/dsl/requirement_test.exs new file mode 100644 index 0000000..e7ed3ec --- /dev/null +++ b/test/choreo/lab/dsl/requirement_test.exs @@ -0,0 +1,134 @@ +defmodule Choreo.Lab.RequirementDSLTest do + use ExUnit.Case + + doctest Choreo.Lab.DSL.Requirement + + import Choreo.Lab.DSL.Requirement + + alias Choreo.Requirement + + test "taxonomy returns the Livebook discovery vocabulary" do + taxonomy = Choreo.Lab.DSL.Requirement.taxonomy() + + assert :functional in taxonomy.requirements + assert :component in taxonomy.nodes + assert :test_case in taxonomy.nodes + assert :stakeholder in taxonomy.nodes + assert :satisfies in taxonomy.edges + assert :verifies in taxonomy.modifiers + assert :with in taxonomy.options + assert Choreo.Lab.DSL.Requirement.verbs() == taxonomy + end + + test "builds a requirements model with variable-bound nodes and traceability edges" do + model = + requirements "Auth v2" do + security = stakeholder("Security Team") + mfa = functional("Users must authenticate with MFA", id: "REQ-001", risk: :high) + latency = performance("p95 login latency below 100ms", verification: :analysis) + auth = component("Auth Service", type: "service") + mfa_test = test_case("MFA login test", type: "integration") + + security ~> mfa |> traces("owns") + auth ~> mfa |> satisfies("implements") + mfa_test ~> mfa |> verifies("proves") + latency ~> mfa |> depends("after MFA") + end + + assert model.name == "Auth v2" + assert Requirement.requirements(model) |> Enum.sort() == [:latency, :mfa] + assert Requirement.components(model) == [:auth] + assert Requirement.tests(model) == [:mfa_test] + assert Requirement.stakeholders(model) == [:security] + + mfa = Requirement.node(model, :mfa) + assert mfa.id == "REQ-001" + assert mfa.text == "Users must authenticate with MFA" + assert mfa.kind == :functional + assert mfa.risk == :high + + latency = Requirement.node(model, :latency) + assert latency.id == "LATENCY" + assert latency.kind == :performance + assert latency.verification == :analysis + + edge_types = + Enum.map(Requirement.edges_with_meta(model), fn {_from, _to, _weight, meta} -> meta.type end) + + assert :traces in edge_types + assert :satisfies in edge_types + assert :verifies in edge_types + assert :depends in edge_types + end + + test "supports inline constructors for one-off sketches" do + model = + requirements do + component("Auth") ~> requirement("MFA", id: "REQ-001") |> satisfies("implements") + end + + assert :auth in Requirement.components(model) + assert :mfa in Requirement.requirements(model) + assert Requirement.node(model, :mfa).text == "MFA" + assert [{:auth, :mfa, _weight, meta}] = Requirement.edges_with_meta(model) + assert meta.type == :satisfies + assert meta.label == "implements" + end + + test "supports node_id option while keeping human requirement id" do + model = + requirements do + auth_req = req("Authenticate users", node_id: :authn, id: "REQ-AUTH-001") + api = service("API") + + edge api ~> auth_req, satisfies: "implements" + end + + assert :authn in Requirement.requirements(model) + assert Requirement.node(model, :authn).id == "REQ-AUTH-001" + assert Requirement.node(model, :authn).text == "Authenticate users" + assert [{:api, :authn, _weight, meta}] = Requirement.edges_with_meta(model) + assert meta.type == :satisfies + end + + test "supports typed edge statements and aliases" do + model = + requirements do + parent = requirement("Authentication", id: "REQ-AUTH") + child = design_constraint("Use OAuth2", id: "REQ-OAUTH") + source = owner("Product") + test = verification("OAuth conformance test") + + contains(parent ~> child, "breakdown") + derives(child ~> source, "derived from") + verifies(test ~> child, "covers") + relates source ~> parent, "requests" + end + + edge_meta = Requirement.edges_with_meta(model) + edge_types = Enum.map(edge_meta, fn {_from, _to, _weight, meta} -> meta.type end) + labels = Enum.map(edge_meta, fn {_from, _to, _weight, meta} -> meta.label end) + + assert :contains in edge_types + assert :derives in edge_types + assert :verifies in edge_types + assert :traces in edge_types + assert "breakdown" in labels + assert "requests" in labels + end + + test "raises on unknown node variables" do + assert_raise ArgumentError, ~r/unknown requirement node variable `missing`/, fn -> + Code.eval_quoted( + quote do + import Choreo.Lab.DSL.Requirement + + requirements do + req = requirement("MFA", id: "REQ-001") + req ~> missing + end + end + ) + end + end +end