draft: Do, bind, bindTo

Author: David Peter

chain.ts

@@ -7,8 +7,48 @@ import type { Apply } from "./apply.ts";
  */
 export interface Chain<U extends Kind> extends TypeClass<U>, Apply<U> {
   readonly chain: <A, I, J = never, K = never, D = unknown, E = unknown>(
-    fati: (a: A) => $<U, [I, J, K], [D], [E]>,
+    fati: (a: A) => $<U, [I, J, K], [D], [E]>
   ) => <B = never, C = never>(
-    ta: $<U, [A, B, C], [D], [E]>,
+    ta: $<U, [A, B, C], [D], [E]>
   ) => $<U, [I, B | J, C | K], [D], [E]>;
 }
+
+/**
+ * ChainRec
+ * https://github.com/fantasyland/static-land/blob/master/docs/spec.md#chain
+ */
+export interface ChainRec<U extends Kind> extends TypeClass<U>, Chain<U> {
+  readonly chainRec: <A, B, I, J = never, K = never, D = unknown, E = unknown>(
+    fati: (a: A) => $<U, [I, J, K], [D], [E]>,
+    a: A
+  ) => $<U, [B, J, K], [D], [E]>;
+}
+
+// chainFirst
+export function chainFirst<U extends Kind>(
+  M: Chain<U>
+): <A, I, J = never, K = never, D = unknown, E = unknown>(
+  f: (a: A) => $<U, [I, J, K], [D], [E]>
+) => <B, C>(ma: $<U, [A, B, C], [D], [E]>) => $<U, [A, B, C], [D], [E]> {
+  return (f) => (ma) => M.chain((a) => M.map(() => a)(f(a)))(ma);
+}
+
+// bind
+export function bind<U extends Kind>(
+  M: Chain<U>
+): <N extends string, A, I, J = never, K = never, D = unknown, E = unknown>(
+  name: Exclude<N, keyof A>,
+  f: (a: A) => $<U, [I, J, K], [D], [E]>
+) => <B, C>(
+  ma: $<U, [A, B, C], [D], [E]>
+) => $<
+  U,
+  [{ readonly [K in keyof A | N]: K extends keyof A ? A[K] : I }],
+  [D],
+  [E]
+> {
+  return (name, f) =>
+    M.chain((a) =>
+      M.map((b) => Object.assign({}, a, { [name]: b }) as any)(f(a))
+    );
+}

either.ts

@@ -17,6 +17,8 @@ import * as O from "./option.ts";
 import { isNotNil } from "./nilable.ts";
 import { fromCompare } from "./ord.ts";
 import { flow, pipe } from "./fn.ts";
+import { bind as bind_ } from "./chain.ts";
+import { bindTo as bindTo_ } from "./functor.ts";
 
 export type Left<L> = { tag: "Left"; left: L };
 
