encoding-hkt.ts

export interface None {
  readonly _tag: "None"
}

export interface Some<A> {
  readonly _tag: "Some"
  readonly value: A
}

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

export interface Left<E> {
  readonly _tag: "Left"
  readonly left: E
}

export interface Right<A> {
  readonly _tag: "Right"
  readonly right: A
}

export type Either<E, A> = Left<E> | Right<A>

export interface F_<A> {
  _tag: "F_"
  A: A
}
export interface G_<A> {
  _tag: "G_"
  A: A
}
export interface H_<A> {
  _tag: "H_"
  A: A
}

export interface URItoKind<S, R, E, A> {
  F_: F_<A>
  G_: G_<A>
  H_: H_<A>
  Either: Either<E, A>
  Option: Option<A>
}

export type URIS = keyof URItoKind<any, any, any, any>

export type Param = "S" | "R" | "E"

export interface Fix<P extends Param, K> {
  Fix: {
    [p in P]: K
  }
}

export type OrFix<P extends Param, C, V> = C extends Fix<P, infer K> ? K : V

export type KindURI = [URIS, ...URIS[]]

export type Kind<F extends KindURI, C, S, R, E, A> = ((...args: F) => any) extends (
  head: infer H,
  ...rest: infer Rest
) => any
  ? H extends URIS
    ? Rest extends KindURI
      ? URItoKind<
          OrFix<"S", C, S>,
          OrFix<"R", C, R>,
          OrFix<"E", C, E>,
          Kind<Rest, C, S, R, E, A>
        >[H]
      : URItoKind<OrFix<"S", C, S>, OrFix<"R", C, R>, OrFix<"E", C, E>, A>[H]
    : never
  : never

export interface Functor<F extends KindURI, C = {}> {
  URI: F
  map: <A, A2>(
    f: (a: A) => A2
  ) => <S, R, E>(fa: Kind<F, C, S, R, E, A>) => Kind<F, C, S, R, E, A2>
}

export interface Bifunctor<F extends KindURI, C = {}> {
  URI: F
  bimap: <A, A2, E, E2>(
    f: (a: A) => A2,
    g: (a: OrFix<"E", C, E>) => OrFix<"E", C, E2>
  ) => <S, R>(fa: Kind<F, C, S, R, E, A>) => Kind<F, C, S, R, E2, A2>
}

export const functorOption: Functor<["Option"]> = {
  URI: ["Option"],
  map: (f) => (fa) => (fa._tag === "None" ? fa : { _tag: "Some", value: f(fa.value) })
}

export const bifunctorEither: Bifunctor<["Either"]> = {
  URI: ["Either"],
  bimap: (f, g) => (fa) =>
    fa._tag === "Left"
      ? { _tag: "Left", left: g(fa.left) }
      : { _tag: "Right", right: f(fa.right) }
}

export const bifunctorStringValidation: Bifunctor<["Either"], Fix<"E", string>> = {
  URI: ["Either"],
  bimap: (f, g) => (fa) =>
    fa._tag === "Left"
      ? { _tag: "Left", left: g(fa.left) }
      : { _tag: "Right", right: f(fa.right) }
}

export function addOne<URI extends KindURI, C>(
  F: Functor<URI, C>
): <S, R, E>(fa: Kind<URI, C, S, R, E, number>) => Kind<URI, C, S, R, E, number>
export function addOne<C>(F: Functor<["F_"], C>): (fa: F_<number>) => F_<number> {
  return F.map((n) => n + 1)
}

export const functorEitherOption: Functor<["Either", "Option"], {}> = {
  URI: ["Either", "Option"],
  map: (f) => (fa) =>
    fa._tag === "Left"
      ? { _tag: "Left", left: fa.left }
      : fa.right._tag === "None"
      ? { _tag: "Right", right: { _tag: "None" } }
      : { _tag: "Right", right: { _tag: "Some", value: f(fa.right.value) } }
}

export const addOneEitherOption = addOne(functorEitherOption)

addOneEitherOption({
  _tag: "Right",
  right: {
    _tag: "Some",
    value: 1
  }
})