Add the behaviors API.

packages/@ot-doc/model/src/behaviors/behavior.ts

@@ -0,0 +1,84 @@
+import { $ } from './hkt';
+import { $Struct, AnyDict, Dict } from './struct';
+
+/**
+ * Behavior
+ */
+export type Behavior<T extends AnyDict> = {
+  $string: $<T, string>;
+  $number: $<T, number>;
+  $boolean: $<T, boolean>;
+  $array: <E>(elm: $<T, E>) => $<T, E[]>;
+  $dict: <V>(val: $<T, V>) => $<T, Dict<V>>;
+  $struct: <S extends AnyDict>(struct: $Struct<T, S>) => $<T, S>;
+};
+
+/**
+ * Behavior Definition
+ */
+export type BehaviorDef<
+  Type extends AnyDict,
+  Base extends AnyDict = AnyDict,
+> = {
+  $string: (u: $<Base, string>) => $<Type, string>;
+  $number: (u: $<Base, number>) => $<Type, number>;
+  $boolean: (u: $<Base, boolean>) => $<Type, boolean>;
+  $array: <E>(u: $<Base, E[]>) => (elm: $<Type & Base, E>) => $<Type, E[]>;
+  $dict: <V>(
+    u: $<Base, Dict<V>>,
+  ) => (val: $<Type & Base, V>) => $<Type, Dict<V>>;
+  $struct: <S extends AnyDict>(
+    u: $<Base, S>,
+  ) => (stt: $Struct<Type & Base, S>) => $<Type, S>;
+};
+
+const define = <Type extends AnyDict, Base extends AnyDict>(
+  { $string, $number, $boolean, $array, $dict, $struct }: Behavior<Base>,
+  def: BehaviorDef<Type, Base>,
+) =>
+  ({
+    $string: Object.assign({}, $string, def.$string($string)),
+    $number: Object.assign({}, $number, def.$number($number)),
+    $boolean: Object.assign({}, $boolean, def.$boolean($boolean)),
+    $array: <E>(elm: $<Type & Base, E>) => {
+      const bhv = $array(elm);
+      return Object.assign({}, bhv, def.$array(bhv)(elm));
+    },
+    $dict: <V>(val: $<Type & Base, V>) => {
+      const bhv = $dict(val);
+      return Object.assign({}, bhv, def.$dict(bhv)(val));
+    },
+    $struct: <S extends AnyDict>(stt: $Struct<Type & Base, S>) => {
+      const bhv = $struct(stt);
+      return Object.assign({}, bhv, def.$struct(bhv)(stt));
+    },
+  }) as Behavior<Type & Base>;
+
+type Builder<U extends AnyDict> = {
+  mixin: <T extends AnyDict>(def: BehaviorDef<T, U>) => Builder<T & U>;
+  build: () => Behavior<U>;
+};
+
+const builder = <T extends AnyDict>(bhv: Behavior<T>): Builder<T> => ({
+  mixin: (def) => builder(define(bhv, def)),
+  build: () => bhv,
+});
+
+export const behavior = <T extends AnyDict>(bhv: Behavior<T>) =>
+  ({
+    $string: () => bhv.$string,
+    $number: () => bhv.$number,
+    $boolean: () => bhv.$boolean,
+    $array: () => bhv.$array,
+    $dict: () => bhv.$dict,
+    $struct: () => bhv.$struct,
+  }) as BehaviorDef<T>;
+
+export const BehaviorBuilder = builder({
+  $string: {},
+  $number: {},
+  $boolean: {},
+  $array: () => ({}),
+  $dict: () => ({}),
+  $struct: () => ({}),
+});

packages/@ot-doc/model/src/behaviors/editable.ts

