@reventlessdev/reventless-spec 3.0.0-alpha.126 → 3.0.0-alpha.128

package/src/semantic/CaptionedImage.res

@@ -0,0 +1,100 @@
+/**
+An image the platform stores, together with the text that goes with it.
+
+## Why the text travels with the reference
+
+A picture and the words that describe it are one thing, and holding them apart is
+what let them drift. A view that carried an image field and a caption field
+beside it had to keep the pair in step on every arm of its projection, and the
+one arm that forgot produced a hero image with no alternative text — an
+accessibility hole opened by a projection, not by a missing command.
+
+Inside one value there is no pair to keep in step. It also puts the text where a
+renderer can reach it: a cell renderer is handed a field's key, its schema and
+its value, and never the row — so a caption in a *sibling field* is a caption no
+cell can draw.
+
+## Two texts, not one
+
+They are different things and one does not substitute for the other.
+**`altText` replaces** the image: what a screen reader announces instead of it,
+what shows when it fails to load. **`caption` sits beside** it, visible to
+everyone. `altText: "Blue running shoe, side profile"` and
+`caption: "Front view"` are both correct and neither does the other's job.
+
+A consumer resolves them like this, and the rules are written down because a
+wrong one is silent:
+
+- **the visible caption** is `caption` only. Absent means no visible text.
+- **`alt`** is `altText`, else `caption`, else `""`.
+
+The fallback through `caption` is deliberate and slightly impure. The pure rule —
+`altText` else `""` — makes a host that filled only `caption` emit `alt=""` on
+every photo, which declares them decorative. An imperfect accessible name is
+better than a wrong one.
+
+## No store argument on the field
+
+The store is the host field's name, pluralised, derived by the ppx exactly as it
+is for {!UploadableImage} — and the rule is idempotent, so `productImages:
+array<CaptionedImage.t>` and `categoryImage?: CaptionedImage.t` both derive the
+store their host means. The marker lands on this record rather than on the `ref`
+inside it, which is what lets `StorageRef.getFieldStore` find the store through
+an array wrapper without looking a level deeper.
+
+## A pair, not a general type
+
+Monomorphic on purpose: the ppx matches the *spelling* of a field's type under an
+empty type-argument list, so an `Attachment.t<'ref>` would not match and no store
+would be derived — silently. A document counterpart is a second type for the
+reason {!UploadableImage} and {!UploadableFile} are two: they differ in what the
+value depicts, not in how a reference to it is written. It would carry no
+`altText`, because a document has no visual to replace.
+
+@example
+```rescript
+@schema type state = {
+  productId: string,
+  productImages: array<Reventless.CaptionedImage.t>,
+}
+```
+*/
+
+/** The record itself. No `@schema`: the derived schema would have to name a
+    store, and the store is the host field's — so `forField` is the only way to
+    a schema, and a field the ppx did not reach fails to compile rather than
+    provisioning a store nobody meant. */
+type t = {
+  ref: UploadableImage.t,
+  altText?: string,
+  caption?: string,
+}
+
+/**
+The sury schema for a field holding captioned images out of a named store.
+
+Prefer typing the field `CaptionedImage.t` (or `array<CaptionedImage.t>`) and
+letting the ppx call this. Written by hand it needs the derived store name, which
+defeats the point of the type.
+*/
+let forField = (~plugin: option<string>=?, ~store: string): S.t<t> =>
+  S.schema(s => {
+    ref: s.matches(UploadableImage.forField(~plugin?, ~store)),
+    altText: ?s.matches(S.option(S.string)),
+    caption: ?s.matches(S.option(S.string)),
+  })->Semantic.mark(
+    ~id=Semantic.Id.captionedImage,
+    // The store rides on the record, not on `ref`: a field reader looks through
+    // an optional wrapper and an array element and no further, so a marker one
+    // record deeper would be a store declaration nothing provisions.
+    ~payload=StoredIn({plugin, store, threshold: None}),
+  )
+
+/** The text that replaces the image, by the rule above — `altText`, else the
+    caption, else nothing. One definition, because a second one would be the
+    drift this type exists to remove. */
+let altTextOf = (c: t): option<string> =>
+  switch c.altText {
+  | Some(_) as text => text
+  | None => c.caption
+  }

