@reventlessdev/trait-attachments 1.0.0-alpha.3 → 1.0.0-alpha.4

package/package.json

@@ -1,6 +1,6 @@
 {
   "name": "@reventlessdev/trait-attachments",
-  "version": "1.0.0-alpha.3",
+  "version": "1.0.0-alpha.4",
   "description": "Attachments domain trait: rules, host contract, conformance suite and emitter for an ordered set of stored files on an entity, with a primary and captions",
   "license": "Apache-2.0",
   "files": [
@@ -13,8 +13,8 @@
   "dependencies": {
     "sury": "11.0.0-rc.2",
     "sury-ppx": "11.0.0-rc.2",
-    "@reventlessdev/reventless-gwt": "1.0.0-alpha.201",
-    "@reventlessdev/reventless-spec": "3.0.0-alpha.127"
+    "@reventlessdev/reventless-gwt": "1.0.0-alpha.202",
+    "@reventlessdev/reventless-spec": "3.0.0-alpha.128"
   },
   "devDependencies": {
     "rescript": "12.3.0"

package/src/Attachments.res

@@ -64,3 +64,53 @@ module type Binding = {
   /** The refusal for a primary or caption on a ref that is not in the set. */
   let notAttached: Spec.error
 }
+
+/**
+One host of the **bounded** cardinality, bound.
+
+A separate contract rather than optional members on {!Binding}, because what
+`Attachments_Rules.Single` changes is the host's command surface and not just a
+rule: there is no primary to choose between one member, so the graft declares no
+such command, and there is no ref for a remove to name, so it declares none.
+Both absences are facts a module type states better than a test does — a
+`Single` graft that grew a `SetPrimary` command would fail to satisfy this
+signature, which is the check, and it happens at compile time.
+
+Everything the two contracts share is spelled identically on purpose: a reader
+comparing them should find the difference in what is missing, not in how the
+common half is phrased.
+*/
+module type SingleBinding = {
+  type ref
+  /** Two refs that differ — the second is what replaces the first. */
+  let refA: ref
+  let refB: ref
+
+  module Spec: ReventlessGwt.Behavior_GWT.BehaviorSpec
+  module Behavior: ReventlessGwt.Behavior_GWT.Behavior with module Spec = Spec
+
+  /** History that brings the entity into existence with an empty set. */
+  let created: array<Spec.consumedEvent>
+  /** The set's own facts, as the slice consumes them. No `primarySetC`: nothing
+      emits one. */
+  let attachedC: ref => Spec.consumedEvent
+  let removedC: ref => Spec.consumedEvent
+  let altTextSetC: (ref, string) => Spec.consumedEvent
+
+  let attach: ref => Spec.command
+  /** Remove whatever is held. Takes no ref — there is only one, and asking the
+      caller to name it is asking them to repeat what the row already says. */
+  let clear: Spec.command
+  /** Caption whatever is held. Ref-less for `clear`'s reason, and there is a
+      second one here: a bounded host's view carries the reference as a scalar
+      and no collection at all, so there is no field for a selection to be a
+      member *of*. */
+  let setAltText: string => Spec.command
+
+  /** The set's facts, as the slice emits them. */
+  let attached: ref => Spec.event
+  let removed: ref => Spec.event
+  let altTextSet: (ref, string) => Spec.event
+  /** The refusal for a caption on a ref that is not held. */
+  let notAttached: Spec.error
+}

package/src/Attachments_Conformance.res

@@ -6,7 +6,12 @@ inside a Jest test file registers one `describe` block over the binding.
 /** The suite's title, composed once and read twice: the suite registers it,
     and `certify-trait` computes the same string to find the run's assertions in
     a test report. Exported rather than inlined so neither side parses the
-    other's prose. */
+    other's prose.
+
+    One title for both cardinalities: a host conforms to this trait or it does
+    not, and which of the two suites established that is not a fact a
+    certificate should have to know. `MakeSingle` registers under the same
+    name. */
 let suiteName = (host: string) => `${host} conforms to the attachments trait`
 
 module Make = (B: Attachments.Binding) => {
@@ -86,3 +91,81 @@ module Make = (B: Attachments.Binding) => {
       )
     })
 }
+
+/**
+The suite for a host of the bounded cardinality.
+
+Smaller than `Make`'s, and smaller for a reason worth reading: most of what the
+larger suite asserts is about choosing between members, and a set that holds one
+member has nothing to choose. Those assertions are not skipped here — they are
+unreachable, because {!Attachments.SingleBinding} does not admit the commands
+that would reach them. The absent primary is checked by the compiler.
+
+What is left is the one rule cardinality actually changes — a second attachment
+replaces rather than joins — plus the ref-less remove and the captions, which a
+single image wants exactly as much as a gallery member does.
+*/
+module MakeSingle = (B: Attachments.SingleBinding) => {
+  module G = ReventlessGwt.Behavior_GWT.Make(B.Spec, B.Behavior)
+
+  let withA = Array.concat(B.created, [B.attachedC(B.refA)])
+
+  let register = () =>
+    G.describe(suiteName(B.Spec.name), () => {
+      G.test("the first attachment is appended", () =>
+        G.givenEvents(B.created)->G.whenCmd(B.attach(B.refA))->G.thenEvent(B.attached(B.refA))
+      )
+
+      G.test("attaching the ref already held is a no-op", () =>
+        G.givenEvents(withA)->G.whenCmd(B.attach(B.refA))->G.thenNoEvent
+      )
+
+      // The assertion the cardinality exists for. Two facts, in order: what was
+      // there leaves before what replaces it arrives, so a reader replaying the
+      // log never sees the set hold both.
+      G.test("a second ref replaces the first rather than joining it", () =>
+        G.givenEvents(withA)
+        ->G.whenCmd(B.attach(B.refB))
+        ->G.thenEvents([B.removed(B.refA), B.attached(B.refB)])
+      )
+
+      G.test("clearing a held set removes what it holds", () =>
+        G.givenEvents(withA)->G.whenCmd(B.clear)->G.thenEvent(B.removed(B.refA))
+      )
+
+      G.test("clearing an empty set is a no-op", () =>
+        G.givenEvents(B.created)->G.whenCmd(B.clear)->G.thenNoEvent
+      )
+
+      G.test("a replaced ref can be attached again", () =>
+        G.givenEvents(Array.concat(withA, [B.removedC(B.refA), B.attachedC(B.refB)]))
+        ->G.whenCmd(B.attach(B.refA))
+        ->G.thenEvents([B.removed(B.refB), B.attached(B.refA)])
+      )
+
+      // The caption names no ref either, so what it lands on is whatever is
+      // held — and the assertion is that it lands on the *right* ref, which is
+      // the only thing a ref-less command can get wrong.
+      G.test("a caption lands on the ref that is held", () =>
+        G.givenEvents(withA)
+        ->G.whenCmd(B.setAltText("front"))
+        ->G.thenEvent(B.altTextSet(B.refA, "front"))
+      )
+
+      G.test("a caption follows a replacement onto the new ref", () =>
+        G.givenEvents(Array.concat(withA, [B.removedC(B.refA), B.attachedC(B.refB)]))
+        ->G.whenCmd(B.setAltText("side"))
+        ->G.thenEvent(B.altTextSet(B.refB, "side"))
+      )
+
+      G.test("captioning an empty set is refused", () =>
+        G.givenEvents(B.created)->G.whenCmd(B.setAltText("front"))->G.thenError(B.notAttached)
+      )
+
+      G.test("repeating the caption is a no-op", () =>
+        G.givenEvents(Array.concat(withA, [B.altTextSetC(B.refA, "front")]))
+        ->G.whenCmd(B.setAltText("front"))
+        ->G.thenNoEvent
+      )
+    })
+}

package/src/Attachments_Conformance.res.mjs

@@ -42,8 +42,48 @@ function Make(B) {
   };
 }
 
