expanding pelotom hkts with kind substitution map

hkt.ts

/*******************************************************************************
 * Kinds Type
 * 
 * A registry for Kind URIS with their substitution strategies.
 * Note that the idiomatic replacement type for kinds uses $[0] as the inner-
 * most hole for Functor and Chain. Thus Either<L, R> should use the hole
 * order of Either<$[1], $[0]>.
 * 
 * Here $ is a tuple of types that can be substituted into each kind.
 ******************************************************************************/

export interface Kinds<$ extends any[]> {}

/*******************************************************************************
 * URIS Type
 * 
 * A union of all Kind URIS
 ******************************************************************************/

export type URIS = keyof Kinds<any[]>;

/*******************************************************************************
 * Kind Type
 * 
 * A lookup type used to specify a specific kind with its substitution.
 ******************************************************************************/

export type Kind<URI extends URIS, $ extends any[]> = Kinds<$>[URI];

/*******************************************************************************
 * Type Classes
 * 
 * Up to * -> * -> * -> * undifferentiated
 ******************************************************************************/

export type Functor<URI extends URIS> = {
  readonly map: <A, I>(
    fai: (a: A) => I,
  ) => <B = never, C = never, D = never>(
    ta: Kind<URI, [A, B, C, D]>,
  ) => Kind<URI, [I, B, C, D]>;
};

// This is NOT the actual Traversable type, but just an illustration of nexted
// type classes
export type Traversable<URI extends URIS> = {
  readonly traverse: <VRI extends URIS>(
    F: Functor<VRI>,
  ) => <A, I, J = never, K = never, L = never>(
    favi: (a: A) => Kind<VRI, [I, J, K, L]>,
  ) => <B = never, C = never, D = never>(
    ta: Kind<URI, [A, B, C, D]>,
  ) => Kind<VRI, [Kind<URI, [I, B, C, D]>, J, K, L]>;
};

hkts.ts

// deno-lint-ignore-file no-explicit-any ban-types

// Option
export type None = { tag: "None" };
export type Some<V> = { tag: "Some"; value: V };
export type Option<V> = None | Some<V>;

// Either
export type Left<L> = { tag: "Left"; left: L };
export type Right<R> = { tag: "Right"; right: R };
export type Either<L, R> = Left<L> | Right<R>;

// These
export type Both<L, R> = { tag: "Both"; left: L; right: R };
export type These<L, R> = Either<L, R> | Both<L, R>;

// Reader
export type Reader<R, A> = (r: R) => A;

// ReaderEither
export type ReaderEither<R, E, A> = Reader<R, Either<E, A>>;

/*******************************************************************************
 * Hole Types
 * @description Marks a type hole to be filled by the substitution ($) type
 ******************************************************************************/

declare const index: unique symbol;

export interface _<N extends number = 0> {
  [index]: N;
}
export type _0 = _<0>;
export type _1 = _<1>;
export type _2 = _<2>;
export type _3 = _<3>;
export type _4 = _<4>;
export type _5 = _<5>;
export type _6 = _<6>;
export type _7 = _<7>;
export type _8 = _<8>;
export type _9 = _<9>;

/*******************************************************************************
 * Fix Type
 * @description Fixes a type so it is not replaced by the substitution ($) type
 ******************************************************************************/

declare const Fix: unique symbol;

export interface Fix<T> {
  [Fix]: T;
}

/*******************************************************************************
 * Substitution Type
 * @description Replaces any type holes in a type with the supplied parameters
 * @example
 *     type FunctorFn<T> = <A, B>(fab: (a: A) => B, ta: $<T, [A]>) => $<T, [B]>;
 *     type ArrayInstance = FunctorFn<Array<_>>;
 *     // ArrayInstance = <A, B>(fab: (a: A) => B, ta: A[]): B[]
 ******************************************************************************/

export type Primitives =
  | null
  | undefined
  | boolean
  | number
  | bigint
  | string
  | symbol;

