@reventlessdev/reventless-core 3.0.0-alpha.241 → 3.0.0-alpha.242

package/CHANGELOG.md

@@ -3,6 +3,13 @@
 All notable changes to this project will be documented in this file.
 See [Conventional Commits](https://conventionalcommits.org) for commit guidelines.
 
+# 3.0.0-alpha.242 (2026-08-20)
+
+### Features
+
+* **api:** emit a tagged-union state field as a GraphQL union ([3a380c0](https://github.com/ReventlessDev/reventless-core/commit/3a380c0ab055b87048d90a852ec1664f6aab6b00))
+
+
 # 3.0.0-alpha.241 (2026-08-19)
 
 ### Bug Fixes

package/package.json

@@ -1,6 +1,6 @@
 {
   "name": "@reventlessdev/reventless-core",
-  "version": "3.0.0-alpha.241",
+  "version": "3.0.0-alpha.242",
   "description": "Core package for Reventless framework",
   "license": "Apache-2.0",
   "jest": {
@@ -31,19 +31,19 @@
     "@reventlessdev/rescript-effect": "0.1.0-alpha.32",
     "@reventlessdev/rescript-fast-csv": "2.0.0-alpha.8",
     "@reventlessdev/rescript-jest": "1.0.0-alpha.10",
-    "@reventlessdev/rescript-hash-object": "1.2.0-alpha.14",
     "@reventlessdev/rescript-node": "2.0.0-alpha.8",
+    "@reventlessdev/rescript-hash-object": "1.2.0-alpha.14",
     "@reventlessdev/rescript-pulumi-pulumi": "2.3.0-alpha.19",
     "@reventlessdev/rescript-ssh2": "2.0.0-alpha.8",
-    "@reventlessdev/reventless-infra": "3.0.0-alpha.146",
     "@reventlessdev/rescript-uuid": "2.0.0-alpha.0",
-    "@reventlessdev/reventless-spec": "3.0.0-alpha.118",
-    "@reventlessdev/reventless-interop": "3.0.0-alpha.32"
+    "@reventlessdev/reventless-interop": "3.0.0-alpha.32",
+    "@reventlessdev/reventless-infra": "3.0.0-alpha.147",
+    "@reventlessdev/reventless-spec": "3.0.0-alpha.119"
   },
   "devDependencies": {
     "rescript": "12.3.0",
     "sury-ppx": "11.0.0-rc.1",
-    "@reventlessdev/reventless-ppx": "1.0.0-alpha.71"
+    "@reventlessdev/reventless-ppx": "1.0.0-alpha.72"
   },
   "peerDependencies": {
     "rescript": "12.3.0"

package/src/components/Api/GraphQL_FragmentGenerator.res

@@ -4,6 +4,8 @@
 
 open ReventlessInfra.Api
 
+let log = Logger.fromEnv()
+
 // Every aggregate-derived mutation returns the CommandResult union — the
 // shape carries the outcome from CommandTopic processing (Accepted / Rejected
 // for sync slices, Pending for async). Consumers select sub-fields via inline
@@ -85,6 +87,37 @@ let rec fromSchemaType = (
   // reaches the UI through the field's JSON Schema, which is the channel that
   // can express it.
   | Semantic(_, inner) => fromSchemaType(~required, ~asInput, inner, collectedTypes, seenTypes)
+  // A union declares one object type per arm and a `union` naming them. Both
+  // names come from the schema — see `Reventless.TaggedUnion` — so the same union
+  // is the same type wherever it appears, which is what lets AppSync merge each
+  // source API's copy back into one, and what lets the write path stamp a
+  // `__typename` the SDL will recognise.
+  | TaggedUnion(name, arms) =>
+    if asInput {
+      // GraphQL has no input unions. A command that wants one takes its arms as
+      // separate mutations, which is what the command decomposition already
+      // does. Emitting the union type here would produce an SDL AppSync rejects
+      // outright, so the field keeps the `String` it renders as today — said out
+      // loud, because it is not what the declaration asks for.
+      log.warn(
+        ~comp="GraphQL_FragmentGenerator",
+        `union "${name}" is used in an input position; GraphQL has no input unions, so the field is emitted as String. Take the arms as separate mutations instead.`,
+      )
+      `String${bang}`
+    } else {
+      if !(seenTypes->Set.has(name)) {
+        seenTypes->Set.add(name)
+        // The member types are collected by the recursion, which emits each arm
+        // as the object type it is. `~required=false` only so the reference comes
+        // back without a `!` — a union's member list carries no nullability.
+        let memberNames =
+          arms->Array.map(((_, armType)) =>
+            fromSchemaType(~required=false, ~asInput, armType, collectedTypes, seenTypes)
+          )
+        collectedTypes->Array.push(`union ${name} = ${memberNames->Array.join(" | ")}`)
+      }
+      `${name}${bang}`
+    }
   | Unknown => `String${bang}`
   }
 }
@@ -124,12 +157,26 @@ let deriveFieldType = (
 
 // ── Object type derivation ─────────────────────────────────────────────────
 
+// A union field the walk cannot classify is emitted as `String`, and that has
+// been true and silent for as long as the fallthrough has existed. Saying it here
+// — at the one point every generated object type is derived — costs a walk of the
+// schema and turns a field that will fail at execution into a line in the deploy
+// log naming the type and the field.
+let reportUnclassifiedUnions = (~typeName: string, schema: S.t<unknown>): unit =>
+  SchemaType.unclassifiedUnions(schema)->Array.forEach(({path, reason}) =>
+    log.warn(
+      ~comp="GraphQL_FragmentGenerator",
+      `${typeName}.${path} is emitted as String: ${reason}`,
+    )
+  )
+
 let deriveObjectTypeWithNested = (
   ~typeName: string,
   ~excludeFields: array<string>=[],
   ~includeIdParam: bool=true,
   schema: S.t<unknown>,
-): array<string> =>
+): array<string> => {
+  reportUnclassifiedUnions(~typeName, schema)
   switch SchemaType.fromSuryObject(~typeName, schema) {
   | Some(fields) =>
     // `@internal` joins the caller's exclusions rather than replacing them. The
@@ -175,6 +222,7 @@ let deriveObjectTypeWithNested = (
     Array.concat(collectedTypes, [mainTypeWithId])
   | None => []
   }
+}
 
 let derivePluralWrapperType = (~pluralTypeName: string, ~singularTypeName: string): string =>
   `type ${pluralTypeName} {\n  nextToken: String\n  scannedCount: Int!\n  items: [${singularTypeName}!]!\n}`

package/src/components/Api/GraphQL_FragmentGenerator.res.mjs

@@ -3,12 +3,15 @@
 import * as Stdlib_Array from "@rescript/runtime/lib/es6/Stdlib_Array.js";
 import * as Stdlib_Option from "@rescript/runtime/lib/es6/Stdlib_Option.js";
 import * as Stdlib_String from "@rescript/runtime/lib/es6/Stdlib_String.js";
+import * as Logger$ReventlessCore from "../../util/Logger.res.mjs";
 import * as Api_Naming$ReventlessCore from "./Api_Naming.res.mjs";
 import * as SchemaType$ReventlessCore from "./SchemaType.res.mjs";
 import * as SchemaWalker$ReventlessCore from "../../plugin/component/SchemaWalker.res.mjs";
 import * as StateAnnotations$Reventless from "@reventlessdev/reventless-spec/src/components/StateAnnotations.res.mjs";
 import * as GraphQL_Stitcher$ReventlessCore from "./GraphQL_Stitcher.res.mjs";
 
+let log = Logger$ReventlessCore.fromEnv();
+
 let commandResultSdlTypes = [
   `union CommandResult = CommandAccepted | CommandRejected | CommandPending`,
   `type CommandAccepted {
@@ -90,6 +93,18 @@ function fromSchemaType(_required, _asInputOpt, _st, collectedTypes, seenTypes)
           _st = inner;
           _asInputOpt = asInput;
           continue;
+        case "TaggedUnion" :
+          let name$3 = st._0;
+          if (asInput) {
+            log.warn("GraphQL_FragmentGenerator", undefined, `union "` + name$3 + `" is used in an input position; GraphQL has no input unions, so the field is emitted as String. Take the arms as separate mutations instead.`);
+            return `String` + bang;
+          }
+          if (!seenTypes.has(name$3)) {
+            seenTypes.add(name$3);
+            let memberNames = st._1.map(param => fromSchemaType(false, asInput, param[1], collectedTypes, seenTypes));
+            collectedTypes.push(`union ` + name$3 + ` = ` + memberNames.join(" | "));
+          }
+          return name$3 + bang;
       }
     }
   };
@@ -110,9 +125,14 @@ function deriveFieldType(parentTypeName, fieldName, required, fieldSchema, colle
   return fromSchemaType(required, undefined, st, collectedTypes, seenTypes);
 }
 
+function reportUnclassifiedUnions(typeName, schema) {
+  SchemaType$ReventlessCore.unclassifiedUnions(schema).forEach(param => log.warn("GraphQL_FragmentGenerator", undefined, typeName + `.` + param.path + ` is emitted as String: ` + param.reason));
+}
+
 function deriveObjectTypeWithNested(typeName, excludeFieldsOpt, includeIdParamOpt, schema) {
   let excludeFields = excludeFieldsOpt !== undefined ? excludeFieldsOpt : [];
   let includeIdParam = includeIdParamOpt !== undefined ? includeIdParamOpt : true;
+  reportUnclassifiedUnions(typeName, schema);
   let fields = SchemaType$ReventlessCore.fromSuryObject(typeName, schema);
   if (fields === undefined) {
     return [];
@@ -580,10 +600,12 @@ function generate(mutationEntries, queryEntries) {
 }
 
 export {
+  log,
   commandResultSdlTypes,
   fromSchemaType,
   objectRefToGraphQL,
   deriveFieldType,
+  reportUnclassifiedUnions,
   deriveObjectTypeWithNested,
   derivePluralWrapperType,
   deriveConnectionTypes,
@@ -611,4 +633,4 @@ export {
   mutationArgTypes,
   generate,
 }
-/* Api_Naming-ReventlessCore Not a pure module */
+/* log Not a pure module */

package/src/components/Api/SchemaType.res

@@ -15,6 +15,14 @@ type rec schemaType =
         are *not* expressed this way: they long predate the generic marker and
         their JSON Schema `format` output is a published contract. */
   Semantic(Reventless.Semantic.t, schemaType)
+  | /** A variant used as a field: the union's name, and one arm per constructor
+        keyed by the `TAG` sury discriminates on. Each arm is the `ObjectRef` its
+        member type is emitted from, so the arm's own name travels with it and
+        every consumer that can already render an object renders an arm.
+
+        Only a *named* union reaches this case — see `Reventless.TaggedUnion`,
+        which owns the name and the arm rules both. */
+  TaggedUnion(string, array<(string, schemaType)>)
   | Unknown
 
 let isTagged = Reventless.DcbTag.isTagged
@@ -162,7 +170,35 @@ and shapeOf = (~parentName: string, ~fieldName: string, schema: S.t<unknown>): s
           let enum = Enum(enumName, constValues)
           isOptional ? Nullable(enum) : enum
         } else {
-          Unknown
+          // A union of payload-carrying arms. Its name is read off the schema
+          // rather than composed from the field path the way the enum above is:
+          // the same union is one type wherever it appears, and the write-time
+          // `__typename` stamp has only the schema to derive it from.
+          switch Reventless.TaggedUnion.classify(schema) {
+          | Some((unionName, arms)) =>
+            let armTypes = arms->Array.map(({tag, schema: armSchema}) => {
+              let memberName = Reventless.TaggedUnion.memberTypeName(~union=unionName, ~arm=tag)
+              let fields = Dict.make()
+              switch armSchema {
+              | Object({properties}) =>
+                properties
+                ->Dict.toArray
+                ->Array.forEach(((propName, propSchema)) =>
+                  if propName !== "TAG" {
+                    fields->Dict.set(
+                      propName,
+                      fromSury(~parentName=memberName, ~fieldName=propName, propSchema),
+                    )
+                  }
+                )
+              | _ => ()
+              }
+              (tag, ObjectRef(memberName, fields))
+            })
+            let union = TaggedUnion(unionName, armTypes)
+            isOptional ? Nullable(union) : union
+          | None => Unknown
+          }
         }
       }
     | Null(_) => Nullable(ScalarString)
@@ -171,6 +207,102 @@ and shapeOf = (~parentName: string, ~fieldName: string, schema: S.t<unknown>): s
   }
 }
 
+/**
+A field whose schema is a union the walk could not classify, and why.
+
+`Unknown` is emitted as `String`, which is a lie a client only discovers at
+execution time — and for a union field it is the *silent* half of a failure
+whose loud half is a null in a non-nullable position. Reporting is deliberately
+narrow: a field is only named here if its schema is a union of two or more real
+members, which is a shape somebody wrote on purpose. An opaque `JSON.t` field
+also lands on `Unknown` and is left alone, because nothing better was ever
+available for it.
+*/
+type unclassifiedUnion = {path: string, reason: string}
+
+// Walks the schema, not a value, so a self-referential schema has nothing to
+// terminate it. Bounded rather than cycle-detected: this is a report, and a
+// field nested a dozen records deep is past the depth the SDL emitter itself
+// renders usefully.
+let maxReportDepth = 12
+
+let rec collectUnclassifiedUnions = (
+  ~path: string,
+  ~depth: int=0,
+  schema: S.t<unknown>,
+  out: array<unclassifiedUnion>,
+): unit =>
+  if depth > maxReportDepth {
+    ()
+  } else {
+    let under = (name: string) => path === "" ? name : path ++ "." ++ name
+    let recurse = (~path, schema) => collectUnclassifiedUnions(~path, ~depth=depth + 1, schema, out)
+    switch schema {
+    | Object({properties}) =>
+      properties
+      ->Dict.toArray
+      ->Array.forEach(((name, propSchema)) =>
+        if name !== "TAG" {
+          recurse(~path=under(name), propSchema)
+        }
+      )
+    | Array({items, additionalItems}) =>
+      let itemSchema = switch items->Array.get(0) {
+      | Some(s) => Some(s)
+      | None =>
+        switch additionalItems {
+        | Schema(s) => Some(s)
+        | _ => None
+        }
+      }
+      switch itemSchema {
+      | Some(s) => recurse(~path=path ++ "[]", s)
+      | None => ()
+      }
+    | AnyOf({anyOf}) =>
+      let members = anyOf->Array.filter(v =>
+        switch v {
+        | Null(_) | Undefined(_) => false
+        | _ => true
+        }
+      )
+      switch members {
+      | [inner] => recurse(~path, inner)
+      | _ =>
+        let allConst = members->Array.every(v =>
+          switch v {
+          | String({const: ?Some(_)}) => true
+          | _ => false
+          }
+        )
+        if allConst {
+          ()
+        } else {
+          switch Reventless.TaggedUnion.classify(schema) {
+          | Some((_, arms)) =>
+            arms->Array.forEach(({tag, schema: armSchema}) => recurse(~path=under(tag), armSchema))
+          | None =>
+            let reason = if Reventless.TaggedUnion.armsOf(schema)->Option.isSome {
+              `its arms are well-formed but the union carries no name. Declare it in a spec file, where the ppx names it, or mark the schema with \`Reventless.TaggedUnion.named\`.`
+            } else {
+              `its ${members
+                ->Array.length
+                ->Int.toString} members are neither all string literals (an enum) nor all tagged objects each declaring at least one named field of its own (a union).`
+            }
+            out->Array.push({path, reason})
+          }
+        }
+      }
+    | _ => ()
+    }
+  }
+
+let unclassifiedUnions = (schema: S.t<unknown>): array<unclassifiedUnion> => {
+  let out = []
+  collectUnclassifiedUnions(~path="", schema, out)
+  out
+}
+
 /**
 The names of an object's optional properties, read from sury rather than from
 the IR.

package/src/components/Api/SchemaType.res.mjs

@@ -6,6 +6,7 @@ import * as DcbTag$Reventless from "@reventlessdev/reventless-spec/src/component
 import * as DateTime$Reventless from "@reventlessdev/reventless-spec/src/types/DateTime.res.mjs";
 import * as Semantic$Reventless from "@reventlessdev/reventless-spec/src/semantic/Semantic.res.mjs";
 import * as Reference$Reventless from "@reventlessdev/reventless-spec/src/components/Reference.res.mjs";
+import * as TaggedUnion$Reventless from "@reventlessdev/reventless-spec/src/components/TaggedUnion.res.mjs";
 
 function isIdFieldName(name) {
   let lower = name.toLowerCase();
@@ -147,28 +148,147 @@ function shapeOf(parentName, fieldName, schema) {
           return c;
         }
       });
-      if (constValues.length !== nonNullVariants.length || constValues.length === 0) {
+      if (constValues.length === nonNullVariants.length && constValues.length !== 0) {
+        let enumName = parentName + fieldName.charAt(0).toUpperCase() + fieldName.slice(1, fieldName.length);
+        let $$enum = {
+          TAG: "Enum",
+          _0: enumName,
+          _1: constValues
+        };
+        if (isOptional) {
+          return {
+            TAG: "Nullable",
+            _0: $$enum
+          };
+        } else {
+          return $$enum;
+        }
+      }
+      let match = TaggedUnion$Reventless.classify(schema);
+      if (match === undefined) {
         return "Unknown";
       }
-      let enumName = parentName + fieldName.charAt(0).toUpperCase() + fieldName.slice(1, fieldName.length);
-      let $$enum = {
-        TAG: "Enum",
-        _0: enumName,
-        _1: constValues
+      let unionName = match[0];
+      let armTypes = match[1].map(param => {
+        let armSchema = param.schema;
+        let tag = param.tag;
+        let memberName = TaggedUnion$Reventless.memberTypeName(unionName, tag);
+        let fields = {};
+        if (armSchema.type === "object") {
+          Object.entries(armSchema.properties).forEach(param => {
+            let propName = param[0];
+            if (propName !== "TAG") {
+              fields[propName] = fromSury(memberName, propName, param[1]);
+              return;
+            }
+          });
+        }
+        return [
+          tag,
+          {
+            TAG: "ObjectRef",
+            _0: memberName,
+            _1: fields
+          }
+        ];
+      });
+      let union = {
+        TAG: "TaggedUnion",
+        _0: unionName,
+        _1: armTypes
       };
       if (isOptional) {
         return {
           TAG: "Nullable",
-          _0: $$enum
+          _0: union
         };
       } else {
-        return $$enum;
+        return union;
       }
     default:
       return "Unknown";
   }
 }
 
+function collectUnclassifiedUnions(path, depthOpt, schema, out) {
+  let depth = depthOpt !== undefined ? depthOpt : 0;
+  if (depth > 12) {
+    return;
+  }
+  let under = name => {
+    if (path === "") {
+      return name;
+    } else {
+      return path + "." + name;
+    }
+  };
+  let recurse = (path, schema) => collectUnclassifiedUnions(path, depth + 1 | 0, schema, out);
+  switch (schema.type) {
+    case "array" :
+      let additionalItems = schema.additionalItems;
+      let s = schema.items[0];
+      let itemSchema = s !== undefined ? s : (
+          additionalItems === "strip" || additionalItems === "strict" ? undefined : additionalItems
+        );
+      if (itemSchema !== undefined) {
+        return recurse(path + "[]", itemSchema);
+      } else {
+        return;
+      }
+    case "object" :
+      Object.entries(schema.properties).forEach(param => {
+        let name = param[0];
+        if (name !== "TAG") {
+          return recurse(under(name), param[1]);
+        }
+      });
+      return;
+    case "anyOf" :
+      let members = schema.anyOf.filter(v => {
+        switch (v.type) {
+          case "null" :
+          case "undefined" :
+            return false;
+          default:
+            return true;
+        }
+      });
+      if (members.length !== 1) {
+        let allConst = members.every(v => {
+          if (v.type === "string") {
+            return v.const !== undefined;
+          } else {
+            return false;
+          }
+        });
+        if (allConst) {
+          return;
+        }
+        let match = TaggedUnion$Reventless.classify(schema);
+        if (match !== undefined) {
+          match[1].forEach(param => recurse(under(param.tag), param.schema));
+          return;
+        }
+        let reason = Stdlib_Option.isSome(TaggedUnion$Reventless.armsOf(schema)) ? `its arms are well-formed but the union carries no name. Declare it in a spec file, where the ppx names it, or mark the schema with \`Reventless.TaggedUnion.named\`.` : `its ` + members.length.toString() + ` members are neither all string literals (an enum) nor all tagged objects each declaring at least one named field of its own (a union).`;
+        out.push({
+          path: path,
+          reason: reason
+        });
+        return;
+      }
+      let inner = members[0];
+      return recurse(path, inner);
+    default:
+      return;
+  }
+}
+
+function unclassifiedUnions(schema) {
+  let out = [];
+  collectUnclassifiedUnions("", undefined, schema, out);
+  return out;
+}
+
 function optionalFieldNames(schema) {
   if (schema.type === "object") {
     return Stdlib_Array.filterMap(Object.entries(schema.properties), param => {
@@ -209,6 +329,8 @@ let isTagged = DcbTag$Reventless.isTagged;
 
 let isDateTime = DateTime$Reventless.isDateTime;
 
+let maxReportDepth = 12;
+
 export {
   isTagged,
   isDateTime,
@@ -218,6 +340,9 @@ export {
   canonicalName,
   fromSury,
   shapeOf,
+  maxReportDepth,
+  collectUnclassifiedUnions,
+  unclassifiedUnions,
   optionalFieldNames,
   fromSuryObject,
 }

package/src/components/Api/SuryToJsonSchema.res

@@ -196,9 +196,45 @@ let rec fromSchemaType = (st: SchemaType.schemaType): JSON.t =>
       ("enum", JSON.Encode.array(values->Array.map(JSON.Encode.string))),
     ])
   | Semantic(sem, inner) => fromSchemaType(inner)->withSemantic(sem)
+  // A union is `oneOf` its arms, each an object carrying the `TAG` const it is
+  // discriminated by. The discriminator is what tells a union apart from a
+  // nullable object, which is also a `oneOf` of objects — a reader that misses
+  // it selects one arm's fields as though they were the field's own and produces
+  // a query that looks plausible and is invalid.
+  | TaggedUnion(name, arms) =>
+    let members = arms->Array.map(((tag, armType)) => armToJsonSchema(~tag, armType))
+    jsonObject([("oneOf", JSON.Encode.array(members)), ("x-reventless-union", str(name))])
   | Unknown => jsonObject([("type", str("string"))])
   }
 
+// One arm. `TAG` is declared rather than filtered out — the raw value on the
+// wire and in the live change channel carries it, and it is the only thing in
+// the payload that says which arm this is. The GraphQL member type name rides
+// alongside so a reader mapping a raw payload to a selection does not have to
+// re-derive the naming rule in a second repo.
+and armToJsonSchema = (~tag: string, armType: SchemaType.schemaType): JSON.t =>
+  switch armType {
+  | ObjectRef(memberName, fields) =>
+    let base = objectRefToJsonSchema(fields)
+    switch base->JSON.Decode.object {
+    | Some(obj) =>
+      switch obj->Dict.get("properties")->Option.flatMap(JSON.Decode.object) {
+      | Some(props) =>
+        props->Dict.set("TAG", jsonObject([("type", str("string")), ("const", str(tag))]))
+      | None => ()
+      }
+      let required = switch obj->Dict.get("required")->Option.flatMap(JSON.Decode.array) {
+      | Some(existing) => Array.concat([str("TAG")], existing)
+      | None => [str("TAG")]
+      }
+      obj->Dict.set("required", JSON.Encode.array(required))
+      obj->Dict.set("x-reventless-union-member", str(memberName))
+      JSON.Encode.object(obj)
+    | None => base
+    }
+  | other => fromSchemaType(other)
+  }
+
 // Attach a type-carried semantic to a field's JSON Schema.
 //
 // This is the type path's emission point, and it is deliberately *not*

package/src/components/Api/SuryToJsonSchema.res.mjs

@@ -246,10 +246,54 @@ function fromSchemaType(st) {
         ]);
       case "Semantic" :
         return withSemantic(fromSchemaType(st._1), st._0);
+      case "TaggedUnion" :
+        let members = st._1.map(param => armToJsonSchema(param[0], param[1]));
+        return Object.fromEntries([
+          [
+            "oneOf",
+            members
+          ],
+          [
+            "x-reventless-union",
+            st._0
+          ]
+        ]);
     }
   }
 }
 
+function armToJsonSchema(tag, armType) {
+  if (typeof armType !== "object") {
+    return fromSchemaType(armType);
+  }
+  if (armType.TAG !== "ObjectRef") {
+    return fromSchemaType(armType);
+  }
+  let base = objectRefToJsonSchema(undefined, undefined, undefined, armType._1);
+  let obj = Stdlib_JSON.Decode.object(base);
+  if (obj === undefined) {
+    return base;
+  }
+  let props = Stdlib_Option.flatMap(obj["properties"], Stdlib_JSON.Decode.object);
+  if (props !== undefined) {
+    props["TAG"] = Object.fromEntries([
+      [
+        "type",
+        "string"
+      ],
+      [
+        "const",
+        tag
+      ]
+    ]);
+  }
+  let existing = Stdlib_Option.flatMap(obj["required"], Stdlib_JSON.Decode.array);
+  let required = existing !== undefined ? ["TAG"].concat(existing) : ["TAG"];
+  obj["required"] = required;
+  obj["x-reventless-union-member"] = armType._0;
+  return obj;
+}
+
 function withSemantic(fieldSchema, sem) {
   let obj = Stdlib_JSON.Decode.object(fieldSchema);
   if (obj === undefined) {
@@ -368,6 +412,7 @@ export {
   mergeAnnotations,
   isNullableType,
   fromSchemaType,
+  armToJsonSchema,
   withSemantic,
   objectRefToJsonSchema,
   deriveObjectSchema,

package/src/components/QueryDb/QueryDb_Operations.res

@@ -67,12 +67,24 @@ module Make = (ReadModelSpec: Reventless.ReadModel.Spec, Ops: Ops) => {
     })
   }
 
+  // Every union value in the row carries the GraphQL member type it is, written
+  // once here rather than by each of the fourteen read doors across three
+  // backends — and, unlike a read-time stamp, it is also on the row the live
+  // change channel hands over as raw JSON. A view with no union field is walked
+  // and left exactly as it was.
+  let stampUnionMembers = dict =>
+    Reventless.TaggedUnion.stampInto(
+      ~schema=ReadModelSpec.stateSchema->S.castToUnknown,
+      JSON.Encode.object(dict),
+    )
+
   let save = async (id, state, saveMode, ttl) =>
     switch state->Message.encode(ReadModelSpec.stateSchema)->JSON.Decode.object {
     | Some(dict) =>
       dict->Dict.set("id", id->Message.encode(ReadModelSpec.Id.schema))
       injectSubId(dict, state)
       injectCompositeIndexAttrs(dict)
+      stampUnionMembers(dict)
       let json = JSON.Encode.object(dict)
       await Ops.jsonOps.save(id->ReadModelSpec.Id.toString, json, saveMode, ttl)
     | None =>
@@ -87,6 +99,7 @@ module Make = (ReadModelSpec: Reventless.ReadModel.Spec, Ops: Ops) => {
           dict->Dict.set("id", id->Message.encode(ReadModelSpec.Id.schema))
           injectSubId(dict, state)
           injectCompositeIndexAttrs(dict)
+          stampUnionMembers(dict)
           let json = JSON.Encode.object(dict)
           Ok(batch->Array.concat([(id->ReadModelSpec.Id.toString, json, ttl)]))
         | None =>