fix: implementation of these was a little wrong

Rather than manually implement getApply, getApplicative and getMonad from semigroups I opted to implement only getMonad in terms of 'chain' and then derive the rest of the instance normally via createMonad. Additionally, the monad definition for getMonad was a little long so I shortened it by changing the Fixed type to Fix. Since Apply implements ap and that function must join the left type of a These in some cases I removed the default implementation. This also means removing the default sequence helpers from These.
nullpub · Sep 20, 2020 · 532c96a · 532c96a
1 parent 82163b2
commit 532c96a
Show file tree

Hide file tree

Showing 4 changed files with 139 additions and 148 deletions.
diff --git a/either.ts b/either.ts
@@ -1,5 +1,5 @@
 import type * as TC from "./type_classes.ts";
-import type { Fixed, _0, _1 } from "./hkts.ts";
+import type { Fix, _0, _1 } from "./hkts.ts";
 
 import { createSequenceStruct, createSequenceTuple } from "./sequence.ts";
 import { Fn, isNotNil, Lazy, Predicate, Refinement } from "./fns.ts";
@@ -75,81 +75,65 @@ export const isLeft = <L, R>(m: Either<L, R>): m is Left<L> => m.tag === "Left";
 export const isRight = <L, R>(m: Either<L, R>): m is Right<R> =>
   m.tag === "Right";
 