+function MakeSingle(B) {
+  let $$let = B.Behavior;
+  let G = Behavior_GWT$ReventlessGwt.Make(B.Spec)({
+    initialState: $$let.initialState,
+    evolve: $$let.evolve,
+    decide: $$let.decide
+  });
+  let withA = B.created.concat([B.attachedC(B.refA)]);
+  let register = () => G.describe(suiteName(B.Spec.name), () => {
+    G.test("the first attachment is appended", () => G.thenEvent(G.whenCmd(G.givenEvents(B.created), B.attach(B.refA)), B.attached(B.refA)));
+    G.test("attaching the ref already held is a no-op", () => G.thenNoEvent(G.whenCmd(G.givenEvents(withA), B.attach(B.refA))));
+    G.test("a second ref replaces the first rather than joining it", () => G.thenEvents(G.whenCmd(G.givenEvents(withA), B.attach(B.refB)), [
+      B.removed(B.refA),
+      B.attached(B.refB)
+    ]));
+    G.test("clearing a held set removes what it holds", () => G.thenEvent(G.whenCmd(G.givenEvents(withA), B.clear), B.removed(B.refA)));
+    G.test("clearing an empty set is a no-op", () => G.thenNoEvent(G.whenCmd(G.givenEvents(B.created), B.clear)));
+    G.test("a replaced ref can be attached again", () => G.thenEvents(G.whenCmd(G.givenEvents(withA.concat([
+      B.removedC(B.refA),
+      B.attachedC(B.refB)
+    ])), B.attach(B.refA)), [
+      B.removed(B.refB),
+      B.attached(B.refA)
+    ]));
+    G.test("a caption lands on the ref that is held", () => G.thenEvent(G.whenCmd(G.givenEvents(withA), B.setAltText("front")), B.altTextSet(B.refA, "front")));
+    G.test("a caption follows a replacement onto the new ref", () => G.thenEvent(G.whenCmd(G.givenEvents(withA.concat([
+      B.removedC(B.refA),
+      B.attachedC(B.refB)
+    ])), B.setAltText("side")), B.altTextSet(B.refB, "side")));
+    G.test("captioning an empty set is refused", () => G.thenError(G.whenCmd(G.givenEvents(B.created), B.setAltText("front")), B.notAttached));
+    G.test("repeating the caption is a no-op", () => G.thenNoEvent(G.whenCmd(G.givenEvents(withA.concat([B.altTextSetC(B.refA, "front")])), B.setAltText("front"))));
+  });
+  return {
+    G: G,
+    withA: withA,
+    register: register
+  };
+}
+
 export {
   suiteName,
   Make,
+  MakeSingle,
 }
 /* Behavior_GWT-ReventlessGwt Not a pure module */

