feat: widen pipeable chain

While I'm ver averse to widening the type of the chain defined in the Chain static-land type class, I have no problem making the pipeable type class functions more useful. So for chain I widened the type of the 2nd, 3rd, and 4th type parameters. In the ongoing effort to both optimize and dogfood I started using array IndexedTraversal from array.ts and record.ts in decoder.ts. There are about the same number of any's as before and this work will need to be revisited to tighten up the types. In general I'm not a fan of the M, T, C, and W suffixes that haskell uses for go knows why. Often I see these being replicated in fp-ts and I fell prey to using them for getEitherM and getOptionM here. To rectify this I switched both usages to the more illustrative composeMonad name. This required updating their references in io_either.ts and task_either.ts. I also cleaned up some formatting in record.ts and have taken to using deno-fmt-ignore to make the indexed types a bit more readable.
nullpub · Oct 17, 2020 · ba799e5 · ba799e5
1 parent d2dcfa3
commit ba799e5
Show file tree

Hide file tree

Showing 9 changed files with 96 additions and 131 deletions.
diff --git a/array.ts b/array.ts
@@ -141,6 +141,18 @@ export const { of, ap, map, join, chain } = D.createPipeableMonad(Monad);
 
 export const { reduce, traverse } = D.createPipeableTraversable(Traversable);
 
+export const {
+  traverse: indexedTraverse,
+  reduce: indexedReduce,
+  map: indexedMap,
+}: TC.IndexedTraversableP<ReadonlyArray<_>> = {
+  map: (fab) => (ta) => _map(ta, fab),
+  reduce: (faba, a) => (tb) => _reduce(tb, faba, a),
+  traverse: <U>(A: TC.Applicative<U>) =>
+    <A, B>(faUb: (a: A, i: number) => $<U, [B]>) =>
+      (ta: readonly A[]) => IndexedTraversable.traverse(A, faUb, ta),
+};
+
 /***************************************************************************************************
  * @section Sequence
  **************************************************************************************************/

