feat: finish fast-check schemable integration

Removed the IntersectArbitrary implementation in favor of an intersect defined
by dubzzz from fast-check that uses tuple and map. Also lifted the fast-check
library as a type to be supplied in order to create the Arbitrary Schemable.
Updated tests. Added sequential Flatmappable export ot async.ts. Added a
flatmappable transformers example to exmaples and updated the traverse example.

async.ts

@@ -154,6 +154,16 @@ export const FlatmappableAsync: Flatmappable<KindAsync> = {
   wrap,
 };
 
+/**
+ * @since 2.0.1
+ */
+export const FlatmappableAsyncSeq: Flatmappable<KindAsync> = {
+  apply: applySequential,
+  flatmap,
+  map,
+  wrap,
+};
+
 /**
  * @since 2.0.0
  */

contrib/fast-check.ts

@@ -1,62 +1,48 @@
-import type { Arbitrary, Random, Stream, Value } from "npm:fast-check@3.14.0";
+import type * as FC from "npm:fast-check@3.14.0";
+import type { Kind, Out, Spread } from "../kind.ts";
 import type {
-  IntersectSchemable,
   LiteralSchemable,
   Schemable,
   TupleSchemable,
 } from "../schemable.ts";
-import type { Kind, Out } from "../kind.ts";
-
-import * as fc from "npm:fast-check@3.14.0";
-export * from "npm:fast-check@3.14.0";
 
+/**
+ * Specifies Arbitrary from fast-check as a Higher Kinded Type.
+ *
+ * @since 2.0.0
+ */
 export interface KindArbitrary extends Kind {
-  readonly kind: Arbitrary<Out<this, 0>>;
+  readonly kind: FC.Arbitrary<Out<this, 0>>;
 }
 
-export class IntersectArbitrary<U, V> extends fc.Arbitrary<U & V> {
-  constructor(private first: Arbitrary<U>, private second: Arbitrary<V>) {
-    super();
-  }
-
-  generate(mrng: Random, biasFactor: number | undefined): Value<U & V> {
-    const fst = this.first.generate(mrng, biasFactor);
-    const snd = this.second.generate(mrng, biasFactor);
-    return new fc.Value(
-      Object.assign({}, fst.value, snd.value),
-      mrng.nextInt(),
-    );
-  }
-
-  canShrinkWithoutContext(value: unknown): value is U & V {
-    return this.first.canShrinkWithoutContext(value) &&
-      this.second.canShrinkWithoutContext(value);
-  }
-
-  shrink(value: U & V, context: unknown): Stream<Value<U & V>> {
-    return fc.Stream.of(new fc.Value(value, context));
-  }
+/**
+ * Given an API that matches the default exports of fast-check at version 3.14.0
+ * create a Schemable for Arbitrary.
+ *
+ * @since 2.0.1
+ */
+export function getSchemableArbitrary(fc: typeof FC): Schemable<KindArbitrary> {
+  return {
+    unknown: fc.anything,
+    string: fc.string,
+    number: fc.float,
+    boolean: fc.boolean,
+    literal: fc.constantFrom as LiteralSchemable<KindArbitrary>["literal"],
+    nullable: fc.option,
+    undefinable: fc.option,
+    record: <T>(arb: FC.Arbitrary<T>) => fc.dictionary(fc.string(), arb),
+    array: fc.array,
+    tuple: fc.tuple as TupleSchemable<KindArbitrary>["tuple"],
+    struct: fc.record,
+    partial: (items) => fc.record(items, { requiredKeys: [] }),
+    intersect: (second) => (first) =>
+      fc.tuple(first, second).map(([first, second]) =>
+        Object.assign({}, first, second) as Spread<
+          (typeof first) & (typeof second)
+        >
+      ),
+    union: (second) => (first) => fc.oneof(first, second),
+
+    lazy: (_id, builder) => fc.memo(builder)(),
+  };
 }
-
-export const SchemableArbitrary: Schemable<KindArbitrary> = {
-  unknown: fc.anything,
-  string: fc.string,
-  number: fc.float,
-  boolean: fc.boolean,
-  literal: fc.constantFrom as LiteralSchemable<KindArbitrary>["literal"],
-  nullable: fc.option,
-  undefinable: fc.option,
-  record: <T>(arb: Arbitrary<T>) => fc.dictionary(fc.string(), arb),
-  array: fc.array,
-  tuple: fc.tuple as TupleSchemable<KindArbitrary>["tuple"],
-  struct: fc.record,
-  partial: (items) => fc.record(items, { requiredKeys: [] }),
-  intersect:
-    ((second) => (first) =>
-      new IntersectArbitrary(first, second)) as IntersectSchemable<
-        KindArbitrary
-      >["intersect"],
-  union: (second) => (first) => fc.oneof(first, second),
-
-  lazy: (_id, builder) => fc.memo(builder)(),
-};

examples/schema.ts

@@ -1,7 +1,8 @@
+import * as FC from "npm:fast-check@3.14.0";
 import { schema } from "../schemable.ts";
 import { SchemableDecoder } from "../decoder.ts";
 import { print, SchemableJsonBuilder } from "../json_schema.ts";
-import { sample, SchemableArbitrary } from "../contrib/fast-check.ts";
+import { getSchemableArbitrary } from "../contrib/fast-check.ts";
 import { pipe } from "../fn.ts";
 
 const Vector = schema((s) => s.tuple(s.number(), s.number(), s.number()));
@@ -57,10 +58,10 @@ const SpaceObject = schema((s) =>
 );
 
 const decoder = SpaceObject(SchemableDecoder);
-const arbitrary = SpaceObject(SchemableArbitrary);
+const arbitrary = SpaceObject(getSchemableArbitrary(FC));
 const json_schema = print(SpaceObject(SchemableJsonBuilder));
 
-const rands = sample(arbitrary, 10);
+const rands = FC.sample(arbitrary, 10);
 const checks = rands.map(decoder);
 
 console.log({ json_schema, rands, checks });
@@ -72,5 +73,5 @@ const intersect = schema((s) =>
   )
 );
 
