Kleisli Category in Typescript

kliesli.ts

type Eq<A, B, C> = [B] extends [C] // If B is assignable to C
  ? [C] extends [B] // AND C is assignable to B
    ? A // Then return A
    : never // Else (they are not mutually assignable), return never
  : never; // Else (B is not assignable to C), return never

// parametrized over monads and functors via currying
export type KliesliCategory<
  C extends T3,
  M extends Monad<C, Functor<C>>,
  A,
  B,
> = {
  composition: <
    R extends Eq<M, M, R>,
    E extends Eq<R, R, E>,
    A extends Eq<E, E, A>,
    B extends Eq<A, A, B>,
  >(
    c: Kind3<C, R, E, A>
  ) => (m: Kind2<C, R, E>) => (f: Kind<C, A>) => (a: A) => B;
  id: Eq<A, A, B>;
};

interface U1<A> {}

interface U2<E, A extends Eq<E, E, A>> {}

interface U3<R, E extends Eq<R, R, E>, A extends Eq<E, E, A>> {}

// defunctionalization
// we can think of this as "universes" in HoTT
type T = keyof U1<any>;
type T2 = keyof U2<any, any>;
type T3 = keyof U3<any, any, any>;

type Kind<I extends T, A> = I extends T ? U1<A>[I] : any;
type Kind2<T extends T2, E, A extends Eq<E, E, A>> = T extends T2
  ? U2<E, A>[T]
  : any;
type Kind3<
  T extends T3,
  R,
  E extends Eq<R, R, E>,
  A extends Eq<E, E, A>,
> = T extends T3 ? U3<R, E, A>[T] : any;

interface Functor<F extends T> {
  readonly k: F;
  // Here we also enforce A = B to enable endofunctors locally
  readonly fmap: <A, B extends Eq<A, A, B>>(
    fa: Kind<F, A>,
    f: (a: A) => A
  ) => Kind<F, A>;
}

interface Monad<M extends T2, F extends Functor<M>> {
  bind: <A extends Eq<F, F, A>, B extends Eq<F, F, B>>(
    ma: Kind2<M, F, A>,
    f: (a: A) => Kind2<M, F, B>
  ) => Kind2<M, F, B>;
  pure: <A extends Eq<F, F, A>, B extends Eq<F, F, B>>(
    a: A
  ) => (b: B) => (a: A) => Kind2<M, F, B>;
}

type fmap<A extends T, B extends Eq<A, A, B>> = (
  fa: Functor<A>,
  f: (a: A) => B
) => Functor<B>;

type bind<M extends T2, E extends Functor<M>, A> = (
  ma: Monad<M, E>,
  f: (a: A) => Monad<M, E>
) => Monad<M, E>;

// implementation
interface U1<A> {
  CanopyNodes: CanopyNodes<A, A, A>;
}

interface U2<E, A extends Eq<E, E, A>> {
  CanopyNodes: CanopyNodes<E, A, A>;
}

interface U3<R, E extends Eq<R, R, E>, A extends Eq<E, E, A>> {
  CanopyNodes: CanopyNodes<R, E, A>;
}

interface CanopyNode<M extends T> {
  interactions: number;
  fmap: fmap<M, M>;
  bind: bind<M, Functor<M>, M>;
}

export type CanopyNodes<
  R,
  E extends Eq<R, R, E>,
  A extends Eq<E, E, A>,
> = KliesliCategory<
  "CanopyNodes",
  Monad<"CanopyNodes", Functor<"CanopyNodes">>,
  CanopyNode<"CanopyNodes">,
  CanopyNode<"CanopyNodes">
>;