feat!: Enforce Free as a Freer (#176)

mod.ts

@@ -11,6 +11,7 @@ export * as Coyoneda from "./src/coyoneda.ts";
 export * as Curry from "./src/curry.ts";
 export * as Dual from "./src/dual.ts";
 export * as Ether from "./src/ether.ts";
+export * as Exists from "./src/exists.ts";
 export * as Free from "./src/free.ts";
 export * as MonadFree from "./src/free/monad.ts";
 export * as Frozen from "./src/frozen.ts";

src/control-flow.ts

@@ -22,6 +22,7 @@ import {
     monadForDecoder,
 } from "./serial.ts";
 import { doT } from "./cat.ts";
+import type { Bifunctor } from "./type-class/bifunctor.ts";
 
 const continueSymbol = Symbol("ControlFlowContinue");
 /**
@@ -132,6 +133,8 @@ export const traversableMonad = <B>(): TraversableMonad<
     ...traversable(),
 });
 
+export const bifunctor: Bifunctor<ControlFlowHkt> = { biMap };
+
 export const enc =
     <B>(encB: Encoder<B>) =>
     <C>(encC: Encoder<C>): Encoder<ControlFlow<B, C>> =>

src/coyoneda.ts

@@ -1,53 +1,76 @@
-import { compose, id } from "./func.ts";
-import type { Get1, Hkt3 } from "./hkt.ts";
-import type { Contravariant } from "./type-class/variance.ts";
+import { type Exists, newExists, runExists } from "./exists.ts";
+import type { Apply2Only, Apply3Only, Get1, Hkt2, Hkt3 } from "./hkt.ts";
+import { collect, type Distributive } from "./type-class/distributive.ts";
+import type { Applicative } from "./type-class/applicative.ts";
+import type { Apply } from "./type-class/apply.ts";
+import { type Comonad, extend } from "./type-class/comonad.ts";
+import type { Foldable } from "./type-class/foldable.ts";
+import type { Functor } from "./type-class/functor.ts";
+import type { Monad } from "./type-class/monad.ts";
+import type { Pure } from "./type-class/pure.ts";
+import type { Traversable } from "./type-class/traversable.ts";
 
 /**
- * Coyoneda functor, a dual of Yoneda functor reduction. It is also known as presheaf.
+ * Calculation on a space `X` and mapping function from `X` to an inclusion space `A`.
  */
-export interface Coyoneda<F, B, A> {
-    readonly hom: (a: A) => B;
-    readonly map: Get1<F, B>;
+export type CoyonedaT<F, A, X> = [map: (shape: X) => A, image: Get1<F, X>];
+
+export interface CoyonedaTHkt extends Hkt3 {
+    readonly type: CoyonedaT<this["arg3"], this["arg2"], this["arg1"]>;
 }
+
 /**
- * More generic construction form of `Coyoneda`, freeing type parameters.
+ * Coyoneda functor, a dual of Yoneda functor reduction. It is also known as presheaf.
  */
-export interface CoyonedaConstructor<A> {
-    <B>(hom: (a: A) => B): <F>(map: Get1<F, B>) => Coyoneda<F, B, A>;
+export type Coyoneda<F, A> = Exists<Apply2Only<Apply3Only<CoyonedaTHkt, F>, A>>;
+
+export interface CoyonedaHkt extends Hkt2 {
+    readonly type: Coyoneda<this["arg2"], this["arg1"]>;
 }
+
 /**
- * Creates the new constructor for `A`.
+ * Creates a new `Coyoneda` from mapping function `map` and calculation on `F`.
  *
- * @returns The Coyoneda constructor.
+ * @param map - A mapping function from `A` to `B`.
+ * @param image - A calculation that results `A` on `F`.
+ * @returns A new `Coyoneda`.
  */
 export const coyoneda =
-    <A>(): CoyonedaConstructor<A> =>
-    <B>(hom: (a: A) => B) =>
-    <F>(map: Get1<F, B>): Coyoneda<F, B, A> => ({
-        hom,
-        map,
-    });
+    <X, A>(map: (a: X) => A) => <F>(image: Get1<F, X>): Coyoneda<F, A> =>
+        newExists<Coyoneda<F, A>, X>([map, image]);
+
+/**
+ * Unwraps a `Coyoneda` with running `runner`.
+ *
+ * @param runner - An extracting function.
+ * @returns The result of `runner`.
+ */
+export const unCoyoneda =
+    <F, A, R>(runner: <X>(map: (shape: X) => A) => (image: Get1<F, X>) => R) =>
+    (coy: Coyoneda<F, A>): R =>
+        runExists<Coyoneda<F, A>, R>(<X>([map, image]: CoyonedaT<F, A, X>) =>
+            runner(map)(image)
+        )(coy);
 
 /**
  * Lifts the presheaf as a `Coyoneda`.
  *
  * @param fa - The presheaf to be expanded.
  * @returns The new expanded instance.
  */
-export const lift = <F, A>(fa: Get1<F, A>): Coyoneda<F, A, A> =>
-    coyoneda<A>()(id)(fa);
+export const lift = <F, A>(fa: Get1<F, A>): Coyoneda<F, A> =>
+    coyoneda((x: A) => x)(fa);
 
 /**
  * Lowers `coy` on a presheaf.
  *
- * @param contra - The instance of `Contravariant` for `F`.
+ * @param functor - The instance of `Functor` for `F`.
  * @param coy - The instance to be reduced.
  * @returns The reduction on a presheaf.
  */
 export const lower =
-    <F>(contra: Contravariant<F>) =>
-    <B, A>(coy: Coyoneda<F, B, A>): Get1<F, A> =>
-        contra.contraMap(coy.hom)(coy.map);
+    <F>(functor: Functor<F>) => <A>(coy: Coyoneda<F, A>): Get1<F, A> =>
+        unCoyoneda(functor.map)(coy);
 
 /**
  * Lifts the natural transformation from `F` to `G` on `Coyoneda`.
@@ -57,27 +80,129 @@ export const lower =
  */
 export const hoist =
     <F, G>(nat: <A>(fa: Get1<F, A>) => Get1<G, A>) =>
-    <B, A>(coy: Coyoneda<F, B, A>): Coyoneda<G, B, A> =>
-        coyoneda<A>()(coy.hom)(nat(coy.map));
+    <A>(coy: Coyoneda<F, A>): Coyoneda<G, A> =>
+        runExists<Coyoneda<F, A>, Coyoneda<G, A>>(([map, image]) =>
+            coyoneda(map)(nat(image))
+        )(coy);
+
+export const pureT = <F>(pure: Pure<F>) => <T>(item: T): Coyoneda<F, T> =>
+    lift(pure.pure(item));
 
 /**
- * Maps the function into an opposite function on `Coyoneda`.
+ * Maps the function into an function on `Coyoneda`.
  *
  * @param fn - The function from `T` to `U`.
  * @returns The mapped function.
  */
-export const contraMap =
-    <T, U>(fn: (t: T) => U) =>
-    <F, B>(coy: Coyoneda<F, B, U>): Coyoneda<F, B, T> => {
-        const { hom, map } = coy;
-        return { hom: compose(hom)(fn), map };
-    };
-
-export interface CoyonedaHkt extends Hkt3 {
-    readonly type: Coyoneda<this["arg3"], this["arg2"], this["arg1"]>;
-}
+export const map =
+    <T, U>(fn: (t: T) => U) => <F>(coy: Coyoneda<F, T>): Coyoneda<F, U> =>
+        runExists<Coyoneda<F, T>, Coyoneda<F, U>>(<A>(
+            [map, image]: CoyonedaT<F, T, A>,
+        ) => coyoneda((t: A) => fn(map(t)))(image))(coy);
+
+export const applyT =
+    <F>(apply: Apply<F>) =>
+    <T, U>(fn: Coyoneda<F, (t: T) => U>) =>
+    (coy: Coyoneda<F, T>): Coyoneda<F, U> =>
+        lift(apply.apply(lower(apply)(fn))(lower(apply)(coy)));
+
+export const flatMapT =
+    <F>(flatMap: Monad<F>) =>
+    <T, U>(fn: (t: T) => Coyoneda<F, U>) =>
+    (coy: Coyoneda<F, T>): Coyoneda<F, U> =>
+        lift(
+            runExists<Coyoneda<F, T>, Get1<F, U>>(<A>(
+                [map, image]: CoyonedaT<F, T, A>,
+            ) => flatMap.flatMap(
+                (x: A) => lower(flatMap)(fn(map(x))),
+            )(image))(coy),
+        );
+
+export const duplicateT =
+    <F>(comonad: Comonad<F>) =>
+    <T>(coy: Coyoneda<F, T>): Coyoneda<F, Coyoneda<F, T>> =>
+        runExists<Coyoneda<F, T>, Coyoneda<F, Coyoneda<F, T>>>(<A>(
+            [map, image]: CoyonedaT<F, T, A>,
+        ) => lift(extend(comonad)((x: Get1<F, A>) => coyoneda(map)(x))(image)))(
+            coy,
+        );
+
+export const extractT =
+    <F>(comonad: Comonad<F>) => <T>(coy: Coyoneda<F, T>): T =>
+        runExists<Coyoneda<F, T>, T>(([map, image]) =>
+            map(comonad.extract(image))
+        )(coy);
+
+export const foldRT =
+    <F>(foldable: Foldable<F>) =>
+    <A, B>(folder: (next: A) => (acc: B) => B) =>
+    (init: B): (data: Coyoneda<F, A>) => B =>
+        unCoyoneda(
+            <X>(map: (x: X) => A) =>
+                foldable.foldR((next: X) => folder(map(next)))(init),
+        );
+
+export const traverseT =
+    <T>(tra: Traversable<T>) =>
+    <F>(app: Applicative<F>) =>
+    <A, B>(
+        visitor: (item: A) => Get1<F, B>,
+    ): (data: Coyoneda<T, A>) => Get1<F, Coyoneda<T, B>> =>
+        unCoyoneda(<X>(map: (x: X) => A) => (image: Get1<T, X>) =>
+            app.map(lift)(tra.traverse(app)((a: X) => visitor(map(a)))(image))
+        );
+
+export const distributeT =
+    <G>(dist: Distributive<G>) =>
+    <F>(functor: Functor<F>) =>
+    <A>(fga: Get1<F, Coyoneda<G, A>>): Coyoneda<G, Get1<F, A>> =>
+        lift(collect(dist)(functor)(lower(dist))(fga));
 
 /**
- * The instance of `Contravariant` for `Coyoneda`.
+ * The instance of `Functor` for `Coyoneda`.
  */
-export const contravariant: Contravariant<CoyonedaHkt> = { contraMap };
+export const functor: Functor<CoyonedaHkt> = { map };
+
+export const applicative = <F>(
+    app: Applicative<F>,
+): Applicative<Apply2Only<CoyonedaHkt, F>> => ({
+    pure: pureT(app),
+    map,
+    apply: applyT(app),
+});
+
+export const monad = <F>(
+    monad: Monad<F>,
+): Monad<Apply2Only<CoyonedaHkt, F>> => ({
+    pure: pureT(monad),
+    map,
+    apply: applyT(monad),
+    flatMap: flatMapT(monad),
+});
+
+export const comonad = <F>(
+    comonad: Comonad<F>,
+): Comonad<Apply2Only<CoyonedaHkt, F>> => ({
+    map,
+    extract: extractT(comonad),
+    duplicate: duplicateT(comonad),
+});
+
+export const foldable = <F>(
+    foldable: Foldable<F>,
+): Foldable<Apply2Only<CoyonedaHkt, F>> => ({ foldR: foldRT(foldable) });
+
+export const traversable = <T>(
+    tra: Traversable<T>,
+): Traversable<Apply2Only<CoyonedaHkt, T>> => ({
+    map,
+    foldR: foldRT(tra),
+    traverse: traverseT(tra),
+});
+
+export const distributive = <G>(
+    dist: Distributive<G>,
+): Distributive<Apply2Only<CoyonedaHkt, G>> => ({
+    map,
+    distribute: distributeT(dist),
+});

src/exists.ts

@@ -0,0 +1,11 @@
+import type { Get1 } from "./hkt.ts";
+
+declare const existsNominal: unique symbol;
+export type Exists<F> = F & { [existsNominal]: never };
+
+export const newExists = <F, A>(item: Get1<F, A>): Exists<F> =>
+    item as Exists<F>;
+
+export const runExists = <F, R>(
+    runner: <A>(item: Get1<F, A>) => R,
+): (exists: Exists<F>) => R => runner as (exists: Exists<F>) => R;

src/free.test.ts

@@ -1,13 +1,13 @@
 import { assertEquals } from "../deps.ts";
-import { doVoidT } from "./cat.ts";
+import { catT, doVoidT } from "./cat.ts";
 import {
     eq,
     type Free,
-    isPure,
     liftF,
     monad as freeMonad,
-    node,
     pure,
+    runFree,
+    wrap,
 } from "./free.ts";
 import type { Hkt1 } from "./hkt.ts";
 import { type Eq, fromEquality } from "./type-class/eq.ts";
@@ -51,37 +51,32 @@ Deno.test("hello language", async (t) => {
         };
     const functor: Functor<HelloLangHkt> = { map };
 
-    const runProgram = <T>(code: Free<HelloLangHkt, T>): string => {
-        if (isPure(code)) {
-            return `return ${code[1]}`;
-        }
-        switch (code[1].type) {
-            case "Hello":
-                return `Hello.\n${runProgram(code[1].next)}`;
-            case "Hey":
-                return `Hey.\n${runProgram(code[1].next)}`;
-            case "YearsOld":
-                return `I'm ${code[1].years} years old.\n${
-                    runProgram(code[1].next)
-                }`;
-            case "Bye":
-                return "Bye.\n";
-        }
-    };
+    const runProgram = runFree(functor)<string>(
+        (
+            op: HelloLang<Free<HelloLangHkt, string>>,
+        ): Free<HelloLangHkt, string> => {
+            switch (op.type) {
+                case "Hello":
+                    return pure(`Hello.\n${runProgram(op.next)}`);
+                case "Hey":
+                    return pure(`Hey.\n${runProgram(op.next)}`);
+                case "YearsOld":
+                    return pure(
+                        `I'm ${op.years} years old.\n${runProgram(op.next)}`,
+                    );
+                case "Bye":
+                    return pure("Bye.\n");
+            }
+        },
+    );
 
-    const hello: Free<HelloLangHkt, []> = liftF(functor)({
-        type: "Hello",
-        next: [],
-    });
-    const hey: Free<HelloLangHkt, []> = liftF(functor)({
-        type: "Hey",
-        next: [],
-    });
+    const hello: Free<HelloLangHkt, []> = liftF({ type: "Hello", next: [] });
+    const hey: Free<HelloLangHkt, []> = liftF({ type: "Hey", next: [] });
     const yearsOld = (years: number): Free<HelloLangHkt, []> =>
-        liftF(functor)({ type: "YearsOld", years, next: [] });
-    const bye: Free<HelloLangHkt, []> = liftF(functor)({ type: "Bye" });
+        liftF({ type: "YearsOld", years, next: [] });
+    const bye: Free<HelloLangHkt, []> = liftF({ type: "Bye" });
 
-    const m = freeMonad(functor);
+    const m = freeMonad<HelloLangHkt>();
 
     const comparator = eq<HelloLangHkt, unknown>({
         equalityA: fromEquality(() => () => true)(),
@@ -105,21 +100,14 @@ Deno.test("hello language", async (t) => {
                 }
             },
         ),
+        functor,
     });
 
     await t.step("syntax tree", () => {
-        const empty: Free<HelloLangHkt, unknown> = pure({} as unknown);
-        const example: Free<HelloLangHkt, unknown> = node<
-            HelloLangHkt,
-            HelloLang<unknown>
-        >({
+        const empty: Free<HelloLangHkt, unknown> = pure({});
+        const example: Free<HelloLangHkt, string> = wrap({
             type: "Hello",
-            next: node<HelloLangHkt, HelloLang<unknown>>({
-                type: "Hello",
-                next: node<HelloLangHkt, HelloLang<unknown>>({
-                    type: "Bye",
-                }),
-            }),
+            next: wrap({ type: "Hello", next: wrap({ type: "Bye" }) }),
         });
         assertEquals(comparator.eq(example, example), true);
         assertEquals(comparator.eq(example, empty), false);
@@ -134,7 +122,7 @@ Deno.test("hello language", async (t) => {
     await t.step("program monad", () => {
         const subRoutine = doVoidT(m).run(hello).run(yearsOld(25)).ctx;
         const program =
-            doVoidT(m).run(hey).run(subRoutine).run(hey).run(bye).ctx;
+            catT(m)(pure("")).run(hey).run(subRoutine).run(hey).run(bye).ctx;
 
         assertEquals(
             runProgram(program),