package/src/semantic/CaptionedImage.res.mjs

@@ -0,0 +1,35 @@
+// Generated by ReScript, PLEASE EDIT WITH CARE
+
+import * as Sury from "sury";
+import * as Semantic$Reventless from "./Semantic.res.mjs";
+import * as UploadableImage$Reventless from "./UploadableImage.res.mjs";
+
+function forField(plugin, store) {
+  return Semantic$Reventless.mark(Sury.$schema(s => ({
+    ref: s.m(UploadableImage$Reventless.forField(plugin, store)),
+    altText: s.m(Sury.$option(Sury.string)),
+    caption: s.m(Sury.$option(Sury.string))
+  })), Semantic$Reventless.Id.captionedImage, {
+    TAG: "StoredIn",
+    _0: {
+      plugin: plugin,
+      store: store,
+      threshold: undefined
+    }
+  });
+}
+
+function altTextOf(c) {
+  let text = c.altText;
+  if (text !== undefined) {
+    return text;
+  } else {
+    return c.caption;
+  }
+}
+
+export {
+  forField,
+  altTextOf,
+}
+/* sury Not a pure module */

package/src/semantic/Duration.res

@@ -1,29 +1,10 @@
 /**
-Marks an `int` field as a length of time, in **seconds**.
+Marks an `int` field as a length of time, in **seconds** — whole, zero or
+greater. Zero is a real duration.
 
-## Why a scalar, and why seconds are part of the type
-
-The obvious richer design is `{value, unit}`. It is not available here, and the
-reason is the reason this whole set of types is safe to add: a record is an
-*object* on the wire, so adopting it would turn every field that used it into a
-decode failure against events already written. These types are additive
-precisely because they stay scalars. A duration that carries its unit is a
-different type for a different plan, not a later version of this one — widening
-this one would retroactively hand an upcaster obligation to every field that had
-already adopted it.
-
-Seconds, because that is what the renderer reads: it formats `3660` as
-`"1h 1m"`. Milliseconds would be off by a factor of a thousand and would
-render as weeks, which is the same class of silent wrongness `Percent` avoids by
-matching its gauge.
-
-`int` is right here where it was wrong for `Bytes`: int32 seconds is 68 years,
-which no duration field needs to exceed.
-
-## The grammar
-
-A whole number of seconds, zero or greater. Zero is a real duration — an instant
-timeout, a zero-length window.
+Seconds because that is the unit `format` reads; milliseconds would render as
+weeks. A scalar rather than `{value, unit}` so the type stays additive on the
+wire. `int` is safe here — int32 seconds is 68 years.
 
 @example
 ```rescript
@@ -51,3 +32,20 @@ let fromInt = (raw: int): result<t, string> =>
 /** The sury schema for a duration field, in seconds.
     Use with `@s.matches(Reventless.Duration.schema)`. */
 let schema: S.t<t> = S.int->Semantic.refined(~id=Semantic.Id.duration, ~check=fromInt)
+
+let scales = [(86400, "d"), (3600, "h"), (60, "m"), (1, "s")]
+
+/** The duration as text, largest unit first and zero units dropped — `3660` is
+    `"1h 1m"`, `0` is `"0s"`. Locale-independent, the way `Money.format` is. */
+let format = (d: t): string => {
+  let remaining = ref(d < 0 ? 0 : d)
+  let parts = []
+  scales->Array.forEach(((size, suffix)) => {
+    let count = remaining.contents / size
+    if count > 0 {
+      parts->Array.push(Int.toString(count) ++ suffix)
+      remaining := remaining.contents - count * size
+    }
+  })
+  Array.length(parts) == 0 ? "0s" : parts->Array.join(" ")
+}

package/src/semantic/Duration.res.mjs

@@ -1,6 +1,7 @@
 // Generated by ReScript, PLEASE EDIT WITH CARE
 
 import * as Sury from "sury";