@@ -0,0 +1,105 @@
+import { Maybe, just, nothing } from "./maybe";
+import { BehaviorDef } from "./behavior";
+import { $Var } from "./variables";
+import { Action, ObjectOp, Op, Prim } from "./operation";
+import { $Struct, reduceDict, reduceStruct } from "./struct";
+import { Eq } from "./eq";
+import { Preset } from "./preset";
+
+export type Result<T> = { value: T, op: Op<T> };
+
+export type Update<T> = (action: Action<T>) => (a: T) => Maybe<Result<T>>;
+export type Editable<T = $Var> = { update: Update<T> };
+
+const withUpdate = <T>(update: Update<T>): Editable<T> => ({ update });
+const constant = <T>(value: T) => () => value;
+
+const withUpdatePrim = <T extends Prim>({ preset }: Preset<T>): Editable<T> =>
+  withUpdate((action) => (v) => {
+    const op = action(v);
+    const { o = preset, n = preset } = op;
+    return o === v ? just({ value: n as T, op }) : nothing();
+  });
+
+const editable: BehaviorDef<Editable, Eq & Preset> = {
+  $string: withUpdatePrim,
+  $number: withUpdatePrim,
+  $boolean: withUpdatePrim,
+  $array:
+    ({ eq }) =>
+    () =>
+      withUpdate((updater) => (arrOld) => {
+        const op = updater(arrOld);
+        const { i: ins, d: del } = op;
+        if (del.length === 0 && ins.length === 0)
+          return just({ value: arrOld, op });
+        const arrNew = [...arrOld];
+        for (const { i: idx, a: arr } of del) {
+          if (
+            idx > arrNew.length ||
+            idx < 0 ||
+            !eq(arr)(arrNew.slice(idx, idx + arr.length))
+          )
+            return nothing();
+          arrNew.splice(idx, arr.length);
+        }
+        for (const { i: idx, a: arr } of ins) {
+          if (idx > arrNew.length || idx < 0) return nothing();
+          arrNew.splice(idx, 0, ...arr);
+        }
+        return just({ value: arrNew, op });
+      }),
+  $dict:
+    () =>
+    ({ update, preset, eq }) =>
+      withUpdate((action) => (dictOld) => {
+        const op = action(dictOld);
+        return reduceDict(
+          op,
+          (m, opVal, key) => {
+            if (m.$ === 'Nothing' || !opVal || typeof key !== 'string')
+              return m;
+            const valOld = dictOld[key] ?? preset;
+            const mResult = update(constant(opVal))(valOld);
+            if (mResult.$ === 'Nothing') return nothing();
+            const { value } = mResult.v;
+            if (!eq(dictOld[key])(value)) {
+              if (m.v.value === dictOld) {
+                m.v.value = { ...dictOld };
+              }
+              if (eq(preset)(value)) {
+                delete m.v.value[key];
+              } else {
+                m.v.value[key] = value;
+              }
+            }
+            return m;
+          },
+          just({ value: dictOld, op })
+        );
+      }),
+  $struct: <S extends object>() => (sttDoc: $Struct<Editable & Eq & Preset, S>) =>
+    withUpdate((updater: Action<S>) => (sttOld: S): Maybe<Result<S>> => {
+      const op = updater(sttOld);
+      const opObj = op as ObjectOp<S>;
+      return reduceStruct(
+        sttOld,
+        <K extends keyof S>(m: Maybe<Result<S>>, valOld: S[K], key: K) => {
+          if (m.$ === 'Nothing' || !opObj[key]) return m;
+          const mResult = sttDoc[key].update(constant(opObj[key]))(valOld);
+          if (mResult.$ === 'Nothing') return nothing();
+          const { value } = mResult.v;
+          if (!sttDoc[key].eq(valOld)(value)) {
+            if (m.v.value === sttOld) {
+              m.v.value = { ...sttOld };
+            }
+            m.v.value[key] = value;
+          }
+          return m;
+        },
+        just({ value: sttOld, op })
+      );
+    }),
+};
+
+export default editable;