-const iarbitrary = intersect(SchemableArbitrary);
-console.log("Intersect", sample(iarbitrary, 20));
+const iarbitrary = intersect(getSchemableArbitrary(FC));
+console.log("Intersect", FC.sample(iarbitrary, 20));

examples/transformers.ts

@@ -0,0 +1,211 @@
+import type { $, In, InOut, Kind, Out } from "../kind.ts";
+import type { Option } from "../option.ts";
+import type { Flatmappable } from "../flatmappable.ts";
+import type { Fn } from "../fn.ts";
+
+import * as F from "../fn.ts";
+import { createBind, createTap } from "../flatmappable.ts";
+import { createBindTo } from "../mappable.ts";
+import { pipe } from "../fn.ts";
+
+/**
+ * Here we try creating a monad transformer for Fn with a generic kind over Fn.
+ */
+
+export interface TransformFn<U extends Kind> extends Kind {
+  readonly kind: Fn<
+    In<this, 0>,
+    $<
+      U,
+      [Out<this, 0>, Out<this, 1>, Out<this, 2>],
+      [In<this, 1>],
+      [InOut<this, 0>]
+    >
+  >;
+}
+
+export function transformFn<U extends Kind>(
+  FM: Flatmappable<U>,
+): Flatmappable<TransformFn<U>> {
+  return {
+    apply: (ua) => (ufai) => (d) => pipe(ufai(d), FM.apply(ua(d))),
+    map: (fai) => (ua) => pipe(ua, F.map(FM.map(fai))),
+    flatmap: (faui) => (ua) => (d) =>
+      pipe(
+        ua(d),
+        FM.flatmap((a) => faui(a)(d)),
+      ),
+    wrap: (value) => F.wrap(FM.wrap(value)),
+  };
+}
+
+/**
+ * Try transforming FlatmappablePromise with transformFn.
+ */
+
+import { FlatmappablePromise } from "../promise.ts";
+
+export const FFP = transformFn(FlatmappablePromise);
+export const bindToFP = createBindTo(FFP);
+export const bindFP = createBind(FFP);
+export const tapFP = createTap(FFP);
+
+// Should have type { readonly one: number, readonly two: number }
+export const test1 = await pipe(
+  FFP.wrap(1),
+  bindToFP("one"),
+  bindFP("two", ({ one }) => FFP.wrap(one + one)),
+)("yar");
+
+/**
+ * Noticed that Sync<A> is the same type as Fn<never, A> so this is a test to
+ * see if TypeScript allows me to reuse the Fn functions to construct a
+ * Flatmappable for Sync
+ */
+type Sync<A> = Fn<never, A>;
+
+interface KindSync extends Kind {
+  readonly kind: Sync<Out<this, 0>>;
+}
+
+export const FlatmappableSync: Flatmappable<KindSync> = {
+  apply: F.apply,
+  map: F.map,
+  flatmap: F.flatmap,
+  wrap: F.wrap,
+};
+
+/**
+ * Now we try implementing a monad transformer for Promise.
+ */
+
+import * as P from "../promise.ts";
+
+export interface TransformPromise<U extends Kind> extends Kind {
+  readonly kind: Promise<
+    $<
+      U,
+      [Out<this, 0>, Out<this, 1>, Out<this, 2>],
+      [In<this, 0>],
+      [InOut<this, 0>]
+    >
+  >;
+}
+
+/**
+ * The issue here is that we need a join function with a signature of
+ * Promise<U<Promise<U<A>>>> => Promise<U<A>> or maybe a swap function with a
+ * signature of U<Promise<U<A>>> => Promise<U<A>>.
+ *
+ * After some research I found [this](https://web.cecs.pdx.edu/~mpj/pubs/RR-1004.pdf)
+ * and we see that there are several strategies for constructing a monad
+ * composition given one of three functions prod, dorp, or swap.
+ *
+ * I don't fully grok the three constructions, mostly because I'm not fluent in
+ * haskell and haven't taken the time to kill a few trees with notes and trial
+ * and error.
+ *
+ * This construction of transformPromise uses, I think, the dorp construction.
+ */
+export function transformPromise<U extends Kind>(
+  FM: Flatmappable<U>,
+  extract: <
+    I,
+    B = unknown,
+    C = unknown,
+    D = never,
+    E = unknown,
+    J = unknown,
+    K = unknown,
+    L = never,
+    M = unknown,
+  >(
+    va: $<U, [Promise<$<U, [I, J, K], [L], [M]>>, B, C], [D], [E]>,
+  ) => Promise<$<U, [I, B | J, C | K], [D & L], [E & M]>>,
+): Flatmappable<TransformPromise<U>> {
+  return {
+    apply: ((ua) => (ufai) =>
+      pipe(
+        P.all(ua, ufai),
+        // These anys are required as TS has issues using Awaited<A> as A
+        // in the generic positions of $ substitution
+        // deno-lint-ignore no-explicit-any
+        P.map(([va, vfai]) => pipe(vfai as any, FM.apply(va as any))),
+      )) as Flatmappable<TransformPromise<U>>["apply"],
+    flatmap: (faui) => (ua) =>
+      pipe(
+        ua,
+        P.flatmap((va) => pipe(va, FM.map(faui), extract)),
+      ),
+    map: (fai) => (ua) => pipe(ua, P.map(FM.map(fai))),
+    wrap: (a) => P.wrap(FM.wrap(a)),
+  };
+}
+
+/**
+ * Here let's try transforming Option with transformPromise
+ */
+
+import * as O from "../option.ts";
+
+export const FPO = transformPromise(
+  O.FlatmappableOption,
+  /**
+   * The extract function here is illustrative of what's necessary to compose
+   * another monad with Promise. Specifically we need a way to combine  any
+   * state in the outer and inner U monad (here U is Option).
+   */
+  O.match(() => P.wrap(O.none), F.identity),
+);
+
+/**
+ * These tests began as an effort to build the IndexedAsyncState monad
+ * implemented in my `pick` module using monad transformers. I'm still on the
+ * fence with regards to whether this `fun` module should have monad
+ * transformers or even the individual function transformers as implemented in
+ * the new fp-ts builds in effect-ts.
+ *
+ * Further areas of inquiry in this direction could be:
+ *
+ * 1. How much code reuse to we see if we implement composed adts with
+ *    transformers?
+ * 2. Is there a performance difference in those implementations?
+ * 3. Do transformers introduce unnecessary complexity?
+ * 4. The Fn transformer did not require a join function, how many other adts
+ *    will require prod, dorp, or swap?
+ * 5. Will transformers lead to the need to expand type classes beyond type
+ *    constructors of length 5?
+ */
+
+/**
+ * Just for fun, let's make a transformer for Option
+ */
+
+export interface TransformOption<U extends Kind> extends Kind {
+  readonly kind: Option<
+    $<
+      U,
+      [Out<this, 0>, Out<this, 1>, Out<this, 2>],
+      [In<this, 0>],
+      [InOut<this, 0>]
+    >
+  >;
+}
+
+import * as A from "../array.ts";
+const sa = A.sequence(O.FlatmappableOption);
+
+export function transformOption<U extends Kind>(
+  FM: Flatmappable<U>,
+): Flatmappable<TransformOption<U>> {
+  const t = O.traverse(FM)(FM.wrap);
+  return {
+    wrap: (a) => O.wrap(FM.wrap(a)),
+    map: (fai) => (ua) => pipe(ua, O.map(FM.map(fai))),
+    apply: (ua) => (ufai) =>
+      pipe(sa(ua, ufai), O.map(([va, vfai]) => pipe(vfai, FM.apply(va)))),
+
+    // Not sure how to do this.. tired
+    flatmap: (faui) => (ua) => F.todo(),
+  };
+}

examples/traverse.ts

@@ -1,12 +1,14 @@
 import * as A from "../array.ts";
-import * as T from "../async.ts";
+import * as AS from "../async.ts";
+import * as I from "../iterable.ts";
+import * as T from "../tree.ts";
 import { pipe } from "../fn.ts";
 
-const traversePar = A.traverse(T.MonadAsyncParallel);
-const traverseSeq = A.traverse(T.MonadAsyncSequential);
+const traversePar = A.traverse(AS.FlatmappableAsync);
+const traverseSeq = A.traverse(AS.FlatmappableAsyncSeq);
 
 const addNumberToIndex = (a: number, i: number) =>
-  pipe(T.of(a + i), T.delay(100 * a));
+  pipe(AS.wrap(a + i), AS.delay(100 * a));
 
 const sumPar = traversePar(addNumberToIndex);
 const sumSeq = traverseSeq(addNumberToIndex);
@@ -19,3 +21,5 @@ asyncPar().then((result) => console.log("Parallel", result));
 
 // Sequential takes as long as the sum of delays, ~1500ms
 asyncSeq().then((result) => console.log("Sequential", result));
+
+const traverseTreeIterable = T.traverse(I.FlatmappableIterable);