@@ -33,11 +35,11 @@ export interface RightURI<B> extends Kind {
 }
 
 export function left<E, A = never>(left: E): Either<E, A> {
-  return ({ tag: "Left", left });
+  return { tag: "Left", left };
 }
 
 export function right<A, E = never>(right: A): Either<E, A> {
-  return ({ tag: "Right", right });
+  return { tag: "Right", right };
 }
 
 export function of<A, B = never>(a: A): Either<B, A> {
@@ -49,14 +51,13 @@ export function throwError<A = never, B = never>(b: B): Either<B, A> {
 }
 
 export function fromNullable<E>(fe: () => E) {
-  return <A>(
-    a: A,
-  ): Either<E, NonNullable<A>> => (isNotNil(a) ? right(a) : left(fe()));
+  return <A>(a: A): Either<E, NonNullable<A>> =>
+    isNotNil(a) ? right(a) : left(fe());
 }
 
 export function tryCatch<E, A>(
   fa: () => A,
-  onError: (e: unknown) => E,
+  onError: (e: unknown) => E
 ): Either<E, A> {
   try {
     return right(fa());
@@ -67,7 +68,7 @@ export function tryCatch<E, A>(
 
 export function tryCatchWrap<E, A, AS extends unknown[]>(
   fn: (...as: AS) => A,
-  onError: (e: unknown) => E,
+  onError: (e: unknown) => E
 ): (...as: AS) => Either<E, A> {
   return (...as: AS) => {
     try {
@@ -80,24 +81,24 @@ export function tryCatchWrap<E, A, AS extends unknown[]>(
 
 export function fromPredicate<E, A, B extends A>(
   refinement: Refinement<A, B>,
-  onFalse: (a: A) => E,
+  onFalse: (a: A) => E
 ): (a: A) => Either<E, B>;
 export function fromPredicate<E, A>(
   predicate: Predicate<A>,
-  onFalse: (a: A) => E,
+  onFalse: (a: A) => E
 ): (a: A) => Either<E, A> {
-  return (a: A) => predicate(a) ? right(a) : left(onFalse(a));
+  return (a: A) => (predicate(a) ? right(a) : left(onFalse(a)));
 }
 
 export function match<L, R, B>(
   onLeft: (left: L) => B,
-  onRight: (right: R) => B,
+  onRight: (right: R) => B
 ): (ta: Either<L, R>) => B {
-  return (ta) => isLeft(ta) ? onLeft(ta.left) : onRight(ta.right);
+  return (ta) => (isLeft(ta) ? onLeft(ta.left) : onRight(ta.right));
 }
 
 export function getOrElse<E, A>(onLeft: (e: E) => A) {
-  return (ma: Either<E, A>): A => isLeft(ma) ? onLeft(ma.left) : ma.right;
+  return (ma: Either<E, A>): A => (isLeft(ma) ? onLeft(ma.left) : ma.right);
 }
 
 export function getRight<E, A>(ma: Either<E, A>): O.Option<A> {
@@ -116,23 +117,17 @@ export function isRight<L, R>(m: Either<L, R>): m is Right<R> {
   return m.tag === "Right";
 }
 
-export function getShow<A, B>(
-  SB: Show<B>,
-  SA: Show<A>,
-): Show<Either<B, A>> {
-  return ({
+export function getShow<A, B>(SB: Show<B>, SA: Show<A>): Show<Either<B, A>> {
+  return {
     show: match(
       (left) => `Left(${SB.show(left)})`,
-      (right) => `Right(${SA.show(right)})`,
+      (right) => `Right(${SA.show(right)})`
     ),
-  });
+  };
 }
 
-export function getEq<A, B>(
-  SB: Eq<B>,
-  SA: Eq<A>,
-): Eq<Either<B, A>> {
-  return ({
+export function getEq<A, B>(SB: Eq<B>, SA: Eq<A>): Eq<Either<B, A>> {
+  return {
     equals: (b) => (a) => {
       if (isLeft(a)) {
         if (isLeft(b)) {
@@ -146,69 +141,70 @@ export function getEq<A, B>(
       }
       return SA.equals(b.right)(a.right);
     },
-  });
+  };
 }
 
-export function getOrd<A, B>(
-  OB: Ord<B>,
-  OA: Ord<A>,
-): Ord<Either<B, A>> {
+export function getOrd<A, B>(OB: Ord<B>, OA: Ord<A>): Ord<Either<B, A>> {
   return fromCompare((fst, snd) =>
     isLeft(fst)
-      ? isLeft(snd) ? OB.compare(fst.left, snd.left) : -1
+      ? isLeft(snd)
+        ? OB.compare(fst.left, snd.left)
+        : -1
       : isLeft(snd)
       ? 1
       : OA.compare(fst.right, snd.right)
   );
 }
 
 export function getLeftSemigroup<E = never, A = never>(
-  SE: Semigroup<E>,
+  SE: Semigroup<E>
 ): Semigroup<Either<E, A>> {
-  return ({
+  return {
     concat: (x) => (y) =>
       isRight(x) ? x : isRight(y) ? y : left(SE.concat(x.left)(y.left)),
-  });
+  };
 }
 
 export function getRightSemigroup<E = never, A = never>(
-  SA: Semigroup<A>,
+  SA: Semigroup<A>
 ): Semigroup<Either<E, A>> {
-  return ({
+  return {
     concat: (x) => (y) =>
       isLeft(x) ? x : isLeft(y) ? y : right(SA.concat(x.right)(y.right)),
-  });
+  };
 }
 
 export function getRightMonoid<E = never, A = never>(
-  MA: Monoid<A>,
+  MA: Monoid<A>
 ): Monoid<Either<E, A>> {
-  return ({
+  return {
     ...getRightSemigroup(MA),
     empty: () => right(MA.empty()),
-  });
+  };
 }
 
-export function getRightMonad<E>(
-  { concat }: Semigroup<E>,
-): Monad<RightURI<E>> {
-  return ({
+export function getRightMonad<E>({ concat }: Semigroup<E>): Monad<RightURI<E>> {
+  return {
     of,
     ap: (ua) => (ufai) =>
       isLeft(ufai)
-        ? (isLeft(ua) ? left(concat(ua.left)(ufai.left)) : ufai)
-        : (isLeft(ua) ? ua : right(ufai.right(ua.right))),
+        ? isLeft(ua)
+          ? left(concat(ua.left)(ufai.left))
+          : ufai
+        : isLeft(ua)
+        ? ua
+        : right(ufai.right(ua.right)),
     map,
     join,
     chain,
-  });
+  };
 }
 
 export function bimap<A, B, I, J>(
   fbj: (b: B) => J,
-  fai: (a: A) => I,
+  fai: (a: A) => I
 ): (ta: Either<B, A>) => Either<J, I> {
-  return (ta) => isLeft(ta) ? left(fbj(ta.left)) : right(fai(ta.right));
+  return (ta) => (isLeft(ta) ? left(fbj(ta.left)) : right(fai(ta.right)));
 }
 
 export function swap<E, A>(ma: Either<E, A>): Either<A, E> {
@@ -217,71 +213,71 @@ export function swap<E, A>(ma: Either<E, A>): Either<A, E> {
 
 export function stringifyJSON<E>(
   u: unknown,
-  onError: (reason: unknown) => E,
+  onError: (reason: unknown) => E
 ): Either<E, string> {
   return tryCatch(() => JSON.stringify(u), onError);
 }
 
 export function map<A, I>(
-  fai: (a: A) => I,
+  fai: (a: A) => I
 ): <B>(ta: Either<B, A>) => Either<B, I> {
-  return (ta) => isLeft(ta) ? ta : right(fai(ta.right));
+  return (ta) => (isLeft(ta) ? ta : right(fai(ta.right)));
 }
 
 export function chainLeft<B, I, J>(
-  fbj: (b: B) => Either<J, I>,
+  fbj: (b: B) => Either<J, I>
 ): <A>(ta: Either<B, A>) => Either<J, A | I> {
   return (tab) => (isLeft(tab) ? fbj(tab.left) : tab);
 }
 
 export function ap<A, B>(
-  ua: Either<B, A>,
+  ua: Either<B, A>
 ): <I, J>(ufai: Either<J, (a: A) => I>) => Either<B | J, I> {
   return (ufai) =>
     isLeft(ua) ? ua : isLeft(ufai) ? ufai : right(ufai.right(ua.right));
 }
 
 export function chain<A, I, J>(
-  fati: (a: A) => Either<J, I>,
+  fati: (a: A) => Either<J, I>
 ): <B>(ta: Either<B, A>) => Either<B | J, I> {
-  return (ta) => isLeft(ta) ? ta : fati(ta.right);
+  return (ta) => (isLeft(ta) ? ta : fati(ta.right));
 }
 
 export function join<A, B, J = never>(
-  ta: Either<J, Either<B, A>>,
+  ta: Either<J, Either<B, A>>
 ): Either<B | J, A> {
   return isLeft(ta) ? ta : ta.right;
 }
 
 export function mapLeft<B, J>(
-  fbj: (b: B) => J,
+  fbj: (b: B) => J
 ): <A>(ta: Either<B, A>) => Either<J, A> {
-  return (ta) => isLeft(ta) ? left(fbj(ta.left)) : ta;
+  return (ta) => (isLeft(ta) ? left(fbj(ta.left)) : ta);
 }
 
 export function alt<A, J>(
-  tb: Either<J, A>,
+  tb: Either<J, A>
 ): <B>(ta: Either<B, A>) => Either<B | J, A> {
-  return (ta) => isLeft(ta) ? tb : ta;
+  return (ta) => (isLeft(ta) ? tb : ta);
 }
 
 export function extend<A, I, B>(
-  ftai: (ta: Either<B, A>) => I,
+  ftai: (ta: Either<B, A>) => I
 ): (ta: Either<B, A>) => Either<B, I> {
   return (ta) => right(ftai(ta));
 }
 
 export function reduce<A, O>(
   foao: (o: O, a: A) => O,
-  o: O,
+  o: O
 ): <B>(ta: Either<B, A>) => O {
-  return (ta) => isLeft(ta) ? o : foao(o, ta.right);
+  return (ta) => (isLeft(ta) ? o : foao(o, ta.right));
 }
 
 export function traverse<V extends Kind>(
-  A: Applicative<V>,
+  A: Applicative<V>
 ): <A, I, J, K, L, M>(
-  faui: (a: A) => $<V, [I, J, K], [L], [M]>,
+  faui: (a: A) => $<V, [I, J, K], [L], [M]>
 ) => <B>(ta: Either<B, A>) => $<V, [Either<B, I>, J, K], [L], [M]> {
   //deno-lint-ignore no-explicit-any
   const onLeft: any = flow(left, A.of);
@@ -298,6 +294,12 @@ export const MonadEither: Monad<URI> = {
   chain,
 };
 
+export function Do() {
+  return of({});
+}
+export const bind = bind_(MonadEither);
+export const bindTo = bindTo_(MonadEither);
+
 export const BifunctorEither: Bifunctor<URI> = { bimap, mapLeft };
 
 export const AltEither: Alt<URI> = { alt, map };

functor.ts

@@ -6,8 +6,18 @@ import type { $, Kind, TypeClass } from "./kind.ts";
  */
 export interface Functor<U extends Kind> extends TypeClass<U> {
   readonly map: <A, I>(
-    fai: (value: A) => I,
+    fai: (value: A) => I
   ) => <B = never, C = never, D = unknown, E = unknown>(
-    ta: $<U, [A, B, C], [D], [E]>,
+    ta: $<U, [A, B, C], [D], [E]>
   ) => $<U, [I, B, C], [D], [E]>;
 }
+
+export function bindTo<U extends Kind>(
+  F: Functor<U>
+): <N extends string>(
+  name: N
+) => <A = never, B = never, C = never, D = unknown, E = unknown>(
+  fa: $<U, [A, B, C], [D], [E]>
+) => $<U, [{ readonly [K in N]: A }, B, C], [D], [E]> {
+  return (name) => F.map((a) => ({ [name]: a } as any));
+}