+import * as Primitive_int from "@rescript/runtime/lib/es6/Primitive_int.js";
 import * as Semantic$Reventless from "./Semantic.res.mjs";
 
 function fromInt(raw) {
@@ -19,8 +20,50 @@ function fromInt(raw) {
 
 let schema = Semantic$Reventless.refined(Sury.int, Semantic$Reventless.Id.duration, fromInt);
 
+let scales = [
+  [
+    86400,
+    "d"
+  ],
+  [
+    3600,
+    "h"
+  ],
+  [
+    60,
+    "m"
+  ],
+  [
+    1,
+    "s"
+  ]
+];
+
+function format(d) {
+  let remaining = {
+    contents: d < 0 ? 0 : d
+  };
+  let parts = [];
+  scales.forEach(param => {
+    let size = param[0];
+    let count = Primitive_int.div(remaining.contents, size);
+    if (count > 0) {
+      parts.push(count.toString() + param[1]);
+      remaining.contents = remaining.contents - (count * size | 0) | 0;
+      return;
+    }
+  });
+  if (parts.length === 0) {
+    return "0s";
+  } else {
+    return parts.join(" ");
+  }
+}
+
 export {
   fromInt,
   schema,
+  scales,
+  format,
 }
 /* schema Not a pure module */

package/src/semantic/MemberRef.res

@@ -0,0 +1,119 @@
+/**
+A reference to a member of a collection the row already holds.
+
+The distinction this type exists to make is **input versus selection**. A field
+typed {!UploadableImage} says "give me a new file", and a UI reading it binds an
+upload endpoint. A field that must name a picture the row *already has* — remove
+this one, make that one primary, caption the third — says something else
+entirely, and before this type there was no way to say it: every such field was
+typed as the uploadable it selected among, so every one of them offered an
+uploader. On a remove command that is not merely odd, it is the opposite of what
+the command does.
+
+## What it declares, and what it does not
+
+It declares where the candidates are: a field of the row, by name. It declares
+no store — nothing is provisioned, no upload endpoint is bound — for the same
+reason {!ImageRef} declares none, and with the same consequence: a consumer
+asking `StorageRef.getFieldStore` gets `None`.
+
+The *semantic* is content-agnostic: one id serves images and documents, and what
+a member is comes from `~content`. That argument is optional and, where a caller
+gives it, redundant with the collection's own element type — deliberately, and
+for the reason {!UploadableImage} exists at all rather than a storage ref beside
+a content annotation. A consumer rendering one cell holds that field's schema and
+nothing else; it cannot reach a sibling's element type, so a declaration that
+made it look would be a declaration it could not read. Omit it and such a
+consumer falls back to its own rules, which is the right answer for a member type
+this vocabulary has no word for.
+
+## Why not `Reference.to_`
+
+A reference resolves its candidates by querying the target view's table. These
+candidates are on the row already in hand, so there is no query: same shape of
+answer, different resolution path, and pointing a query at it would scan a table
+to re-read a value the caller is holding. `Reference.toWithoutDcbTag` is the
+precedent that a payload can be reused without dragging DCB tagging along; this
+is the converse — a payload that resolves locally.
+
+## Where it goes
+
+**On a command field**, and there it means *pick one of these*:
+
+```rescript
+@schema type command =
+  | RemoveProductImage({
+      productId: @s.matches(DcbTag.string) string,
+      productImage: @s.matches(Reventless.MemberRef.of_(~view="Products", ~field="productImages")) string,
+    })
+```
+
+`~view` names the collection's view. Omit it on a declaration made *on* that
+view's own state, where the answer is "this record" — the wrapper walk below
+supports that position, and `getFieldTarget` reads it. Nothing in the framework
+declares one there today: a view that carried a scalar *and* the set it was
+drawn from needed a marker saying the two were one thing, and a view whose
+primary is simply the first member has no second field to reconcile.
+*/
+
+/** Transparent `string`, as every ref-shaped semantic here is: the marker
+    refines an existing field rather than replacing it, so nothing stored
+    changes when a field adopts it. */
+type t = string
+
+external unsafe: string => t = "%identity"
+external toString: t => string = "%identity"
+
+/** Which collection a field names a member of. */
+type target = Semantic.memberTarget
+
+/**
+The sury schema for a field that selects a member of `field`.
+
+`~view` names the collection's view; omit it on a declaration made *on* that
+view's own state, where the answer is "this record". `~plugin` qualifies a view
+another plugin owns. `~content` names what the members are — pass
+`Semantic.Id.imageRef` for a set of pictures — so a reader holding this field
+alone still knows what it is drawing.
+
+No grammar is checked. The value is whatever the collection's own element type
+admits — a storage ref today, and checking the ref grammar a second time here
+would put {!StorageRef}'s rules in a second place to drift from. What makes a
+selection valid is that the row holds it, and only the decider knows that.
+*/
+let of_ = (
+  ~plugin: option<string>=?,
+  ~view: option<string>=?,
+  ~content: option<string>=?,
+  ~field: string,
+): S.t<t> =>
+  S.string->Semantic.mark(
+    ~id=Semantic.Id.memberRef,
+    ~payload=MemberOf({view, field, plugin, content}),
+  )
+
+/** The collection a schema names, if it carries the marker. */
+let getTarget = (schema: S.t<'a>): option<target> =>
+  switch Semantic.get(schema) {
+  | Some({payload: MemberOf(target)}) => Some(target)
+  | _ => None
+  }
+
+/**
+The collection a *field* names, looking through the wrappers around its value.
+
+The distinction `Reference.getFieldTarget` draws applies here for the same
+reason: `of_` returns an element schema, so on an `array<string>` of selections
+the marker sits on the string inside the array and the field's own schema
+carries nothing. Only the optional wrapper and the array element are followed —
+a marker on a nested record's field belongs to that field.
+*/
+let rec getFieldTarget = (schema: S.t<unknown>): option<target> =>
+  switch getTarget(schema) {
+  | Some(_) as found => found
+  | None =>
+    switch schema->Semantic.unwrapOptional->Option.getOr(schema) {
+    | Array({additionalItems: Schema(item)}) => getFieldTarget(item)
+    | _ => None
+    }
+  }

package/src/semantic/MemberRef.res.mjs

@@ -0,0 +1,57 @@
+// 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 Semantic$Reventless from "./Semantic.res.mjs";
+
+function of_(plugin, view, content, field) {
+  return Semantic$Reventless.mark(Sury.string, Semantic$Reventless.Id.memberRef, {
+    TAG: "MemberOf",
+    _0: {
+      view: view,
+      field: field,
+      plugin: plugin,
+      content: content
+    }
+  });
+}
+
+function getTarget(schema) {
+  let match = Semantic$Reventless.get(schema);
+  if (match === undefined) {
+    return;
+  }
+  let target = match.payload;
+  if (typeof target !== "object" || target.TAG !== "MemberOf") {
+    return;
+  } else {
+    return target._0;
+  }
+}
+
+function getFieldTarget(_schema) {
+  while (true) {
+    let schema = _schema;
+    let found = getTarget(schema);
+    if (found !== undefined) {
+      return found;
+    }
+    let match = Stdlib_Option.getOr(Semantic$Reventless.unwrapOptional(schema), schema);
+    if (match.type !== "array") {
+      return;
+    }
+    let item = match.additionalItems;
+    if (item === "strip" || item === "strict") {
+      return;
+    }
+    _schema = item;
+    continue;
+  };
+}
+
+export {
+  of_,
+  getTarget,
+  getFieldTarget,
+}
+/* sury Not a pure module */

package/src/semantic/Messaging.res

@@ -45,6 +45,30 @@ let channelToString = (channel: channel): string =>
   | Push => "Push"
   }
 
+/**
+The `From:` header a deployment's email sender presents as: the bare address, or
+a display name in front of it.
+
+Provider-neutral for the reason everything else here is — the header is the
+RFC's, not a transport's, and two backends formatting it apart would present the
+same deployment under two names. It is applied where the sender is *provisioned*
+rather than at the send, so a transport receives one string and never has to know
+whether a name was configured.
+
+Quoted and escaped unconditionally rather than only when the name looks like it
+needs it. The unquoted form excludes characters an ordinary shop name carries — a
+comma above all, which would otherwise split the header into two addresses — and a
+rule applied only where it looks necessary is a rule that gets the exceptions
+wrong.
+*/
+let fromHeader = (~displayName: option<string>, ~address: string): string =>
+  switch displayName {
+  | None => address
+  | Some(name) =>
+    let escaped = name->String.replaceAll("\\", "\\\\")->String.replaceAll("\"", "\\\"")
+    `"${escaped}" <${address}>`
+  }
+
 /**
 What to say.
 

package/src/semantic/Messaging.res.mjs

@@ -23,6 +23,14 @@ function channelToString(channel) {
   }
 }
 
+function fromHeader(displayName, address) {
+  if (displayName === undefined) {
+    return address;
+  }
+  let escaped = displayName.replaceAll("\\", "\\\\").replaceAll("\"", "\\\"");
+  return `"` + escaped + `" <` + address + `>`;
+}
+
 function retriable(failure) {
   switch (failure.TAG) {
     case "Unavailable" :
@@ -50,6 +58,7 @@ function supports(provider, recipient) {
 export {
   channelOf,
   channelToString,
+  fromHeader,
   retriable,
   failureReason,
   supports,

package/src/semantic/Offload.res.mjs

@@ -110,7 +110,7 @@ function getStore(schema) {
     return;
   }
   let target = match.payload;
-  if (typeof target !== "object" || target.TAG === "ReferenceTo" || match.id !== Semantic$Reventless.Id.offload) {
+  if (typeof target !== "object" || target.TAG !== "StoredIn" || match.id !== Semantic$Reventless.Id.offload) {
     return;
   } else {
     return target._0;
@@ -123,7 +123,7 @@ function getThreshold(schema) {
     return;
   }
   let match$1 = match.payload;
-  if (typeof match$1 !== "object" || match$1.TAG === "ReferenceTo" || match.id !== Semantic$Reventless.Id.offload) {
+  if (typeof match$1 !== "object" || match$1.TAG !== "StoredIn" || match.id !== Semantic$Reventless.Id.offload) {
     return;
   } else {
     return match$1._0.threshold;

package/src/semantic/Percent.res

@@ -1,24 +1,9 @@
 /**
-Marks a `float` field as a percentage, expressed **0–100**.
+Marks a `float` field as a percentage, expressed **0–100**, not 0–1.
 
-## Why 0–100 and not 0–1
-
-Both conventions are defensible in the abstract, so the tie is broken by the
-consumer that already exists: the dashboard gauges a field with this semantic
-against fixed bounds of 0 and 100, and formats `42.0` as `"42%"`. Under a 0–1
-convention every value would render as a rounding error near zero — a gauge
-pinned at empty and a label reading `"0.42%"`.
-
-That failure is quiet, and it is quiet in the worst way: the numbers are
-*present* and *wrong*, and the layer at fault is not the one showing the symptom.
-Agreeing with the renderer costs nothing; disagreeing costs an afternoon.
-
-A fraction is still perfectly good arithmetic — it just multiplies by 100 before
-it becomes this type.
-
-## The grammar
-
-A finite number in `[0, 100]`. Fractions are allowed: `99.95` is a percentage.
+The scale is what every consumer gauges and formats against, so a fraction
+multiplies by 100 before it becomes this type. A finite number in `[0, 100]`;
+fractions are allowed — `99.95` is a percentage.
 
 @example
 ```rescript
@@ -30,7 +15,7 @@ A finite number in `[0, 100]`. Fractions are allowed: `99.95` is a percentage.
 */
 
 /** The percentage's representation. Transparent `float`: the marker refines an
-    existing numeric field rather than replacing it, so nothing stored changes. */
+    existing numeric field, so nothing stored changes. */
 type t = float
 
 external unsafe: float => t = "%identity"
@@ -51,3 +36,7 @@ let fromFloat = (raw: float): result<t, string> =>
 
 /** The sury schema for a percentage field. Use with `@s.matches(Reventless.Percent.schema)`. */
 let schema: S.t<t> = S.float->Semantic.refined(~id=Semantic.Id.percent, ~check=fromFloat)
+
+/** The percentage as text — `"42%"`, `"99.95%"`. Locale-independent, the way
+    `Money.format` is. */
+let format = (p: t): string => Float.toString(p) ++ "%"

package/src/semantic/Percent.res.mjs

@@ -26,8 +26,13 @@ function fromFloat(raw) {
 
 let schema = Semantic$Reventless.refined(Sury.float, Semantic$Reventless.Id.percent, fromFloat);
 
+function format(p) {
+  return p.toString() + "%";
+}
+
 export {
   fromFloat,
   schema,
+  format,
 }
 /* schema Not a pure module */

package/src/semantic/Semantic.res

@@ -18,11 +18,39 @@ type referenceTarget = {entity: string, plugin: option<string>}
     when it defers to the platform default. */
 type storeTarget = {plugin: option<string>, store: string, threshold: option<int>}
 
+/**
+Which collection a value names a member of.
+
+`field` is the collection's field name on the row — the only thing a consumer
+needs, because the candidates are already loaded. `view` names the view that
+collection belongs to and is absent where the answer is "the row this field is
+on", which is every declaration made on a view's own state. `plugin` is absent
+for the declaring plugin's own view, as everywhere else here.
+
+Unlike `referenceTarget` this is deliberately not resolvable by query: the
+members are on the row, so a consumer that went looking for a table has
+misread it.
+
+`content` names what a member *is* — an `imageRef`/`fileRef` id — and is the one
+part of this that is not about the collection. It rides here for the reason
+`uploadableImage` exists at all rather than `storageRef` beside a content
+annotation: the collection's own element type already says it, but a consumer
+holding one field's schema cannot reach a sibling's, and one that renders a cell
+holds exactly that. Absent leaves the reader to its own rules, which is what a
+host attaching something the vocabulary has no word for should get. */
+type memberTarget = {
+  view: option<string>,
+  field: string,
+  plugin: option<string>,
+  content: option<string>,
+}
+
 /** Per-semantic detail, for the semantics that carry any. */
 type payload =
   | Plain
   | ReferenceTo(referenceTarget)
   | StoredIn(storeTarget)
+  | MemberOf(memberTarget)
 
 /** A field's semantic: the vocabulary id, plus its detail. */
 type t = {id: string, payload: payload}
@@ -45,6 +73,16 @@ module Id = {
   let imageRef = "imageRef"
   let fileRef = "fileRef"
 
+  // An image and the text that goes with it, in one value. Declares its store
+  // the way `uploadableImage` does, on the record rather than on the reference
+  // inside it, so a field reader finds it through an array wrapper.
+  let captionedImage = "captionedImage"
+
+  // A selection rather than an input: the value names a member of a collection
+  // the row already holds. Declares no store, so nothing is provisioned and no
+  // upload endpoint is bound — the distinction `uploadableImage` could not make.
+  let memberRef = "memberRef"
+
   // Branded scalars: a refinement, so adopting one changes nothing stored.
   let email = "email"
   let phone = "phone"
@@ -116,6 +154,31 @@ let unwrapOptional = (schema: S.t<unknown>): option<S.t<unknown>> =>
   | _ => None
   }
 
+/**
+One arm of a command or event union, found by its tag.
+
+A union with exactly one constructor is emitted as a bare object carrying the
+TAG rather than a one-element `AnyOf`, so both shapes are matched.
+*/
+let unionVariant = (schema: S.t<unknown>, ~variant: string): option<S.t<unknown>> => {
+  let isVariant = (properties: dict<S.t<unknown>>) =>
+    switch properties->Dict.get("TAG") {
+    | Some(String({const: ?Some(name)})) => name == variant
+    | _ => false
+    }
+  switch schema {
+  | AnyOf({anyOf}) =>
+    anyOf->Array.find(arm =>
+      switch arm {
+      | Object({properties}) => isVariant(properties)
+      | _ => false
+      }
+    )
+  | Object({properties}) => isVariant(properties) ? Some(schema) : None
+  | _ => None
+  }
+}
+
 /**
 The semantic a field's schema carries, if any.