package/src/Attachments_Rules.res

@@ -12,6 +12,30 @@ entity is. `Attachments_Conformance` asserts these rules through a host.
     without a wrapper the host would have to unwrap on every arm. */
 type ref = string
 
+/**
+How many members a host's set may hold.
+
+Not a runtime variation: a graft fixes this once, and every command the graft
+emits is shaped by the answer. It reaches `decide` as an argument rather than
+sitting on `t` so that `empty` stays one value and a host that never mentions
+cardinality gets the behaviour it has today.
+
+Exactly one rule reads it — `Attach` — and that is the whole of the difference:
+a bounded set replaces its member where an unbounded one appends beside it.
+Everything else is already cardinality-blind. `SetPrimary` on a one-member set
+resolves to a no-op through the rules it already has (the only member is already
+the effective primary), which is why `Single` needs no branch for it and why the
+scaffold simply declines to emit the command rather than the rules refusing it.
+*/
+// `@schema` so `Attachments_Scaffold`'s config can take this very type rather
+// than a second spelling of it. A graft's config and the rule it selects being
+// the same value is the point: a config that could say `"single"` where the
+// rules say `Single` is a config that can be misspelled.
+@schema
+type cardinality =
+  | /** An unbounded, ordered set: a gallery. */ Many
+  | /** At most one member, replaced rather than added to. */ Single
+
 /** Refolded per decision, never stored — a StateChangeSlice's state is. */
 type t = {
   attached: array<ref>,
@@ -27,8 +51,25 @@ type op =
   | /** `altText` is the caption a host may supply with the file itself. */
   Attach({ref: ref, altText: option<string>})
   | Remove({ref: ref})
+  | /** Empty the set, whatever it holds.
+
+        The op a bounded set's remove command maps onto: with one member there is
+        no ref for the caller to name, and naming it would be asking them to
+        repeat what the row already says. Well defined at either cardinality —
+        an unbounded host that wants a "remove them all" command gets it here
+        rather than by looping its own remove. */
+  Clear
   | SetPrimary({ref: ref})
   | SetAltText({ref: ref, altText: string})
+  | /** Caption whichever member is the primary, without naming it.
+
+        The counterpart of `Clear`, and the op a bounded set's caption command
+        maps onto — with one member there is nothing to name. It is not
+        bounded-only, though: the primary is the one image a reader actually
+        sees, so "caption the hero" is a command an unbounded host wants too,
+        and resolving it here through `effectivePrimary` is what keeps the
+        answer the same as the member a projection puts first. */
+  SetPrimaryAltText({altText: string})
 
 /** What the set decided, for the host to name in its own event. */
 type fact =
@@ -50,6 +91,33 @@ let effectivePrimary = t => primaryOf(~chosen=t.primary, ~attached=t.attached)
 
 let altTextOf = (t, ref) => t.altTexts->Array.find(((r, _)) => r == ref)->Option.map(((_, t)) => t)
 
+/**
+The set with the chosen member first, for a read model projecting it onto a row.
+
+This is where `primaryOf`'s rule lands on a view. The view carries the set and
+nothing beside it, so *being first* is how the row says which member is the
+primary — and "the chosen one, else the first attached" then needs no second
+field to hold the answer and no rule to keep that field in step. Attach appends,
+remove filters, and both leave the head alone unless they moved it; only this
+reorders.
+
+Sound for a projection because the order is derived: the events fully determine
+it, so a replay reproduces it. What it costs is that attachment order stops being
+readable off the view — the log still has it, and a consumer that wanted it back
+would have to be given it deliberately.
+
+Parameterised on `~ref` rather than owning the member type, for the reason
+`primaryOf` takes two arrays: the member record is the host's own `@schema` type
+and the field holding its reference is named for the host's store. A `chosen` the
+set does not hold leaves the order alone — a `SetPrimary` naming a member a
+removal already took away must not empty the row.
+*/
+let primaryFirst = (~chosen: ref, ~members: array<'m>, ~ref: 'm => ref): array<'m> =>
+  switch members->Array.find(m => ref(m) == chosen) {
+  | Some(primary) => Array.concat([primary], members->Array.filter(m => ref(m) != chosen))
+  | None => members
+  }
+
 let evolve = (t, fact) =>
   switch fact {
   | Attached({ref, altText}) =>
@@ -75,27 +143,66 @@ let evolve = (t, fact) =>
     }
   }
 
