feat: abstract assertMonad and refactor io

Previously, the monad, applicative, functor, and apply laws were mostly tested by an assertMonad function. Unfortunately, this function could not automate the testing of adts like reader, io, task, and their composed forms. assertMonad and its dependencies were extended to take a run parameter that "evaluates" the resultant adt into a plain object wrapped in a promise that can be compared using assertEquals. This allows the use of the assertMonad test for the asynchronous adts. Also, some minor "optimizations" were implemented for io and ioEither
nullpub · Oct 8, 2020 · 8e9f4e1 · 8e9f4e1
1 parent 5e23dad
commit 8e9f4e1
Show file tree

Hide file tree

Showing 15 changed files with 115 additions and 438 deletions.
diff --git a/io.ts b/io.ts
@@ -16,12 +16,12 @@ export type IO<A> = () => A;
  **************************************************************************************************/
 
 export const Functor: TC.Functor<IO<_>> = {
-  map: (fab, ta) => pipe(ta(), fab, constant),
+  map: (fab, ta) => () => fab(ta()),
 };
 
 export const Monad = D.createMonad<IO<_>>({
   of: constant,
-  chain: (fatb, ta) => pipe(ta(), fatb),
+  chain: (fatb, ta) => fatb(ta()),
 });
 
 export const Alt: TC.Alt<IO<_>> = {
@@ -48,7 +48,7 @@ export const Chain: TC.Chain<IO<_>> = {
 
 export const Extends: TC.Extend<IO<_>> = {
   map: Functor.map,
-  extend: (ftab, ta) => constant(ftab(ta)),
+  extend: (ftab, ta) => () => ftab(ta),
 };
 
 export const Foldable: TC.Foldable<IO<_>> = {

diff --git a/io_either.ts b/io_either.ts
@@ -49,11 +49,7 @@ export const orElse = <E, A, M>(onLeft: (e: E) => IOEither<M, A>) =>
  **************************************************************************************************/
 
 export const Functor: TC.Functor<IOEither<_0, _1>, 2> = {
-  map: (fab, ta) =>
-    pipe(
-      ta,
-      I.map(E.map(fab)),
-    ),
+  map: (fab, ta) => pipe(ta, I.map(E.map(fab))),
 };
 
 export const Bifunctor: TC.Bifunctor<IOEither<_0, _1>> = {
@@ -101,13 +97,17 @@ export const Extends: TC.Extend<IOEither<_0, _1>, 2> = {
 
 export const getRightMonad = <E>(
   S: TC.Semigroup<E>,
-): TC.Monad<IOEither<Fix<E>, _>, 1> => ({
-  of: right,
-  ap: (tfab, ta) => pipe(E.getRightMonad(S).ap(tfab(), ta()), constant),
-  map: Monad.map,
-  join: Monad.join,
-  chain: Monad.chain,
-});
+): TC.Monad<IOEither<Fix<E>, _>> => {
+  const { ap } = E.getRightMonad(S);
+
+  return ({
+    of: right,
+    ap: (tfab, ta) => pipe(ap(tfab(), ta()), constant),
+    map: Monad.map,
+    join: Monad.join,
+    chain: Monad.chain,
+  });
+};
 
 /***************************************************************************************************
  * @section Pipeables

diff --git a/sequence.ts b/sequence.ts
@@ -38,10 +38,6 @@ const _getRecordConstructor = (
 
 type NonEmptyArray<T> = [T, ...T[]];
 
-type Test<A, B, I extends number> = A extends $<B, [infer E, infer A]>
-  ? [E, A][I]
-  : never;
-
 // deno-fmt-ignore
 type SequenceTuple<T, R extends NonEmptyArray<$<T, any[]>>, L extends LS = 1> = {
   1: $<T, [{ [K in keyof R]: R[K] extends $<T, [infer A]> ? A : never }]>;

diff --git a/testing/array.test.ts b/testing/array.test.ts
@@ -4,8 +4,8 @@ import * as A from "../array.ts";
 
 Deno.test({
   name: "Array Modules",
-  fn(): void {
+  async fn() {
     // Test Laws
-    assertMonad(A.Monad, "Array");
+    await assertMonad(A.Monad, "Array");
   },
 });
diff --git a/testing/assert.ts b/testing/assert.ts
@@ -2,71 +2,87 @@ import { assertEquals } from "https://deno.land/std/testing/asserts.ts";
 
 import type * as TC from "../type_classes.ts";
 
+type Return<T> = T extends (...as: any[]) => infer R ? R : never;
+
 /**
  * Applicative Functor Laws Tests
  * * Includes Applicative Laws
  * * Includes Functor Laws
  * * Includes Apply Laws
  */
 type AssertApplicative = {
-  <T, L extends 1>(M: TC.Applicative<T, L>, name: string): void;
-  <T, L extends 2>(M: TC.Applicative<T, L>, name: string): void;
-  <T, L extends 3>(M: TC.Applicative<T, L>, name: string): void;
+  <T, L extends 1>(
+    M: TC.Applicative<T, L>,
+    name: string,
+    run?: (ta: Return<TC.ApplicativeFn<T, L>>) => Promise<any>,
+  ): Promise<void>;
+  <T, L extends 2>(
+    M: TC.Applicative<T, L>,
+    name: string,
+    run?: (ta: Return<TC.ApplicativeFn<T, L>>) => Promise<any>,
+  ): Promise<void>;
+  <T, L extends 3>(
+    M: TC.Applicative<T, L>,
+    name: string,
+    run?: (ta: Return<TC.ApplicativeFn<T, L>>) => Promise<any>,
+  ): Promise<void>;
 };
 
-export const assertApplicative: AssertApplicative = <T>(
+export const assertApplicative: AssertApplicative = async <T>(
   M: TC.Applicative<T>,
   name: string,
-): void => {
+  run: (ta: Return<TC.ApplicativeFn<T, 1>>) => Promise<any> = (ta) =>
+    Promise.resolve(ta),
+): Promise<void> => {
   const fab = (n: number) => n + 1;
   const fbc = (n: number): string => n.toString();
   const fgab = (f: typeof fbc) => (g: typeof fab) => (n: number) => f(g(n));
 
   // Apply Composition: A.ap(A.ap(A.map(f => g => x => f(g(x)), a), u), v) ≡ A.ap(a, A.ap(u, v))
   assertEquals(
-    M.ap(M.ap(M.map(fgab, M.of(fbc)), M.of(fab)), M.of(1)),
-    M.ap(M.of(fbc), M.ap(M.of(fab), M.of(1))),
+    await run(M.ap(M.ap(M.map(fgab, M.of(fbc)), M.of(fab)), M.of(1))),
+    await run(M.ap(M.of(fbc), M.ap(M.of(fab), M.of(1)))),
     `${name} : Apply Composition`,
   );
 
   // Functor Identity: F.map(x => x, a) ≡ a
   assertEquals(
-    M.map((n: number) => n, M.of(1)),
-    M.of(1),
+    await run(M.map((n: number) => n, M.of(1))),
+    await run(M.of(1)),
     `${name} : Functor Identity`,
   );
 
   // Functor Composition: F.map(x => f(g(x)), a) ≡ F.map(f, F.map(g, a))
   assertEquals(
-    M.map((x: number) => fbc(fab(x)), M.of(1)),
-    M.map(fbc, M.map(fab, M.of(1))),
+    await run(M.map((x: number) => fbc(fab(x)), M.of(1))),
+    await run(M.map(fbc, M.map(fab, M.of(1)))),
     `${name} : Functor Composition`,
   );
 
   // Applicative Identity: A.ap(A.of(x => x), v) ≡ v
   assertEquals(
-    M.ap(
+    await run(M.ap(
       M.of((n: number) => n),
       M.of(1),
-    ),
-    M.of(1),
+    )),
+    await run(M.of(1)),
     `${name} : Applicative Identity`,
   );
 
   // Applicative Homomorphism: M.ap(A.of(f), A.of(x)) ≡ A.of(f(x))
   assertEquals(
-    M.ap(M.of(fab), M.of(1)),
-    M.of(fab(1)),
+    await run(M.ap(M.of(fab), M.of(1))),
+    await run(M.of(fab(1))),
     `${name} : Applicative Homomorphism`,
   );
 
   // Applicative Interchange: A.ap(u, A.of(y)) ≡ A.ap(A.of(f => f(y)), u)
   assertEquals(
-    M.ap(M.of(fab), M.of(2)),
-    M.ap(
+    await run(M.ap(M.of(fab), M.of(2))),
+    await run(M.ap(
       M.of((f: typeof fab) => f(2)),
       M.of(fab),
-    ),
+    )),
     `${name} : Applicative Interchange`,
   );
 };
@@ -79,28 +95,33 @@ type AssertChain = {
   <T, L extends 1>(
     M: TC.Applicative<T, L> & TC.Chain<T, L>,
     name: string,
-  ): void;
+    run?: (ta: Return<TC.ApplicativeFn<T, L>>) => Promise<any>,
+  ): Promise<void>;
   <T, L extends 2>(
     M: TC.Applicative<T, L> & TC.Chain<T, L>,
     name: string,
-  ): void;
+    run?: (ta: Return<TC.ApplicativeFn<T, L>>) => Promise<any>,
+  ): Promise<void>;
   <T, L extends 3>(
     M: TC.Applicative<T, L> & TC.Chain<T, L>,
     name: string,
-  ): void;
+    run?: (ta: Return<TC.ApplicativeFn<T, L>>) => Promise<any>,
+  ): Promise<void>;
 };
 
-export const assertChain: AssertChain = <T>(
+export const assertChain: AssertChain = async <T>(
   M: TC.Applicative<T> & TC.Chain<T>,
   name: string,
-): void => {
+  run: (ta: Return<TC.ApplicativeFn<T, 1>>) => Promise<any> = (ta) =>
+    Promise.resolve(ta),
+): Promise<void> => {
   const fatb = (n: number) => M.of(n + 1);
   const fbtc = (n: number) => M.of(n.toString());
 
   // Chain Associativity: M.chain(g, M.chain(f, u)) ≡ M.chain(x => M.chain(g, f(x)), u)
   assertEquals(
-    M.chain(fbtc, M.chain(fatb, M.of(1))),
-    M.chain((x) => M.chain(fbtc, fatb(x)), M.of(1)),
+    await run(M.chain(fbtc, M.chain(fatb, M.of(1)))),
+    await run(M.chain((x) => M.chain(fbtc, fatb(x)), M.of(1))),
     `${name} : Chain Associativity`,
   );
 };
@@ -109,48 +130,62 @@ export const assertChain: AssertChain = <T>(
  * Monad Laws Tests
  */
 type AssertMonad = {
-  <T, L extends 1>(M: TC.Monad<T, L>, name: string): void;
-  <T, L extends 2>(M: TC.Monad<T, L>, name: string): void;
-  <T, L extends 3>(M: TC.Monad<T, L>, name: string): void;
+  <T, L extends 1>(
+    M: TC.Monad<T, L>,
+    name: string,
+    run?: (ta: Return<TC.ApplicativeFn<T, L>>) => Promise<any>,
+  ): Promise<void>;
+  <T, L extends 2>(
+    M: TC.Monad<T, L>,
+    name: string,
+    run?: (ta: Return<TC.ApplicativeFn<T, L>>) => Promise<any>,
+  ): Promise<void>;
+  <T, L extends 3>(
+    M: TC.Monad<T, L>,
+    name: string,
+    run?: (ta: Return<TC.ApplicativeFn<T, L>>) => Promise<any>,
+  ): Promise<void>;
 };
 
-export const assertMonad: AssertMonad = <T>(
+export const assertMonad: AssertMonad = async <T>(
   M: TC.Monad<T>,
   name: string,
-): void => {
+  run: (ta: Return<TC.ApplicativeFn<T, 1>>) => Promise<any> = (ta) =>
+    Promise.resolve(ta),
+): Promise<void> => {
   const famb = (n: number) => (n < 0 ? M.of(0) : M.of(n));
   const fbmc = (n: number) => M.of(n.toString());
 
   // Monad Left Identity: M.chain(f, M.of(a)) ≡ f(a)
   assertEquals(
-    M.chain(famb, M.of(1)),
-    famb(1),
+    await run(M.chain(famb, M.of(1))),
+    await run(famb(1)),
     `${name} : Monad Left Identity`,
   );
 
   // Monad Right Identity: M.chain(M.of, u) ≡ u
   assertEquals(
-    M.chain(M.of, M.of(1)),
-    M.of(1),
+    await run(M.chain(M.of, M.of(1))),
+    await run(M.of(1)),
     `${name} : Monad Right Identity`,
   );
 
   // Monad Associativity: M.chain(b => Mc, M.chain(a => Mb, Ma)) === M.chain(a => M.chain(b => Mc, (a => Mb)(a)), Ma)
   assertEquals(
-    M.chain(fbmc, M.chain(famb, M.of(1))),
-    M.chain((a) => M.chain(fbmc, famb(a)), M.of(1)),
+    await run(M.chain(fbmc, M.chain(famb, M.of(1)))),
+    await run(M.chain((a) => M.chain(fbmc, famb(a)), M.of(1))),
     `${name} : Monad Associativity 1`,
   );
 
   assertEquals(
-    M.chain(fbmc, M.chain(famb, M.of(-1))),
-    M.chain((a) => M.chain(fbmc, famb(a)), M.of(-1)),
+    await run(M.chain(fbmc, M.chain(famb, M.of(-1)))),
+    await run(M.chain((a) => M.chain(fbmc, famb(a)), M.of(-1))),
     `${name} : Monad Associativity 2`,
   );
 
   // Monads must support Applicative
-  assertApplicative(M as any, name);
+  await assertApplicative(M as TC.Applicative<T>, name, run as any);
 
   // Monads must support Chain
-  assertChain(M as any, name);
+  await assertChain(M as TC.Applicative<T> & TC.Chain<T>, name, run as any);
 };
diff --git a/testing/datum.test.ts b/testing/datum.test.ts
@@ -38,9 +38,9 @@ Deno.test({
 
 Deno.test({
   name: "Datum Modules",
-  fn(): void {
+  async fn() {
     // Test Laws
-    assertMonad(D.Monad, "Datum");
+    await assertMonad(D.Monad, "Datum");
 
     // Monad Join
     const { join } = D.Monad;

diff --git a/testing/datum_either.test.ts b/testing/datum_either.test.ts
@@ -3,7 +3,7 @@ import * as DE from "../datum_either.ts";
 
 Deno.test({
   name: "DatumEither Modules",
-  fn(): void {
-    assertMonad(DE.Monad, "DatumEither");
+  async fn() {
+    await assertMonad(DE.Monad, "DatumEither");
   },
 });
diff --git a/testing/either.test.ts b/testing/either.test.ts
@@ -37,9 +37,9 @@ Deno.test({
 
 Deno.test({
   name: "Either Modules",
-  fn(): void {
+  async fn() {
     // Test Laws
-    assertMonad(E.Monad, "Either");
+    await assertMonad(E.Monad, "Either");
 
     // Foldable
     const { reduce } = E.Foldable;

diff --git a/testing/identity.test.ts b/testing/identity.test.ts
@@ -4,8 +4,8 @@ import * as I from "../identity.ts";
 
 Deno.test({
   name: "Identity Modules",
-  fn(): void {
+  async fn() {
     // Test Laws
-    assertMonad(I.Monad, "Identity");
+    await assertMonad(I.Monad, "Identity");
   },
 });
diff --git a/testing/option.test.ts b/testing/option.test.ts
@@ -36,9 +36,9 @@ Deno.test({
 
 Deno.test({
   name: "Option Modules",
-  fn(): void {
+  async fn() {
     // Test Laws
-    assertMonad(O.Monad, "Option");
+    await assertMonad(O.Monad, "Option");
 
     // Foldable
     const { reduce } = O.Foldable;