export type $<T, S extends any[]> = T extends Fix<infer F> ? F
  : T extends _<infer N> ? S[N]
  : T extends Primitives ? T
  : T extends any[] ? { [K in keyof T]: $<T[K], S> }
  : T extends (...as: infer AS) => infer R ? (...as: $<AS, S>) => $<R, S>
  : T extends Promise<infer I> ? Promise<$<I, S>>
  : T extends object ? { [K in keyof T]: $<T[K], S> }
  : T extends unknown ? never
  : T;

export type KindDef = {
  L: number;
  T: unknown;
};

// Kinds
export interface Kinds<T, S extends any[]> extends Record<string, KindDef> {
  ["Option"]: {
    L: 1;
    T: (() => T) extends (() => Option<infer V>) ? Option<$<V, S>>
      : never;
  };

  ["Either"]: {
    L: 2;
    T: (() => T) extends (() => Either<infer L, infer R>)
      ? Either<$<L, S>, $<R, S>>
      : never;
  };

  ["These"]: {
    L: 2;
    T: (() => T) extends (() => These<infer L, infer R>)
      ? These<$<L, S>, $<R, S>>
      : never;
  };

  ["Reader"]: {
    L: 2;
    T: T extends Reader<infer R, infer O> ? Reader<$<R, S>, $<O, S>>
      : never;
  };

  ["ReaderEither"]: {
    L: 3;
    T: T extends ReaderEither<infer R, infer E, infer A>
      ? ReaderEither<$<R, S>, $<E, S>, $<A, S>>
      : never;
  };
}

// URIS
export type URIS = keyof Kinds<any, any>;

// Kind
export type Kind<URI extends URIS, T, S extends any[]> = Kinds<T, S>[URI]["T"];
export type Length<URI extends URIS> = Kinds<string, any>[URI]["L"];

export type B = Option<_>; // type B = None | Some<_<0>>
export type BS = $<B, [string]>; // type BS = { tag: "None" } | { tag: "Some"; value: string; }
export type BK1 = Kinds<B, [string]>["Option"]; // type BK1 = None | Some<string>
export type BK2 = Kind<"Option", B, [string]>; // type BK2 = None | Some<string>

export type C = Either<_0, _1>; // type C = Left<_0> | Right<_1>
export type CS = $<C, [string, Array<string>]>; // type CS = { tag: "Left"; left: string; } | { tag: "Right"; right: string[]; }
export type CK1 = Kinds<C, [string, Array<string>]>["Either"]; // type CK1 = Left<string> | Right<string[]>
export type CK2 = Kind<"Either", C, [string, Array<string>]>; // type CK2 = Left<string> | Right<string[]>

export type D = Reader<_0, _1>; // type D = (r: _0) => _1
export type DS = $<D, [number, string]>; // type DS = (r: number) => string
export type DK1 = Kinds<D, [number, string]>["Reader"]; // type DK1 = (r: number) => string
export type DK2 = Kind<"Reader", D, [number, string]>; // type DK2 = (r: number) => string

export type E = ReaderEither<_0, _1, _2>;
export type ES = $<E, [1, 2, 3]>;
export type EK1 = Kinds<E, [1, 2, 3]>["ReaderEither"];
export type EK2 = Kind<"ReaderEither", E, [1, 2, 3]>;

export type F = These<_0, _1>;
export type FS = $<F, [1, 2]>;
export type FK1 = Kinds<F, [1, 2, 3]>["These"];
export type FK2 = Kind<"These", F, [1, 2, 3]>;

// deno-fmt-ignore
export type Functor<U extends URIS, T> = {
  readonly map: {
    [K: number]: <A, B>(fab: (a: A) => B) => (ta: Kind<U, T, [A]>) => Kind<U, T, [B]>;
    1: <A, B>(fab: (a: A) => B) => (ta: Kind<U, T, [A]>) => Kind<U, T, [B]>;
    2: <A, B>(fab: (a: A) => B) => <E = never>(ta: Kind<U, T, [E, A]>) => Kind<U, T, [E, B]>;
    3: <A, B>(fab: (a: A) => B) => <R = never, E = never>(ta: Kind<U, T, [R, E, A]>) => Kind<U, T, [R, E, B]>;
  }[Length<U>];
};