diff --git a/datum_either.ts b/datum_either.ts
@@ -171,7 +171,7 @@ export const getSemigroup = <E, A>(
  * @section Modules
  **************************************************************************************************/
 
-export const Monad = E.getEitherM(DA.Monad);
+export const Monad = E.composeMonad(DA.Monad);
 
 export const Functor: TC.Functor<DatumEither<_0, _1>, 2> = {
   map: Monad.map,

diff --git a/decoder.ts b/decoder.ts
@@ -1,14 +1,16 @@
 import type { _, Refinement } from "./types.ts";
 import type * as TC from "./type_classes.ts";
 
-import { createPipeableMonad } from "./derivations.ts";
-import { pipe } from "./fns.ts";
 import * as S from "./schemable.ts";
 import * as G from "./guard.ts";
 import * as E from "./either.ts";
 import * as T from "./tree.ts";
+import * as A from "./array.ts";
+import * as R from "./record.ts";
 import * as DE from "./decode_error.ts";
 import * as FS from "./free_semigroup.ts";
+import { createPipeableMonad } from "./derivations.ts";
+import { pipe } from "./fns.ts";
 
 /***************************************************************************************************
  * @section Types
@@ -75,7 +77,7 @@ export const fromRefinement = <I, A extends I>(
   refinement: Refinement<I, A>,
   expected: string,
 ): Decoder<I, A> => ({
-  decode: (i) => refinement(i) ? E.right(i) : E.left(error(i, expected)),
+  decode: (i) => refinement(i) ? success(i) : failure(i, expected),
 });
 
 export const fromGuard = <I, A extends I>(
@@ -87,44 +89,9 @@ export const fromGuard = <I, A extends I>(
  * @section Utilities
  **************************************************************************************************/
 
-const traverseRecordWithIndex = <A, B>(
-  f: (a: A, k: string) => Decoded<B>,
-  r: Record<string, A>,
-): Decoded<Record<string, B>> => {
-  const ks = Object.keys(r);
-  if (ks.length === 0) {
-    return Monad.of({});
-  }
-  let fr: Decoded<Record<string, B>> = Monad.of({});
-  for (const key of ks) {
-    fr = Monad.ap(
-      Monad.map((r) =>
-        (b: B) => {
-          r[key] = b;
-          return r;
-        }, fr),
-      f(r[key], key),
-    );
-  }
-  return fr;
-};
+const traverseRecordWithIndex = R.indexedTraverse(Applicative);
 
-const traverseArrayWithIndex = <A, B>(
-  fab: (a: A, i: number) => Decoded<B>,
-  as: A[],
-): Decoded<B[]> =>
-  as.reduce(
-    (mbs, a, i) =>
-      Monad.ap(
-        Monad.map((bs) =>
-          (b: B) => {
-            bs.push(b);
-            return bs;
-          }, mbs),
-        fab(a, i),
-      ),
-    Monad.of<Array<B>>([]),
-  );
+const traverseArrayWithIndex = A.indexedTraverse(Applicative);
 
 const compactRecord = <A>(
   r: Record<string, E.Either<void, A>>,
@@ -246,13 +213,15 @@ export const type = <P extends Record<string, Decoder<any, any>>>(
     pipe(
       unknownRecord.decode(i),
       chain((r) =>
-        traverseRecordWithIndex(
-          ({ decode }, key) =>
-            pipe(
-              decode(r[key]),
-              mapLeft((e) => FS.of(DE.key(key, DE.required, e))),
-            ),
+        pipe(
           properties,
+          traverseRecordWithIndex(
+            ({ decode }, key) =>
+              pipe(
+                decode(r[key]),
+                mapLeft((e) => FS.of(DE.key(key, DE.required, e))),
+              ),
+          ),
         ) as any
       ),
     ),
@@ -271,42 +240,45 @@ export const partial = <P extends Record<string, Decoder<any, any>>>(
         chain((r) =>
           Monad.map(
             compactRecord as any,
-            traverseRecordWithIndex(
-              ({ decode }, key) => {
-                const ikey = r[key];
-                if (ikey === undefined) {
-                  return key in r ? undefinedProperty : skipProperty;
-                }
-                return pipe(
-                  decode(ikey),
-                  bimap(
-                    (e) => FS.of(DE.key(key, DE.optional, e)),
-                    (a) => E.right(a),
-                  ),
-                );
-              },
+            pipe(
               properties,
+              traverseRecordWithIndex(
+                ({ decode }, key) => {
+                  const ikey = r[key];
+                  if (ikey === undefined) {
+                    return key in r ? undefinedProperty : skipProperty;
+                  }
+                  return pipe(
+                    decode(ikey),
+                    bimap(
+                      (e) => FS.of(DE.key(key, DE.optional, e)),
+                      (a) => E.right(a),
+                    ),
+                  );
+                },
+              ),
             ),
           )
         ),
       ),
   });
 };
 
-export const array = <A>(item: Decoder<unknown, A>): Decoder<unknown, A[]> => ({
+export const array = <A>(
+  item: Decoder<unknown, A>,
+): Decoder<unknown, A[]> => ({
   decode: (i) =>
     pipe(
       unknownArray.decode(i),
-      chain((as) =>
+      chain(
         traverseArrayWithIndex(
           (a, i) =>
             pipe(
               item.decode(a),
               mapLeft((e) => FS.of(DE.index(i, DE.optional, e))),
             ),
-          as,
-        )
-      ),
+        ),
+      ) as any,
     ),
 });
 
@@ -316,15 +288,14 @@ export const record = <A>(
   decode: (i) =>
     pipe(
       unknownRecord.decode(i),
-      chain((r) =>
+      chain(
         traverseRecordWithIndex(
-          (i, key) =>
+          (value, key) =>
             pipe(
-              codomain.decode(i),
+              codomain.decode(value),
               mapLeft((e) => FS.of(DE.key(key, DE.required, e))),
             ),
-          r,
-        )
+        ) as any,
       ),
     ),
 });
@@ -336,14 +307,16 @@ export const tuple = <A extends ReadonlyArray<unknown>>(
     pipe(
       unknownArray.decode(i),
       chain((as) =>
-        traverseArrayWithIndex(
-          ({ decode }, i) =>
-            pipe(
-              decode(as[i]),
-              mapLeft((e) => FS.of(DE.index(i, DE.required, e))),
-            ),
-          (components as unknown) as Decoder<any, any>[],
-        ) as any
+        pipe(
+          components,
+          traverseArrayWithIndex(
+            ({ decode }: Decoder<unknown, A[keyof A]>, i) =>
+              pipe(
+                decode(as[i]),
+                mapLeft((e) => FS.of(DE.index(i, DE.required, e))),
+              ),
+          ) as any,
+        )
       ),
     ),
 });

diff --git a/either.ts b/either.ts
@@ -276,7 +276,7 @@ export const Traversable: TC.Traversable<Either<_0, _1>, 2> = {
  **************************************************************************************************/
 
 // deno-fmt-ignore
-type GetEitherMonad = {
+type ComposeEitherMonad = {
   <T, L extends 1>(M: TC.Monad<T, L>): TC.Monad<$<T, [Either<_0, _1>]>, 2>;
   <T, L extends 2>(M: TC.Monad<T, L>): TC.Monad<$<T, [_0, Either<_1, _2>]>, 3>;
   <T, L extends 3>(M: TC.Monad<T, L>): TC.Monad<$<T, [_0, _1, Either<_2, _3>]>, 4>;
@@ -288,7 +288,7 @@ type GetEitherMonad = {
  * a bit better so we wouldn't have to do unsafe coercion.
  * @experimental
  */
-export const getEitherM: GetEitherMonad = <T>(M: TC.Monad<T>) =>
+export const composeMonad: ComposeEitherMonad = <T>(M: TC.Monad<T>) =>
   D.createMonad<$<T, [Either<_0, _1>]>, 2>({
     of: (a) => M.of(right(a)) as any,
     chain: (fatb: any, ta: any) =>

diff --git a/io_either.ts b/io_either.ts
@@ -57,7 +57,7 @@ export const Bifunctor: TC.Bifunctor<IOEither<_0, _1>> = {
   mapLeft: (fef, tea) => pipe(tea, I.map(E.mapLeft(fef))),
 };
 
-export const Monad = E.getEitherM(I.Monad);
+export const Monad = E.composeMonad(I.Monad);
 
 export const MonadThrow: TC.MonadThrow<IOEither<_0, _1>, 2> = {
   ...Monad,

diff --git a/option.ts b/option.ts
@@ -300,7 +300,7 @@ export const Traversable: TC.Traversable<Option<_>> = {
  **************************************************************************************************/
 
 // deno-fmt-ignore
-type GetOptionMonad = {
+type ComposeOptionMonad = {
   <T, L extends 1>(M: TC.Monad<T, L>): TC.Monad<$<T, [Option<_0>]>, L>;
   <T, L extends 2>(M: TC.Monad<T, L>): TC.Monad<$<T, [_0, Option<_1>]>, L>;
   <T, L extends 3>(M: TC.Monad<T, L>): TC.Monad<$<T, [_0, _1, Option<_2>]>, L>;
@@ -312,7 +312,7 @@ type GetOptionMonad = {
  * a bit better so we wouldn't have to do unsafe coercion.
  * @experimental
  */
-export const getOptionM: GetOptionMonad = <T>(M: TC.Monad<T>) =>
+export const composeMonad: ComposeOptionMonad = <T>(M: TC.Monad<T>) =>
   D.createMonad<$<T, [Option<_>]>>({
     of: (a) => M.of(some(a)) as any,
     chain: (fatb, ta) =>

diff --git a/record.ts b/record.ts
@@ -95,53 +95,31 @@ export const map = PipeableTraversable.map as <A, B>(
 
 export const reduce = PipeableTraversable.reduce;
 
+// deno-fmt-ignore
 type TraverseFn<L extends TC.LS = 1> = {
-  1: <U>(
-    A: TC.Applicative<U, L>,
-  ) => <A, B>(
-    faub: (a: A) => $<U, [B]>,
-  ) => <K extends string>(ta: Record<K, A>) => $<U, [Record<K, A>]>;
-  2: <U>(
-    A: TC.Applicative<U, L>,
-  ) => <E, A, B>(
-    faub: (a: A) => $<U, [E, B]>,
-  ) => <K extends string>(ta: Record<K, A>) => $<U, [E, Record<K, A>]>;
-  3: <U>(
-    A: TC.Applicative<U, L>,
-  ) => <R, E, A, B>(
-    faub: (a: A) => $<U, [R, E, B]>,
-  ) => <K extends string>(ta: Record<K, A>) => $<U, [R, E, Record<K, A>]>;
-  4: <U>(
-    A: TC.Applicative<U, L>,
-  ) => <S, R, E, A, B>(
-    faub: (a: A) => $<U, [S, R, E, B]>,
-  ) => <K extends string>(ta: Record<K, A>) => $<U, [S, R, E, Record<K, A>]>;
+  1: <U>(A: TC.Applicative<U, L>) => <A, B>(faub: (a: A) => $<U, [B]>)
+    => <K extends string>(ta: Record<K, A>) => $<U, [Record<K, A>]>;
+  2: <U>(A: TC.Applicative<U, L>) => <E, A, B>(faub: (a: A) => $<U, [E, B]>)
+    => <K extends string>(ta: Record<K, A>) => $<U, [E, Record<K, A>]>;
+  3: <U>(A: TC.Applicative<U, L>) => <R, E, A, B>(faub: (a: A) => $<U, [R, E, B]>)
+    => <K extends string>(ta: Record<K, A>) => $<U, [R, E, Record<K, A>]>;
+  4: <U>(A: TC.Applicative<U, L>) => <S, R, E, A, B>(faub: (a: A) => $<U, [S, R, E, B]>)
+    => <K extends string>(ta: Record<K, A>) => $<U, [S, R, E, Record<K, A>]>;
 }[L];
 
-export const traverse: TraverseFn = PipeableTraversable.traverse as TraverseFn;
+export const traverse = PipeableTraversable.traverse as TraverseFn;
 
+// deno-fmt-ignore
 type IndexedTraverseFn<I extends string = string, L extends TC.LS = 1> = {
-  1: <U>(
-    A: TC.Applicative<U, L>,
-  ) => <A, B>(
-    faub: (a: A, i: I) => $<U, [B]>,
-  ) => <K extends string>(ta: Record<K, A>) => $<U, [Record<K, A>]>;
-  2: <U>(
-    A: TC.Applicative<U, L>,
-  ) => <E, A, B>(
-    faub: (a: A, i: I) => $<U, [E, B]>,
-  ) => <K extends string>(ta: Record<K, A>) => $<U, [E, Record<K, A>]>;
-  3: <U>(
-    A: TC.Applicative<U, L>,
-  ) => <R, E, A, B>(
-    faub: (a: A, i: I) => $<U, [R, E, B]>,
-  ) => <K extends string>(ta: Record<K, A>) => $<U, [R, E, Record<K, A>]>;
-  4: <U>(
-    A: TC.Applicative<U, L>,
-  ) => <S, R, E, A, B>(
-    faub: (a: A, i: I) => $<U, [S, R, E, B]>,
-  ) => <K extends string>(ta: Record<K, A>) => $<U, [S, R, E, Record<K, A>]>;
+  1: <U>(A: TC.Applicative<U, L>) => <A, B>(faub: (a: A, i: I) => $<U, [B]>)
+    => <K extends string>(ta: Record<K, A>) => $<U, [Record<K, A>]>;
+  2: <U>(A: TC.Applicative<U, L>) => <E, A, B>(faub: (a: A, i: I) => $<U, [E, B]>)
+    => <K extends string>(ta: Record<K, A>) => $<U, [E, Record<K, A>]>;
+  3: <U>(A: TC.Applicative<U, L>) => <R, E, A, B>(faub: (a: A, i: I) => $<U, [R, E, B]>)
+    => <K extends string>(ta: Record<K, A>) => $<U, [R, E, Record<K, A>]>;
+  4: <U>(A: TC.Applicative<U, L>) => <S, R, E, A, B>(faub: (a: A, i: I) => $<U, [S, R, E, B]>)
+    => <K extends string>(ta: Record<K, A>) => $<U, [S, R, E, Record<K, A>]>;
 }[L];
 
-export const indexedTraverse: IndexedTraverseFn = PipeableTraversable
+export const indexedTraverse = PipeableTraversable
   .traverse as IndexedTraverseFn;
diff --git a/task_either.ts b/task_either.ts
@@ -62,7 +62,7 @@ export const Bifunctor: TC.Bifunctor<TaskEither<_0, _1>> = {
   mapLeft: (fef, tea) => () => tea().then(E.mapLeft(fef)),
 };
 
-export const Monad = E.getEitherM(T.Monad);
+export const Monad = E.composeMonad(T.Monad);
 
 export const MonadThrow: TC.MonadThrow<TaskEither<_0, _1>, 2> = {
   ...Monad,

diff --git a/type_classes.ts b/type_classes.ts
@@ -683,17 +683,19 @@ export type ChainP<T, L extends LS = 1> = ApplyP<T, L> & {
   readonly chain: ChainFnP<T, L>;
 };
 
+// deno-fmt-ignore
 export type ChainFnP<T, L extends LS> = {
-  1: <A, B>(fatb: (a: A) => $<T, [B]>) => (ta: $<T, [A]>) => $<T, [B]>;
+  1: <A, B>(fatb: (a: A) => $<T, [B]>)
+    => (ta: $<T, [A]>) => $<T, [B]>;
   2: <E, A, B>(
     fatb: (a: A) => $<T, [E, B]>,
-  ) => (ta: $<T, [E, A]>) => $<T, [E, B]>;
+  ) => <D>(ta: $<T, [D, A]>) => $<T, [D | E, B]>;
   3: <R, E, A, B>(
     fatb: (a: A) => $<T, [R, E, B]>,
-  ) => (ta: $<T, [R, E, A]>) => $<T, [R, E, B]>;
+  ) => <P, D>(ta: $<T, [P, D, A]>) => $<T, [P | R, D | E, B]>;
   4: <S, R, E, A, B>(
     fatb: (a: A) => $<T, [S, R, E, B]>,
-  ) => (ta: $<T, [S, R, E, A]>) => $<T, [S, R, E, B]>;
+  ) => <Q, P, D>(ta: $<T, [Q, P, D, A]>) => $<T, [Q | S, P | R, D | E, B]>;
 }[L];
 
 /**