-/** `Ok(None)` is the no-op a retried command must produce; the one refusal the set
-    owns is a primary or a caption on a ref it does not hold. */
-let decide = (t, op): result<option<fact>, [#NotAttached]> =>
+// Shared by the two captioning ops, which differ only in how they arrive at a
+// ref. Spelled once so a named caption and the primary's caption cannot end up
+// with different ideas of what a repeat is.
+let setAltText = (t, ~ref, ~altText): result<array<fact>, [#NotAttached]> =>
+  if !(t.attached->Array.includes(ref)) {
+    Error(#NotAttached)
+  } else if altTextOf(t, ref) == Some(altText) {
+    Ok([])
+  } else {
+    Ok([AltTextSet({ref, altText})])
+  }
+
+/**
+What the set decided, as facts in the order they happened.
+
+`Ok([])` is the no-op a retried command must produce; the one refusal the set
+owns is a primary or a caption on a ref it does not hold.
+
+An array rather than one optional fact, because a bounded set replacing its
+member decides two things at once — the old one leaves and the new one arrives —
+and an event log records both. Collapsing them into a single "replaced" fact
+would make a host declare an event that only bounded hosts have, which is one
+more way the two cardinalities' emitted surfaces could diverge.
+*/
+let decide = (t, ~cardinality: cardinality=Many, op): result<array<fact>, [#NotAttached]> =>
   switch op {
   | Attach({ref, altText}) =>
-    t.attached->Array.includes(ref) ? Ok(None) : Ok(Some(Attached({ref, altText})))
-  | Remove({ref}) => t.attached->Array.includes(ref) ? Ok(Some(Removed({ref: ref}))) : Ok(None)
+    if t.attached->Array.includes(ref) {
+      Ok([])
+    } else {
+      switch cardinality {
+      | Many => Ok([Attached({ref, altText})])
+      // The whole of what `Single` changes. The members that leave are named
+      // individually rather than through `Clear` so the facts read the same
+      // whether one was there or (through some history nothing produces) more.
+      | Single =>
+        Ok(
+          Array.concat(
+            t.attached->Array.map(r => Removed({ref: r})),
+            [Attached({ref, altText})],
+          ),
+        )
+      }
+    }
+  | Remove({ref}) => t.attached->Array.includes(ref) ? Ok([Removed({ref: ref})]) : Ok([])
+  | Clear => Ok(t.attached->Array.map(r => Removed({ref: r})))
   | SetPrimary({ref}) =>
     if !(t.attached->Array.includes(ref)) {
       Error(#NotAttached)
     } else if effectivePrimary(t) == Some(ref) {
-      Ok(None)
+      Ok([])
     } else {
-      Ok(Some(PrimarySet({ref: ref})))
+      Ok([PrimarySet({ref: ref})])
     }
-  | SetAltText({ref, altText}) =>
-    if !(t.attached->Array.includes(ref)) {
-      Error(#NotAttached)
-    } else if altTextOf(t, ref) == Some(altText) {
-      Ok(None)
-    } else {
-      Ok(Some(AltTextSet({ref, altText})))
+  | SetAltText({ref, altText}) => setAltText(t, ~ref, ~altText)
+  // An empty set has no primary, so there is nothing to caption — the same
+  // refusal a named ref the set does not hold gets, and for the same reason.
+  | SetPrimaryAltText({altText}) =>
+    switch effectivePrimary(t) {
+    | Some(ref) => setAltText(t, ~ref, ~altText)
+    | None => Error(#NotAttached)
     }
   }

package/src/Attachments_Rules.res.mjs

@@ -1,7 +1,14 @@
 // Generated by ReScript, PLEASE EDIT WITH CARE
 
+import * as Sury from "sury";
 import * as Stdlib_Option from "@rescript/runtime/lib/es6/Stdlib_Option.js";
 import * as Primitive_object from "@rescript/runtime/lib/es6/Primitive_object.js";
+import * as Primitive_option from "@rescript/runtime/lib/es6/Primitive_option.js";
+
+let cardinalitySchema = Sury.union([
+  Sury.literal("Many"),
+  Sury.literal("Single")
+]);
 
 let empty_attached = [];
 
@@ -29,6 +36,15 @@ function altTextOf(t, ref) {
   return Stdlib_Option.map(t.altTexts.find(param => param[0] === ref), param => param[1]);
 }
 
+function primaryFirst(chosen, members, ref) {
+  let primary = members.find(m => ref(m) === chosen);
+  if (primary !== undefined) {
+    return [Primitive_option.valFromOption(primary)].concat(members.filter(m => ref(m) !== chosen));
+  } else {
+    return members;
+  }
+}
+
 function evolve(t, fact) {
   switch (fact.TAG) {
     case "Attached" :
@@ -71,23 +87,72 @@ function evolve(t, fact) {
   }
 }
 
-function decide(t, op) {
+function setAltText(t, ref, altText) {
+  if (t.attached.includes(ref)) {
+    if (Primitive_object.equal(altTextOf(t, ref), altText)) {
+      return {
+        TAG: "Ok",
+        _0: []
+      };
+    } else {
+      return {
+        TAG: "Ok",
+        _0: [{
+            TAG: "AltTextSet",
+            ref: ref,
+            altText: altText
+          }]
+      };
+    }
+  } else {
+    return {
+      TAG: "Error",
+      _0: "NotAttached"
+    };
+  }
+}
+
+function decide(t, cardinalityOpt, op) {
+  let cardinality = cardinalityOpt !== undefined ? cardinalityOpt : "Many";
+  if (typeof op !== "object") {
+    return {
+      TAG: "Ok",
+      _0: t.attached.map(r => ({
+        TAG: "Removed",
+        ref: r
+      }))
+    };
+  }
   switch (op.TAG) {
     case "Attach" :
       let ref = op.ref;
       if (t.attached.includes(ref)) {
         return {
           TAG: "Ok",
-          _0: undefined
+          _0: []
+        };
+      }
+      let altText = op.altText;
+      if (cardinality === "Many") {
+        return {
+          TAG: "Ok",
+          _0: [{
+              TAG: "Attached",
+              ref: ref,
+              altText: altText
+            }]
         };
       } else {
         return {
           TAG: "Ok",
-          _0: {
-            TAG: "Attached",
-            ref: ref,
-            altText: op.altText
-          }
+          _0: t.attached.map(r => ({
+            TAG: "Removed",
+            ref: r
+          })).concat([{
+              TAG: "Attached",
+              ref: ref,
+              altText: altText
+            }])
         };
       }
     case "Remove" :
@@ -95,15 +160,15 @@ function decide(t, op) {
       if (t.attached.includes(ref$1)) {
         return {
           TAG: "Ok",
-          _0: {
-            TAG: "Removed",
-            ref: ref$1
-          }
+          _0: [{
+              TAG: "Removed",
+              ref: ref$1
+            }]
         };
       } else {
         return {
           TAG: "Ok",
-          _0: undefined
+          _0: []
         };
       }
     case "SetPrimary" :
@@ -112,15 +177,15 @@ function decide(t, op) {
         if (Primitive_object.equal(effectivePrimary(t), ref$2)) {
           return {
             TAG: "Ok",
-            _0: undefined
+            _0: []
           };
         } else {
           return {
             TAG: "Ok",
-            _0: {
-              TAG: "PrimarySet",
-              ref: ref$2
-            }
+            _0: [{
+                TAG: "PrimarySet",
+                ref: ref$2
+              }]
           };
         }
       } else {
@@ -130,38 +195,29 @@ function decide(t, op) {
         };
       }
     case "SetAltText" :
-      let ref$3 = op.ref;
-      if (!t.attached.includes(ref$3)) {
+      return setAltText(t, op.ref, op.altText);
+    case "SetPrimaryAltText" :
+      let ref$3 = effectivePrimary(t);
+      if (ref$3 !== undefined) {
+        return setAltText(t, ref$3, op.altText);
+      } else {
         return {
           TAG: "Error",
           _0: "NotAttached"
         };
       }
-      let altText = op.altText;
-      if (Primitive_object.equal(altTextOf(t, ref$3), altText)) {
-        return {
-          TAG: "Ok",
-          _0: undefined
-        };
-      } else {
-        return {
-          TAG: "Ok",
-          _0: {
-            TAG: "AltTextSet",
-            ref: ref$3,
-            altText: altText
-          }
-        };
-      }
   }
 }
 
 export {
+  cardinalitySchema,
   empty,
   primaryOf,
   effectivePrimary,
   altTextOf,
+  primaryFirst,
   evolve,
+  setAltText,
   decide,
 }
-/* No side effect */
+/* cardinalitySchema Not a pure module */