packages/@ot-doc/model/src/behaviors/eq.ts

@@ -0,0 +1,32 @@
+import { $Var } from "./hkt";
+import { behavior } from "./behavior";
+
+export type Relation<T> = (a: T) => (b: T) => boolean;
+export type Eq<T = $Var> = { eq: Relation<T> };
+
+const withEq = <T>(f: Relation<T> = () => () => false): Eq<T> => ({
+  eq: (a) => (b) => a === b || f(a)(b),
+});
+
+export const eq = behavior<Eq>({
+  $string: withEq(),
+  $number: withEq(),
+  $boolean: withEq(),
+  $array: ({ eq }) =>
+    withEq((a) => (b) => {
+      if (a.length !== b.length) return false;
+      for (let i = 0; i < a.length; i += 1) if (!eq(a[i])(b[i])) return false;
+      return true;
+    }),
+  $dict: ({ eq }) =>
+    withEq((a) => (b) => {
+      for (const key in a) if (!(key in b) || !eq(a[key])(b[key])) return false;
+      for (const key in b) if (!(key in a)) return false;
+      return true;
+    }),
+  $struct: (stt) =>
+    withEq((a) => (b) => {
+      for (const key in stt) if (!stt[key].eq(a[key])(b[key])) return false;
+      return true;
+    }),
+});

packages/@ot-doc/model/src/behaviors/hkt.ts

@@ -0,0 +1,20 @@
+import { Op } from "./operation";
+import { $OpVar, $Var } from "./variables";
+
+
+// Type application (substitutes type variables with types)
+export type $<T, S = $Var> = T extends $Var
+  ? S
+  : T extends $OpVar
+  ? Op<S>
+  : T extends undefined | null | boolean | string | number
+  ? T
+  : T extends Array<infer A>
+  ? $<A, S>[]
+  : T extends (...args: infer Args) => infer R
+  ? (...x: { [K in keyof Args]: $<Args[K], S> }) => $<R, S>
+  : T extends object
+  ? { [K in keyof T]: $<T[K], S> }
+  : T;
+
+export type { $Var };

packages/@ot-doc/model/src/behaviors/maybe.ts

@@ -0,0 +1,6 @@
+// $: Constructor type
+// v: the value
+export type Maybe<T> = { $: 'Nothing' } | { $: 'Just'; v: T };
+
+export const nothing = <T>(): Maybe<T> => ({ $: 'Nothing' });
+export const just = <T>(v: T): Maybe<T> => ({ $: 'Just', v });

packages/@ot-doc/model/src/behaviors/operation.ts

@@ -0,0 +1,49 @@
+import { $Var, $OpVar } from "./variables";
+
+export type Prim = string | number | boolean;
+
+/**
+ * Update a primitive value
+ * @param o the old value
+ * @param n to value
+ */
+export type PrimOp<T extends Prim> = {
+  o?: T;
+  n?: T;
+  t: number;
+};
+
+/**
+ * Update a segment in an array, could be deletion or insertion
+ * @param i index
+ * @param a array of values
+ */
+export type ArrayOplet<T> = { i: number; a: T[] };
+
+/**
+ * Update array
+ * @param d deletions
+ * @param i insertions
+ */
+export type ArrayOp<T> = { d: ArrayOplet<T>[]; i: ArrayOplet<T>[] };
+
+/**
+ * Struct op
+ */
+export type ObjectOp<T extends object> = Partial<{ [K in keyof T]: Op<T[K]> }>;
+
+export type Op<T> = T extends $Var
+  ? $OpVar
+  : T extends string
+  ? PrimOp<string>
+  : T extends number
+  ? PrimOp<number>
+  : T extends boolean
+  ? PrimOp<boolean>
+  : T extends Array<infer E>
+  ? ArrayOp<E>
+  : T extends object
+  ? ObjectOp<T>
+  : never;
+
+export type Action<T> = (v: T) => Op<T>;