+/***************************************************************************************************
+ * @section Module Getters
+ **************************************************************************************************/
+
+export const getShow = <E, A>(
+  SE: TC.Show<E>,
+  SA: TC.Show<A>,
+): TC.Show<Either<E, A>> => ({
+  show: fold(
+    (left) => `Left(${SE.show(left)})`,
+    (right) => `Right(${SA.show(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)),
+});
+
 /***************************************************************************************************
  * @section Modules
  **************************************************************************************************/
 
-export const Foldable: TC.Foldable<Either<_0, _1>, 2> = {
-  reduce: (faba, a, tb) => (isRight(tb) ? faba(a, tb.right) : a),
+export const Functor: TC.Functor<Either<_0, _1>, 2> = {
+  map: (fab, ta) => isLeft(ta) ? ta : right(fab(ta.right)),
+};
+
+export const Bifunctor: TC.Bifunctor<Either<_0, _1>> = {
+  bimap: (fab, fcd, tac) =>
+    isLeft(tac) ? left(fab(tac.left)) : right(fcd(tac.right)),
 };
 
 export const Monad = D.createMonad<Either<_0, _1>, 2>({
   of: right,
   chain: (fatb, ta) => (isRight(ta) ? fatb(ta.right) : ta),
 });
 
-export const Traversable: TC.Traversable<Either<_0, _1>, 2> = {
-  map: Monad.map,
-  reduce: Foldable.reduce,
-  traverse: (F, faub, ta) =>
-    isLeft(ta) ? F.of(left(ta.left)) : F.map(right, faub(ta.right)),
-};
-
 export const Applicative: TC.Applicative<Either<_0, _1>, 2> = {
   of: Monad.of,
   ap: Monad.ap,
-  map: Monad.map,
+  map: Functor.map,
 };
 
 export const Apply: TC.Apply<Either<_0, _1>, 2> = {
   ap: Monad.ap,
-  map: Monad.map,
+  map: Functor.map,
 };
 
-export const Bifunctor: TC.Bifunctor<Either<_0, _1>> = {
-  bimap: (fab, fcd, tac) =>
-    isLeft(tac) ? left(fab(tac.left)) : right(fcd(tac.right)),
+export const Foldable: TC.Foldable<Either<_0, _1>, 2> = {
+  reduce: (faba, a, tb) => (isRight(tb) ? faba(a, tb.right) : a),
 };
 
-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)),
-  };
+export const Traversable: TC.Traversable<Either<_0, _1>, 2> = {
+  map: Functor.map,
+  reduce: Foldable.reduce,
+  traverse: (F, faub, ta) =>
+    isLeft(ta) ? F.of(left(ta.left)) : F.map(right, faub(ta.right)),
 };
 
 /***************************************************************************************************

diff --git a/hkts.ts b/hkts.ts
@@ -20,14 +20,14 @@ export type _8 = _<8>;
 export type _9 = _<9>;
 
 /***************************************************************************************************
- * @section Fixed Type
+ * @section Fix Type
  * @description Fixes a type so it is not replaced by the substitution ($) type
  **************************************************************************************************/
 
-declare const fixed: unique symbol;
+declare const Fix: unique symbol;
 
-export interface Fixed<T> {
-  [fixed]: T;
+export interface Fix<T> {
+  [Fix]: T;
 }
 
 /***************************************************************************************************
@@ -41,7 +41,7 @@ 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
+export type $<T, S extends any[]> = T extends Fix<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>>

diff --git a/option.ts b/option.ts
@@ -79,17 +79,6 @@ export const isSome = <A>(m: Option<A>): m is Some<A> => m.tag === "Some";
  * @section Modules
  **************************************************************************************************/
 
-export const getShow = <A>({ show }: TC.Show<A>): TC.Show<Option<A>> => ({
-  show: (ma) => (isNone(ma) ? "None" : `${"Some"}(${show(ma.value)})`),
-});
-
-export const getSemigroup = <A>(
-  S: TC.Semigroup<A>,
-): TC.Semigroup<Option<A>> => ({
-  concat: (x, y) =>
-    isNone(x) ? y : isNone(y) ? x : of(S.concat(x.value, y.value)),
-});
-
 export const Monad = createMonad<Option<_>>({
   of: some,
   chain: (fatb, ta) => (isSome(ta) ? fatb(ta.value) : ta),
@@ -125,6 +114,17 @@ export const Traversable: TC.Traversable<Option<_>> = {
     isNone(ta) ? F.of(none) : F.map(some, faub(ta.value)),
 };
 
+export const getShow = <A>({ show }: TC.Show<A>): TC.Show<Option<A>> => ({
+  show: (ma) => (isNone(ma) ? "None" : `${"Some"}(${show(ma.value)})`),
+});
+
+export const getSemigroup = <A>(
+  S: TC.Semigroup<A>,
+): TC.Semigroup<Option<A>> => ({
+  concat: (x, y) =>
+    isNone(x) ? y : isNone(y) ? x : of(S.concat(x.value, y.value)),
+});
+
 /***************************************************************************************************
  * @section Pipeables
  **************************************************************************************************/

diff --git a/these.ts b/these.ts
@@ -1,9 +1,9 @@
 import type * as TC from "./type_classes.ts";
-import type { Fixed, _0, _1 } from "./hkts.ts";
+import type { Fix, _0, _1 } from "./hkts.ts";
 
-import { createSequenceStruct, createSequenceTuple } from "./sequence.ts";
 import * as D from "./derivations.ts";
 import * as E from "./either.ts";
+import { getLastSemigroup } from "./semigroup.ts";
 
 /***************************************************************************************************
  * @section Types
@@ -62,51 +62,9 @@ export const isBoth = <L, R>(m: These<L, R>): m is Both<L, R> =>
   m.tag === "Both";
 
 /***************************************************************************************************
- * @section Modules
+ * @section Module Getters
  **************************************************************************************************/
 
-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>,
@@ -119,53 +77,102 @@ export const getShow = <E, A>(
 });
 
 export const getSemigroup = <E, A>(
-  S: TC.Semigroup<A>,
+  SE: TC.Semigroup<E>,
+  SA: TC.Semigroup<A>,
 ): TC.Semigroup<These<E, A>> => ({
-  concat: (x, y) =>
-    isLeft(y) ? x : isLeft(x) ? y : right(S.concat(x.right, y.right)),
-});
+  concat: (x, y) => {
+    if (isLeft(x)) {
+      if (isLeft(y)) {
+        return left(SE.concat(x.left, y.left));
+      } else if (isRight(y)) {
+        return both(x.left, y.right);
+      }
+      return both(SE.concat(x.left, y.left), 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)),
+    if (isRight(x)) {
+      if (isLeft(y)) {
+        return both(y.left, x.right);
+      } else if (isRight(y)) {
+        return right(SA.concat(x.right, y.right));
+      }
+      return both(y.left, SA.concat(x.right, y.right));
+    }
+
+    if (isLeft(y)) {
+      return both(SE.concat(x.left, y.left), x.right);
+    } else if (isRight(y)) {
+      return both(x.left, SA.concat(x.right, y.right));
+    }
+    return both(SE.concat(x.left, y.left), SA.concat(x.right, y.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)),
-  };
-};
+): TC.Monad<These<Fix<E>, _0>> =>
+  D.createMonad<These<Fix<E>, _0>>({
+    of: right,
+    chain: (fatb, ta) => {
+      if (isLeft(ta)) {
+        return ta;
+      } else if (isRight(ta)) {
+        return fatb(ta.right);
+      }
+
+      const tb = fatb(ta.right);
+
+      if (isLeft(tb)) {
+        return left(SE.concat(ta.left, tb.left));
+      } else if (isRight(tb)) {
+        return both(ta.left, tb.right);
+      }
+      return both(SE.concat(ta.left, tb.left), tb.right);
+    },
+  });
 
 /***************************************************************************************************
- * @section Pipeables
+ * @section Modules
  **************************************************************************************************/
 
-export const join: TC.MonadFn<These<_0, _1>, 2> = (tta) =>
-  isRight(tta) || isBoth(tta) ? tta.right : tta;
+export const Functor: TC.Functor<These<_0, _1>, 2> = {
+  map: (fab, ta) =>
+    isLeft(ta)
+      ? ta
+      : isRight(ta)
+      ? right(fab(ta.right))
+      : both(ta.left, fab(ta.right)),
+};
 
-export const { reduce, traverse } = D.createPipeableTraversable(Traversable);
+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 { bimap } = D.createPipeableBifunctor(Bifunctor);
+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: Functor.map,
+  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)),
+};
 
 /***************************************************************************************************
- * @section Sequence
+ * @section Pipeables
  **************************************************************************************************/
 
-export const sequenceTuple = createSequenceTuple(Apply);
+export const { reduce, traverse } = D.createPipeableTraversable(Traversable);
 
-export const sequenceStruct = createSequenceStruct(Apply);
+export const { bimap } = D.createPipeableBifunctor(Bifunctor);