feat: add some semigroups and the these adt

either.ts

@@ -1,8 +1,8 @@
 import type * as TC from "./type_classes.ts";
-import type { _0, _1 } from "./hkts.ts";
+import type { Fixed, _0, _1 } from "./hkts.ts";
 
 import { createSequenceStruct, createSequenceTuple } from "./sequence.ts";
-import { isNotNil, Lazy, Predicate, Refinement } from "./fns.ts";
+import { Fn, isNotNil, Lazy, Predicate, Refinement } from "./fns.ts";
 import * as D from "./derivations.ts";
 
 /***************************************************************************************************
@@ -79,21 +79,6 @@ export const isRight = <L, R>(m: Either<L, R>): m is Right<R> =>
  * @section Modules
  **************************************************************************************************/
 
-export const getShow = <E, A>(
-  Se: TC.Show<E>,
-  Sa: TC.Show<A>,
-): TC.Show<Either<E, A>> => ({
-  show: (ma) =>
-    isLeft(ma) ? `Left(${Se.show(ma.left)})` : `Right(${Sa.show(ma.right)})`,
-});
-
-export const getSemigroup = <E, A>(
-  S: TC.Semigroup<A>,
-): TC.Semigroup<Either<E, A>> => ({
-  concat: (x, y) =>
-    isLeft(y) ? x : isLeft(x) ? y : right(S.concat(x.right, y.right)),
-});
-
 export const Foldable: TC.Foldable<Either<_0, _1>, 2> = {
   reduce: (faba, a, tb) => (isRight(tb) ? faba(a, tb.right) : a),
 };
@@ -126,6 +111,47 @@ export const Bifunctor: TC.Bifunctor<Either<_0, _1>> = {
     isLeft(tac) ? left(fab(tac.left)) : right(fcd(tac.right)),
 };
 
+export const getShow = <E, A>(
+  Se: TC.Show<E>,
+  Sa: TC.Show<A>,
+): TC.Show<Either<E, A>> => ({
+  show: (ma) =>
+    isLeft(ma) ? `Left(${Se.show(ma.left)})` : `Right(${Sa.show(ma.right)})`,
+});
+
+export const getSemigroup = <E, A>(
+  S: TC.Semigroup<A>,
+): TC.Semigroup<Either<E, A>> => ({
+  concat: (x, y) =>
+    isLeft(y) ? x : isLeft(x) ? y : right(S.concat(x.right, y.right)),
+});
+
+export const getApplicative = <E>(
+  SE: TC.Semigroup<E>,
+): TC.Applicative<Either<Fixed<E>, _0>> => ({
+  of: right,
+  map: Applicative.map,
+  ap: (tfab, ta) =>
+    isLeft(tfab)
+      ? isLeft(ta) ? left(SE.concat(tfab.left, ta.left)) : tfab
+      : isLeft(ta)
+      ? ta
+      : right(tfab.right(ta.right)),
+});
+
+export const getMonad = <E>(
+  SE: TC.Semigroup<E>,
+): TC.Monad<Either<Fixed<E>, _0>> => {
+  const { of, ap, map } = getApplicative(SE);
+  return {
+    of,
+    ap,
+    map,
+    join: Monad.join,
+    chain: (fatb, ta) => Monad.join(map(fatb, ta)),
+  };
+};
+
 /***************************************************************************************************
  * @section Pipeables
  **************************************************************************************************/

hkts.ts