export const OptionFunctor: Functor<"Option", Option<_>> = {
  map: (fab) =>
    (ta) => ta.tag === "None" ? ta : { tag: "Some", value: fab(ta.value) },
};

export const EitherFunctor: Functor<"Either", Either<_0, _1>> = {
  map: (fab) =>
    (ta) => ta.tag === "Left" ? ta : { tag: "Right", right: fab(ta.right) },
};

export const RightFunctor: Functor<"Either", Either<Fix<Error>, _1>> = {
  map: (fab) =>
    (ta) => ta.tag === "Left" ? ta : { tag: "Right", right: fab(ta.right) },
};

const a = RightFunctor.map((n: number) => n + 1);

const b = a({ tag: "Left", left: new Error("Hello World") });
const c = a({ tag: "Right", right: 1 });

console.log(a, b, c);

test.ts

// deno-lint-ignore-file no-explicit-any

import type * as H from "./hkt.ts";

/*******************************************************************************
 * Option
 ******************************************************************************/

export type None = { tag: "None" };

export type Some<A> = { tag: "Some"; value: A };

export type Option<A> = None | Some<A>;

declare module "./hkt.ts" {
  export interface Kinds<$ extends any[]> {
    ["Option"]: Option<$[0]>;
  }
}

export const OptionFunctor: H.Functor<"Option"> = {
  map: (fab) =>
    (ta) => ta.tag === "None" ? ta : { tag: "Some", value: fab(ta.value) },
};

declare const OptionTraversable: H.Traversable<"Option">;

export function some<A>(value: A): Option<A> {
  return { tag: "Some", value };
}

export function none(): Option<never> {
  return { tag: "None" };
}

const myMap = OptionFunctor.map((a: number) => a + 1);

const a1 = myMap(some(1));
const a2 = myMap(none());

const c1 = OptionTraversable.traverse(OptionFunctor);
const c2 = c1((n: number) => some(n + 1));
const c3 = c2(none());
const c4 = c2(some(1));

/*******************************************************************************
 * Either
 ******************************************************************************/

export type Left<L> = { tag: "Left"; left: L };

export type Right<R> = { tag: "Right"; right: R };

export type Either<L, R> = Left<L> | Right<R>;

declare module "./hkt.ts" {
  export interface Kinds<$ extends any[]> {
    ["Either"]: Either<$[1], $[0]>;
  }
}

export const EitherFunctor: H.Functor<"Either"> = {
  map: (fab) =>
    (ta) => ta.tag === "Left" ? ta : { tag: "Right", right: fab(ta.right) },
};

export function left<L>(left: L): Either<L, never> {
  return { tag: "Left", left };
}

export function right<R>(right: R): Either<never, R> {
  return { tag: "Right", right };
}

const myMap2 = EitherFunctor.map((n: number) => n + 1);

const b1: Either<string, number> = right(1);
const b2 = myMap2(b1);

const d1 = OptionTraversable.traverse(EitherFunctor);
const d2 = d1((n: number) => left("adf"));
const d3 = d1((n: number) => right(n.toString(10)));
const d4 = d2(none());
const d5 = d2(some(1));
const d6 = d3(none());
const d7 = d3(some(1));

/*******************************************************************************
 * Fixed
 ******************************************************************************/

export type Fixed<R> = Either<number, R>;

declare module "./hkt.ts" {
  export interface Kinds<$ extends any[]> {
    ["Fixed"]: Fixed<$[0]>;
  }
}

const r = <R>(value: R): Fixed<R> => right(value);

const l = (value: number): Fixed<never> => left(value);

const e1 = myMap2(r(1))
const e2 = myMap2(l(1));