fix: various fixes

* simplify fold for either and option * simplify createMonad to take of and chain * add Lazy, Predicate, and Refinement types to fns.ts * add isNil and isNotNil guards to fns.ts * option * add fromNullable * add fromPredicate * add tryCatch * add toNullable * add toUndefined * simplify sequenceTuple and fix off by one error * add monad associativity test to monad law tests
nullpub · Sep 12, 2020 · 4274a3a · 4274a3a
1 parent 84bcbcf
commit 4274a3a
Show file tree

Hide file tree

Showing 6 changed files with 82 additions and 54 deletions.
diff --git a/either.ts b/either.ts
@@ -1,4 +1,4 @@
-import { _0, _1 } from "./hkts.ts";
+import { _0, _1, $ } from "./hkts.ts";
 import * as SL from "./type-classes.ts";
 
 /***************************************************************************************************
@@ -23,14 +23,8 @@ export const right = <R>(right: R): Right<R> => ({ tag: "Right", right });
 export const fold = <L, R, B>(
   onLeft: (left: L) => B,
   onRight: (right: R) => B
-) => (ma: Either<L, R>): B => {
-  switch (ma.tag) {
-    case "Left":
-      return onLeft(ma.left);
-    case "Right":
-      return onRight(ma.right);
-  }
-};
+) => (ma: Either<L, R>): B =>
+  isLeft(ma) ? onLeft(ma.left) : onRight(ma.right);
 
 /***************************************************************************************************
  * @section Guards
@@ -49,9 +43,8 @@ export const Foldable: SL.Foldable2<Either<_0, _1>> = {
 };
 
 export const Monad = SL.createMonad2<Either<_0, _1>>({
-  of: (a) => right(a),
-  map: (fab, ta) => (isRight(ta) ? right(fab(ta.right)) : ta),
-  join: (tta) => (isRight(tta) ? tta.right : tta),
+  of: right,
+  chain: (fatb, ta) => (isRight(ta) ? fatb(ta.right) : ta),
 });
 
 export const Traversable: SL.Traversable2<Either<_0, _1>> = {
@@ -62,9 +55,9 @@ export const Traversable: SL.Traversable2<Either<_0, _1>> = {
 };
 
 export const Applicative: SL.Applicative2<Either<_0, _1>> = {
+  of: Monad.of,
   ap: Monad.ap,
   map: Monad.map,
-  of: Monad.of,
 };
 
 export const Apply: SL.Apply2<Either<_0, _1>> = {

diff --git a/fns.ts b/fns.ts
@@ -6,7 +6,26 @@ export type Fn<AS extends unknown[], B> = (...as: AS) => B;
 
 export type Nil = undefined | null;
 
-export type NotNil<A> = Exclude<A, Nil>;
+export interface Lazy<A> {
+  (): A;
+}
+
+export interface Predicate<A> {
+  (a: A): boolean;
+}
+
+export interface Refinement<A, B extends A> {
+  (a: A): a is B;
+}
+
+/***************************************************************************************************
+ * @section Guards
+ **************************************************************************************************/
+
+export const isNotNil = <A>(a: A): a is NonNullable<A> =>
+  a !== null && a !== undefined;
+
+export const isNil = (a: unknown): a is Nil => a === null || a === undefined;
 
 /***************************************************************************************************
  * @section Helper Functions

diff --git a/option.ts b/option.ts
@@ -1,7 +1,7 @@
-import { compose, identity } from "./fns.ts";
-import { $, _ } from "./hkts.ts";
+import { identity, isNotNil, Lazy, Predicate } from "./fns.ts";
 import * as SL from "./type-classes.ts";
 import { pipe } from "./fns.ts";
+import { _ } from "./hkts.ts";
 
 /***************************************************************************************************
  * @section Types
@@ -23,7 +23,20 @@ export const getShow = <A>({ show }: SL.Show<A>): SL.Show<Option<A>> => ({
   show: (ma) => (isNone(ma) ? "None" : `${"Some"}(${show(ma.value)})`),
 });
 
-// export
+export const fromNullable = <A>(a: A): Option<NonNullable<A>> =>
+  isNotNil(a) ? some(a) : none;
+
+export const fromPredicate = <A>(predicate: Predicate<A>) => (
+  a: A
+): Option<A> => (predicate(a) ? some(a) : none);
+
+export const tryCatch = <A>(f: Lazy<A>): Option<A> => {
+  try {
+    return some(f());
+  } catch (e) {
+    return none;
+  }
+};
 
 /***************************************************************************************************
  * @section Destructors
@@ -32,6 +45,20 @@ export const getShow = <A>({ show }: SL.Show<A>): SL.Show<Option<A>> => ({
 export const getOrElse = <B>(onNone: () => B, ta: Option<B>): B =>
   pipe(ta, fold(identity, onNone));
 
+export const toNullable = <A>(ma: Option<A>): A | null =>
+  isNone(ma) ? null : ma.value;
+
+export const toUndefined = <A>(ma: Option<A>): A | undefined =>
+  isNone(ma) ? undefined : ma.value;
+
+/***************************************************************************************************
+ * @section Combinators
+ **************************************************************************************************/
+
+export const mapNullable = <A, B>(f: (a: A) => B | null | undefined) => (
+  ma: Option<A>
+): Option<B> => (isNone(ma) ? none : fromNullable(f(ma.value)));
+
 /***************************************************************************************************
  * @section Guards
  **************************************************************************************************/