@@ -41,13 +41,11 @@ export interface Fixed<T> {
  *     // RecordInstance = <A, B>(fab: (a: A) => B, ta: { value: A }): { value: B }
  **************************************************************************************************/
 
-export type $<T, S extends any[]> = (
-  T extends Fixed<infer U> ? U
-    : T extends _<infer N> ? S[N]
-    : T extends any[] ? { [K in keyof T]: $<T[K], S> }
-    : T extends Promise<infer I> ? Promise<$<I, S>>
-    T extends (...x: infer I) => infer O ? (...x: $<I, S>) => $<O, S>
-    : T extends object ? { [K in keyof T]: $<T[K], S> }
-    : T extends undefined | null | boolean | string | number ? T
-    : T
-);
+export type $<T, S extends any[]> = T extends Fixed<infer U> ? U
+  : T extends _<infer N> ? S[N]
+  : T extends any[] ? { [K in keyof T]: $<T[K], S> }
+  : T extends Promise<infer I> ? Promise<$<I, S>>
+  : T extends (...x: infer I) => infer O ? (...x: $<I, S>) => $<O, S>
+  : T extends object ? { [K in keyof T]: $<T[K], S> }
+  : T extends undefined | null | boolean | string | number ? T
+  : T;

semigroup.ts

@@ -0,0 +1,15 @@
+import type { Semigroup } from "./type_classes.ts";
+
+import { identity } from "./fns.ts";
+
+export const getFirstSemigroup = <A = never>(): Semigroup<A> => ({
+  concat: identity,
+});
+
+export const getLastSemigroup = <A = never>(): Semigroup<A> => ({
+  concat: (_, b) => b,
+});
+
+export const getArraySemigroup = <A = never>(): Semigroup<A[]> => ({
+  concat: (as, bs) => as.concat(bs),
+});

testing/these.test.ts

@@ -0,0 +1,65 @@
+import { assertEquals } from "https://deno.land/std/testing/asserts.ts";
+
+import * as T from "../these.ts";
+import * as O from "../option.ts";
+import { assertMonad } from "./assert.ts";
+
+const add = (a: number, b: number) => a + b;
+const addOne = (n: number): number => n + 1;
+const addTwo = (n: number): number => n + 2;
+
+Deno.test({
+  name: "These Constructors",
+  fn(): void {
+    assertEquals(T.left(1), { tag: "Left", left: 1 });
+    assertEquals(T.right(1), { tag: "Right", right: 1 });
+  },
+});
+
+Deno.test({
+  name: "These Destructors",
+  fn(): void {
+    const fold = T.fold(addOne, addTwo, add);
+    assertEquals(fold(T.left(1)), 2);
+    assertEquals(fold(T.right(1)), 3);
+    assertEquals(fold(T.both(1, 2)), 3);
+  },
+});
+
+Deno.test({
+  name: "These Guards",
+  fn(): void {
+    assertEquals(T.isLeft(T.left(1)), true);
+    assertEquals(T.isLeft(T.right(1)), false);
+    assertEquals(T.isLeft(T.both(1, 2)), false);
+    assertEquals(T.isRight(T.left(1)), false);
+    assertEquals(T.isRight(T.right(1)), true);
+    assertEquals(T.isRight(T.both(1, 2)), false);
+    assertEquals(T.isBoth(T.left(1)), false);
+    assertEquals(T.isBoth(T.right(1)), false);
+    assertEquals(T.isBoth(T.both(1, 2)), true);
+  },
+});
+
+Deno.test({
+  name: "These Instances",
+  fn(): void {
+    const Monad = T.getMonad({ concat: add });
+
+    // Test Laws
+    assertMonad(Monad, "These");
+
+    // Foldable
+    const { reduce } = T.Foldable;
+    assertEquals(reduce(add, 0, T.right(1)), 1);
+    assertEquals(reduce(add, 0, T.left(1)), 0);
+    assertEquals(reduce(add, 0, T.both(1, 2)), 2);
+
+    // Traversable
+    const { traverse } = T.Traversable;
+    assertEquals(
+      traverse(O.Applicative, (a) => O.some(1), T.left(1)),
+      O.some(T.left(1)),
+    );
+  },
+});

these.ts

@@ -0,0 +1,171 @@
+import type * as TC from "./type_classes.ts";
+import type { Fixed, _0, _1 } from "./hkts.ts";
+
+import { createSequenceStruct, createSequenceTuple } from "./sequence.ts";
+import * as D from "./derivations.ts";
+import * as E from "./either.ts";
+
+/***************************************************************************************************
+ * @section Types
+ **************************************************************************************************/
+
+export type Left<L> = E.Left<L>;
+export type Right<R> = E.Right<R>;
+export type Both<L, R> = { tag: "Both"; left: L; right: R };
+export type These<L, R> = E.Either<L, R> | Both<L, R>;
+
+/***************************************************************************************************
+ * @section Constructors
+ **************************************************************************************************/
+
+export const left = E.left;
+export const right = E.right;
+export const both = <L, R>(left: L, right: R): Both<L, R> => ({
+  tag: "Both",
+  left,
+  right,
+});
+
+/***************************************************************************************************
+ * @section Destructors
+ **************************************************************************************************/
+
+export const fold = <E, A, B>(
+  onLeft: (e: E) => B,
+  onRight: (a: A) => B,
+  onBoth: (e: E, a: A) => B,
+) =>
+  (fa: These<E, A>) => {
+    switch (fa.tag) {
+      case "Left":
+        return onLeft(fa.left);
+      case "Right":
+        return onRight(fa.right);
+      case "Both":
+        return onBoth(fa.left, fa.right);
+    }
+  };
+
+/***************************************************************************************************
+ * @section Combinators
+ **************************************************************************************************/
+
+/***************************************************************************************************
+ * @section Guards
+ **************************************************************************************************/
+
+export const isLeft = <L, R>(m: These<L, R>): m is E.Left<L> =>
+  m.tag === "Left";
+export const isRight = <L, R>(m: These<L, R>): m is E.Right<R> =>
+  m.tag === "Right";
+export const isBoth = <L, R>(m: These<L, R>): m is Both<L, R> =>
+  m.tag === "Both";
+
+/***************************************************************************************************
+ * @section Modules
+ **************************************************************************************************/
+
+export const Foldable: TC.Foldable<These<_0, _1>, 2> = {
+  reduce: (faba, a, tb) =>
+    isLeft(tb) ? a : isRight(tb) ? faba(a, tb.right) : faba(a, tb.right),
+};
+
+export const Traversable: TC.Traversable<These<_0, _1>, 2> = {
+  reduce: Foldable.reduce,
+  map: (fab, ta) =>
+    isLeft(ta)
+      ? ta
+      : isRight(ta)
+      ? right(fab(ta.right))
+      : both(ta.left, fab(ta.right)),
+  traverse: (F, faub, ta) =>
+    isLeft(ta)
+      ? F.of(ta)
+      : isRight(ta)
+      ? F.map(right, faub(ta.right))
+      : F.map((r) => both(ta.left, r), faub(ta.right)),
+};
+
+export const Apply: TC.Apply<These<_0, _1>, 2> = {
+  map: Traversable.map,
+  ap: (tfab, ta) =>
+    join(Traversable.map((fab) => Traversable.map(fab, ta), tfab)),
+};
+
+export const Applicative: TC.Applicative<These<_0, _1>, 2> = {
+  of: right,
+  ap: Apply.ap,
+  map: Apply.map,
+};
+
+export const Bifunctor: TC.Bifunctor<These<_0, _1>> = {
+  bimap: (fab, fcd, tac) =>
+    isLeft(tac)
+      ? left(fab(tac.left))
+      : isRight(tac)
+      ? right(fcd(tac.right))
+      : both(fab(tac.left), fcd(tac.right)),
+};
+
+export const getShow = <E, A>(
+  SE: TC.Show<E>,
+  SA: TC.Show<A>,
+): TC.Show<These<E, A>> => ({
+  show: fold(
+    (left) => `Left(${SE.show(left)})`,
+    (right) => `Right(${SA.show(right)})`,
+    (left, right) => `Both(${SE.show(left)}, ${SA.show(right)})`,
+  ),
+});
+
+export const getSemigroup = <E, A>(
+  S: TC.Semigroup<A>,
+): TC.Semigroup<These<E, A>> => ({
+  concat: (x, y) =>
+    isLeft(y) ? x : isLeft(x) ? y : right(S.concat(x.right, y.right)),
+});
+
+export const getApplicative = <E>(
+  SE: TC.Semigroup<E>,
+): TC.Applicative<These<Fixed<E>, _0>> => ({
+  of: right,
+  map: Applicative.map,
+  ap: (tfab, ta) =>
+    isLeft(tfab)
+      ? isLeft(ta) ? left(SE.concat(tfab.left, ta.left)) : tfab
+      : isLeft(ta)
+      ? ta
+      : right(tfab.right(ta.right)),
+});
+
+export const getMonad = <E>(
+  SE: TC.Semigroup<E>,
+): TC.Monad<These<Fixed<E>, _0>> => {
+  const { of, ap, map } = getApplicative(SE);
+  return {
+    of,
+    ap,
+    map,
+    join: join,
+    chain: (fatb, ta) => join(map(fatb, ta)),
+  };
+};
+
+/***************************************************************************************************
+ * @section Pipeables
+ **************************************************************************************************/
+
+export const join: TC.MonadFn<These<_0, _1>, 2> = (tta) =>
+  isRight(tta) || isBoth(tta) ? tta.right : tta;
+
+export const { reduce, traverse } = D.createPipeableTraversable(Traversable);
+
+export const { bimap } = D.createPipeableBifunctor(Bifunctor);
+
+/***************************************************************************************************
+ * @section Sequence
+ **************************************************************************************************/
+
+export const sequenceTuple = createSequenceTuple(Apply);
+
+export const sequenceStruct = createSequenceStruct(Apply);