fix: Fix implementation of PromiseT and its typing (#160)

src/option.ts

@@ -28,6 +28,7 @@ import {
 } from "./type-class/partial-eq.ts";
 import { fromPartialCmp, type PartialOrd } from "./type-class/partial-ord.ts";
 import { semiGroupSymbol } from "./type-class/semi-group.ts";
+import { TraversableMonad } from "./type-class/traversable-monad.ts";
 import type { Traversable } from "./type-class/traversable.ts";
 
 const someSymbol = Symbol("OptionSome");
@@ -739,6 +740,30 @@ export const okOrElse = <E>(e: () => E) => <T>(opt: Option<T>): Result<E, T> =>
  */
 export const flatMap = andThen;
 
+export const apply =
+    <T1, U1>(fnOpt: Option<(t: T1) => U1>) => (tOpt: Option<T1>) =>
+        flatMap((fn: (t: T1) => U1) => map(fn)(tOpt))(fnOpt);
+
+export const foldR =
+    <A, B>(folder: (next: A) => (acc: B) => B) =>
+    (init: B) =>
+    (data: Option<A>) => {
+        if (isNone(data)) {
+            return init;
+        }
+        return folder(data[1])(init);
+    };
+
+export const traverse =
+    <F>(app: Applicative<F>) =>
+    <A, B>(visitor: (a: A) => Get1<F, B>) =>
+    (opt: Option<A>): Get1<F, Option<B>> => {
+        if (isNone(opt)) {
+            return app.pure(none() as Option<B>);
+        }
+        return app.map<B, Option<B>>(some)(visitor(opt[1]));
+    };
+
 export interface OptionHkt extends Hkt1 {
     readonly type: Option<this["arg1"]>;
 }
@@ -766,30 +791,28 @@ export const monad: Monad<OptionHkt> = {
     pure: some,
     map,
     flatMap,
-    apply: <T1, U1>(fnOpt: Option<(t: T1) => U1>) => (tOpt: Option<T1>) =>
-        flatMap((fn: (t: T1) => U1) => map(fn)(tOpt))(fnOpt),
+    apply,
 };
 
 /**
  * The instance of `Traversable` for `Option`.
  */
 export const traversable: Traversable<OptionHkt> = {
     map,
-    foldR: (folder) => (init) => (data) => {
-        if (isNone(data)) {
-            return init;
-        }
-        return folder(data[1])(init);
-    },
-    traverse:
-        <F>(app: Applicative<F>) =>
-        <A, B>(visitor: (a: A) => Get1<F, B>) =>
-        (opt: Option<A>): Get1<F, Option<B>> => {
-            if (isNone(opt)) {
-                return app.pure(none() as Option<B>);
-            }
-            return app.map<B, Option<B>>(some)(visitor(opt[1]));
-        },
+    foldR,
+    traverse,
+};
+
+/**
+ * The instance of `TraversableMonad` for `Option<_>`.
+ */
+export const traversableMonad: TraversableMonad<OptionHkt> = {
+    pure: some,
+    map,
+    flatMap: andThen,
+    apply,
+    foldR,
+    traverse,
 };
 
 export const ifSome = <T, U>(): Optic<Option<T>, Option<U>, T, U> =>

src/promise.test.ts

@@ -0,0 +1,17 @@
+import { assertEquals } from "../deps.ts";
+import { Cat, Promise, Result } from "../mod.ts";
+
+Deno.test("combine services", async () => {
+    const serviceA = (): Promise<Result.Result<Error, string>> =>
+        Promise.pure(Result.ok("foo"));
+    const serviceB = (
+        x: () => Promise<Result.Result<Error, string>>,
+    ): Promise<Result.Result<Error, string>> =>
+        Cat.doT(Promise.monadT(Result.traversableMonad<Error>()))
+            .addM("x", x())
+            .addM("y", x())
+            .finish(({ x, y }) => `Hello, ${x} and ${y}!`);
+
+    const res = await serviceB(serviceA);
+    assertEquals(res, Result.ok("Hello, foo and foo!"));
+});

src/promise.ts

@@ -11,6 +11,8 @@ import type { Monoid } from "./type-class/monoid.ts";
 import { semiGroupSymbol } from "./type-class/semi-group.ts";
 import type { SemiGroupal } from "./type-class/semi-groupal.ts";
 import type { Traversable } from "./type-class/traversable.ts";
+import type { TraversableMonad } from "./type-class/traversable-monad.ts";
+import { Pure } from "./type-class/pure.ts";
 
 /**
  * Monad transformer `PromiseT`, a generic form of `Promise`.
@@ -20,7 +22,8 @@ export type PromiseT<M, A> = Promise<Get1<M, A>>;
 /**
  * Wraps the value of monad into a `Promise`. This is an alias of `Promise.resolve`.
  */
-export const pureT: <M, A>(ma: Get1<M, A>) => PromiseT<M, A> = Promise.resolve;
+export const pureT = <M>(f: Pure<M>) => <A>(a: A): PromiseT<M, A> =>
+    Promise.resolve(f.pure(a));
 
 /**
  * Makes two `PromiseT`s into a `PromiseT` of tuple.
@@ -111,9 +114,9 @@ export const functorT = <M>(
  * @returns The instance of `Applicative` for `PromiseT<M, _>`.
  */
 export const applicativeT = <M>(
-    m: Functor<M> & Apply<M>,
+    m: Functor<M> & Apply<M> & Pure<M>,
 ): Applicative<Apply2Only<PromiseTHkt, M>> => ({
-    pure,
+    pure: pureT(m),
     map: mapT(m),
     apply: applyT(m),
 });
@@ -123,9 +126,9 @@ export const applicativeT = <M>(
  * @returns The instance of `Monad` for `PromiseT<M, _>`.
  */
 export const monadT = <M>(
-    m: Traversable<M> & Apply<M> & FlatMap<M>,
+    m: TraversableMonad<M>,
 ): Monad<Apply2Only<PromiseTHkt, M>> => ({
-    pure,
+    pure: pureT(m),
     map: mapT(m),
     apply: applyT(m),
     flatMap: flatMapT(m),
@@ -134,7 +137,7 @@ export const monadT = <M>(
 /**
  * Wraps the value into `Promise`. This is the alias of `Promise.resolve`.
  */
-export const pure = Promise.resolve;
+export const pure = <A>(value: A): Promise<A> => Promise.resolve(value);
 
 /**
  * Makes two promises into a promise of tuple.

src/result.ts

@@ -1,4 +1,4 @@
-import type { Get1, Hkt2 } from "./hkt.ts";
+import type { Apply2Only, Get1, Hkt2 } from "./hkt.ts";
 import type { Optic } from "./optical.ts";
 import { newPrism } from "./optical/prism.ts";
 import {
@@ -23,6 +23,7 @@ import {
 } from "./type-class/partial-eq.ts";
 import { fromPartialCmp, type PartialOrd } from "./type-class/partial-ord.ts";
 import { semiGroupSymbol } from "./type-class/semi-group.ts";
+import { TraversableMonad } from "./type-class/traversable-monad.ts";
 import type { Traversable } from "./type-class/traversable.ts";
 
 const okSymbol = Symbol("ResultOk");
@@ -632,30 +633,44 @@ export const monoid = <E, T>(error: E): Monoid<Result<E, T>> => ({
     [semiGroupSymbol]: true,
 });
 
-export const applicative: Applicative<ResultHkt> = {
+export const applicative = <E>(): Applicative<Apply2Only<ResultHkt, E>> => ({
     pure: ok,
     map,
     apply,
-};
+});
 
 /**
  * The instance of `Monad` for `Result<E, _>`.
  */
-export const monad: Monad<ResultHkt> = {
+export const monad = <E>(): Monad<Apply2Only<ResultHkt, E>> => ({
     pure: ok,
     map,
     flatMap: andThen,
     apply,
-};
+});
 
 /**
  * The instance of `Monad` for `Traversable<E, _>`.
  */
-export const traversable: Traversable<ResultHkt> = {
+export const traversable = <E>(): Traversable<Apply2Only<ResultHkt, E>> => ({
     map,
     foldR,
     traverse,
-};
+});
+
+/**
+ * The instance of `TraversableMonad` for `Result<E, _>`.
+ */
+export const traversableMonad = <E>(): TraversableMonad<
+    Apply2Only<ResultHkt, E>
+> => ({
+    pure: ok,
+    map,
+    flatMap: andThen,
+    apply,
+    foldR,
+    traverse,
+});
 
 /**
  * The instance of `Bifunctor` for `Result<_, _>`.

src/type-class/traversable-monad.ts

@@ -0,0 +1,4 @@
+import type { Monad } from "./monad.ts";
+import type { Traversable } from "./traversable.ts";
+
+export type TraversableMonad<T> = Traversable<T> & Monad<T>;