@@ -45,8 +72,7 @@ export const isSome = <A>(m: Option<A>): m is Some<A> => m.tag === "Some";
 
 export const Monad = SL.createMonad<Option<_>>({
   of: some,
-  map: (fab, ta) => (isSome(ta) ? some(fab(ta.value)) : ta),
-  join: (tta) => (isSome(tta) ? tta.value : tta),
+  chain: (fatb, ta) => (isSome(ta) ? fatb(ta.value) : ta),
 });
 
 export const Applicative: SL.Applicative<Option<_>> = {
@@ -85,14 +111,7 @@ export const Traversable: SL.Traversable<Option<_>> = {
 
 export const fold = <A, B>(onSome: (a: A) => B, onNone: () => B) => (
   ta: Option<A>
-): B => {
-  switch (ta.tag) {
-    case "None":
-      return onNone();
-    case "Some":
-      return onSome(ta.value);
-  }
-};
+): B => (isNone(ta) ? onNone() : onSome(ta.value));
 
 export const of = some;
 

diff --git a/sequence.ts b/sequence.ts
@@ -42,15 +42,7 @@ export function sequenceTuple<T>({ map, ap }: Apply<T>) {
   ): $<
     T,
     [[A, ...{ [K in keyof M]: M[K] extends $<T, [infer U]> ? U : never }]]
-  > => {
-    const len = tail.length;
-    const f = getTupleConstructor(len);
-    let fas = map(f, head);
-    for (let i = 1; i < len; i++) {
-      fas = ap(fas, tail[i]);
-    }
-    return fas;
-  };
+  > => tail.reduce(ap, map(getTupleConstructor(tail.length + 1), head));
 }
 
 export function sequenceTuple2<T>({ map, ap }: Apply2<T>) {
@@ -60,13 +52,5 @@ export function sequenceTuple2<T>({ map, ap }: Apply2<T>) {
   ): $<
     T,
     [E, [R, ...{ [K in keyof M]: M[K] extends $<T, [E, infer A]> ? A : never }]]
-  > => {
-    const len = tail.length;
-    const f = getTupleConstructor(len);
-    let fas = map(f, head);
-    for (let i = 0; i < len; i++) {
-      fas = ap(fas, tail[i]);
-    }
-    return fas;
-  };
+  > => tail.reduce(ap, map(getTupleConstructor(tail.length + 1), head));
 }
diff --git a/tests/_asserts.ts b/tests/_asserts.ts
@@ -86,6 +86,7 @@ export function assertChain<T>(
  */
 export function assertMonad<T>(M: TC.Monad<T>, name: string): void {
   const famb = (n: number) => (n < 0 ? M.of(0) : M.of(n));
+  const fbmc = (n: number) => M.of(n.toString());
 
   // Monad Left Identity: M.chain(f, M.of(a)) ≡ f(a)
   assertEquals(
@@ -101,6 +102,19 @@ export function assertMonad<T>(M: TC.Monad<T>, name: string): void {
     `${name} : Monad Right Identity`
   );
 
+  // Monad Associativity: M.chain(b => Mc, M.chain(a => Mb, Ma)) === M.chain(a => M.chain(b => Mc, (a => Mb)(a)), Ma)
+  assertEquals(
+    M.chain(fbmc, M.chain(famb, M.of(1))),
+    M.chain((a) => M.chain(fbmc, famb(a)), M.of(1)),
+    `${name} : Monad Associativity 1`
+  );
+
+  assertEquals(
+    M.chain(fbmc, M.chain(famb, M.of(-1))),
+    M.chain((a) => M.chain(fbmc, famb(a)), M.of(-1)),
+    `${name} : Monad Associativity 2`
+  );
+
   // Monads must support Applicative
   assertApplicative(M as any, name);
 

diff --git a/type-classes.ts b/type-classes.ts
@@ -1,3 +1,4 @@
+import { identity } from "./fns.ts";
 import { $ } from "./hkts.ts";
 
 /***************************************************************************************************
@@ -293,23 +294,21 @@ export type Traversable2<T> = Functor2<T> &
  */
 export function createMonad<T>({
   of,
-  map,
-  join,
-}: Pick<Monad<T>, "of" | "join" | "map">): Monad<T> {
+  chain,
+}: Pick<Monad<T>, "of" | "chain">): Monad<T> {
+  const map: Functor<T>["map"] = (fab, ta) => chain((a) => of(fab(a)), ta);
   return {
     of,
     map,
-    join,
-    ap: (tfab, ta) => join(map((a) => map((fab) => fab(a), tfab), ta)),
-    chain: (fatb, ta) => join(map(fatb, ta)),
+    chain,
+    join: (tta) => chain(identity, tta),
+    ap: (tfab, ta) => chain((f) => map(f, ta), tfab),
   };
 }
 
 /**
  * Derive Monad2 from of, map, and join.
  */
-export function createMonad2<T>(
-  M: Pick<Monad2<T>, "of" | "join" | "map">
-): Monad2<T> {
+export function createMonad2<T>(M: Pick<Monad2<T>, "of" | "chain">): Monad2<T> {
   return createMonad<T>(M as Monad<T>) as Monad2<T>;
 }