How to combine TaskT with the monad instance of Trampoline to get stackless async computations?

Question

Trampoline is a monad and adds stack-safety to a monad transformer stack. It achieves this by relying on a special interpreter (monadRec), which is fed with the result of a monadic computation (actually it is a specialized version of the free monad pattern). For this reason the Trampoline monad must be the outermost monad, that is the base monad of the transformer stack.

In the following setting TaskT (which is essentially Cont with sharing) is the monad transformer and Trampoline the base monad:

// TASK

const TaskT = taskt => record(
  TaskT,
  thisify(o => {
    o.taskt = k =>
      taskt(x => {
        o.taskt = k_ => k_(x);
        return k(x);
      });

    return o;
  }));

// Monad

const taskChainT = mmx => fmm =>
  TaskT(k =>
    mmx.taskt(x =>
      fmm(x).taskt(k)));

const taskOfT = x =>
  TaskT(k => k(x));

// Transformer

const taskLiftT = chain => mmx =>
  TaskT(k => chain(mmx) (k));

// auxiliary functions

const taskAndT = mmx => mmy =>
  taskChainT(mmx) (x =>
    taskChainT(mmy) (y =>
      taskOfT([x, y])));

const delayTaskT = f => ms => x =>
  TaskT(k => setTimeout(comp(k) (f), ms, x));

const record = (type, o) => (
  o[Symbol.toStringTag] = type.name || type, o);

const thisify = f => f({});

const log = (...ss) =>
  (console.log(...ss), ss[ss.length - 1]);

// TRAMPOLINE

const monadRec = o => {
  while (o.tag === "Chain")
    o = o.fm(o.chain);

  return o.tag === "Of"
    ? o.of
    : _throw(new TypeError("unknown trampoline tag"));
};

// tags

const Chain = chain => fm =>
  ({tag: "Chain", fm, chain});


const Of = of =>
  ({tag: "Of", of});

// Monad

const recOf = Of;

const recChain = mx => fm =>
  mx.tag === "Chain" ? Chain(mx.chain) (x => recChain(mx.fm(x)) (fm))
    : mx.tag === "Of" ? fm(mx.of)
    : _throw(new TypeError("unknown trampoline tag"));

// MAIN

const foo = x =>
  Chain(delayTaskT(x => x) (0) (x)) (Of);

const bar = taskAndT(
  taskLiftT(recChain) (foo(1)))
    (taskLiftT(recChain) (foo(2))); // yields TaskT

const main = bar.taskt(x => Of(log(x))); // yields Chain({fm, chain: TaskT})

monadRec(main); // yields [TaskT, TaskT] but [1, 2] desired

This is not what I want, because the Trampoline forces evaluation before the event loop receives the result of the asynchronous tasks. What I need is the other way around but as I've already mentioned there is no TrampolineT transformer. What am I missing?

Answer 1

There are several issues in this code snippet.

Issue #1: There is no monad transformer for IO (i.e. Task)

It's well known that there is no monad transformer for IO.^[1] Your TaskT type is modeled after ContT, and ContT is indeed a monad transformer. However, you're using TaskT to perform asynchronous computations such as setTimeout, which is where the problem arises.

Consider the definition of TaskT, which is similar to ContT.

newtype TaskT r m a = TaskT { taskt :: (a -> m r) -> m r }

Hence, delayTaskT should have the type (a -> b) -> Number -> a -> TaskT r m b.

const delayTaskT = f => ms => x =>
  TaskT(k => setTimeout(comp(k) (f), ms, x));

However, setTimeout(comp(k) (f), ms, x) returns a timeout id which does not match the type m r. Note that k => setTimeout(comp(k) (f), ms, x) should have the type (b -> m r) -> m r.

In fact, it's impossible to conjure a value of type m r when the continuation k is called asynchronously. The ContT monad transformer only works for synchronous computations.

Nevertheless, we can define Task as a specialized version of Cont.

newtype Task a = Task { task :: (a -> ()) -> () } -- Task = Cont ()

Thus, whenever Task is present in a monad transformer stack it'll always be at the base, just like IO.

If you want to make the Task monad stack safe then read the following answer.

Issue #2: The foo function has the wrong return type

Let's assume for a moment that delayTaskT has the correct type. The next issue, as you have already noticed is that foo has the wrong return type.

The problem seems to be foo which return a TaskT wrapped in a Chain and this wrapped TaskT is completely decoupled from the TaskT chain and is thus never evaluated/fired.

I'm assuming that the expected type of foo is a -> TaskT r Trampoline a. However, the actual type of foo is a -> Trampoline (TaskT r m a). Fortunately, the fix is easy.

const foo = delayTaskT(x => x) (0);

The type of foo is the same as taskOfT, i.e. a -> TaskT r m a. We can specialize m = Trampoline.

Issue #3: You're not using taskLiftT correctly

The taskLiftT function lifts an underlying monadic computation into the TaskT layer.

taskLiftT :: (forall a b. m a -> (a -> m b) -> m b) -> m a -> TaskT r m a

taskLiftT(recChain) :: Trampoline a -> TaskT r Trampoline a

Now, you're applying taskLiftT(recChain) to foo(1) and foo(2).

foo :: a -> Trampoline (TaskT r m a) -- incorrect definition of foo

foo(1) :: Trampoline (TaskT r m Number)
foo(2) :: Trampoline (TaskT r m Number)

taskLiftT(recChain) (foo(1)) :: TaskT r Trampoline (TaskT r m Number)
taskLiftT(recChain) (foo(2)) :: TaskT r Trampoline (TaskT r m Number)

However, if we use the correct definition of foo then the types wouldn't even match.

foo :: a -> TaskT r Trampoline a -- correct definition of foo

foo(1) :: TaskT r Trampoline Number
foo(2) :: TaskT r Trampoline Number

-- Can't apply taskLiftT(recChain) to foo(1) or foo(2)

If we're using the correct definition of foo then there are two ways to define bar. Note that there's no way to correctly define foo using setTimeout. Hence, I have redefined foo as taskOfT.

1. Use foo and don't use taskLiftT.

   const bar = taskAndT(foo(1))(foo(2)); // yields TaskT
   

   // TASK
   
   const TaskT = taskt => record(
     TaskT,
     thisify(o => {
       o.taskt = k =>
         taskt(x => {
           o.taskt = k_ => k_(x);
           return k(x);
         });
   
       return o;
     }));
   
   // Monad
   
   const taskChainT = mmx => fmm =>
     TaskT(k =>
       mmx.taskt(x =>
         fmm(x).taskt(k)));
   
   const taskOfT = x =>
     TaskT(k => k(x));
   
   // Transformer
   
   const taskLiftT = chain => mmx =>
     TaskT(k => chain(mmx) (k));
   
   // auxiliary functions
   
   const taskAndT = mmx => mmy =>
     taskChainT(mmx) (x =>
       taskChainT(mmy) (y =>
         taskOfT([x, y])));
   
   const delayTaskT = f => ms => x =>
     TaskT(k => setTimeout(comp(k) (f), ms, x));
   
   const record = (type, o) => (
     o[Symbol.toStringTag] = type.name || type, o);
   
   const thisify = f => f({});
   
   const log = (...ss) =>
     (console.log(...ss), ss[ss.length - 1]);
   
   // TRAMPOLINE
   
   const monadRec = o => {
     while (o.tag === "Chain")
       o = o.fm(o.chain);
   
     return o.tag === "Of"
       ? o.of
       : _throw(new TypeError("unknown trampoline tag"));
   };
   
   // tags
   
   const Chain = chain => fm =>
     ({tag: "Chain", fm, chain});
   
   
   const Of = of =>
     ({tag: "Of", of});
   
   // Monad
   
   const recOf = Of;
   
   const recChain = mx => fm =>
     mx.tag === "Chain" ? Chain(mx.chain) (x => recChain(mx.fm(x)) (fm))
       : mx.tag === "Of" ? fm(mx.of)
       : _throw(new TypeError("unknown trampoline tag"));
   
   // MAIN
   
   const foo = taskOfT;
   
   const bar = taskAndT(foo(1))(foo(2)); // yields TaskT
   
   const main = bar.taskt(x => Of(log(x))); // yields Chain({fm, chain: TaskT})
   
   monadRec(main); // yields [TaskT, TaskT] but [1, 2] desired

2. Don't use foo and use taskLiftT.

   const bar = taskAndT(
     taskLiftT(recChain) (Of(1)))
       (taskLiftT(recChain) (Of(2))); // yields TaskT
   

   // TASK
   
   const TaskT = taskt => record(
     TaskT,
     thisify(o => {
       o.taskt = k =>
         taskt(x => {
           o.taskt = k_ => k_(x);
           return k(x);
         });
   
       return o;
     }));
   
   // Monad
   
   const taskChainT = mmx => fmm =>
     TaskT(k =>
       mmx.taskt(x =>
         fmm(x).taskt(k)));
   
   const taskOfT = x =>
     TaskT(k => k(x));
   
   // Transformer
   
   const taskLiftT = chain => mmx =>
     TaskT(k => chain(mmx) (k));
   
   // auxiliary functions
   
   const taskAndT = mmx => mmy =>
     taskChainT(mmx) (x =>
       taskChainT(mmy) (y =>
         taskOfT([x, y])));
   
   const delayTaskT = f => ms => x =>
     TaskT(k => setTimeout(comp(k) (f), ms, x));
   
   const record = (type, o) => (
     o[Symbol.toStringTag] = type.name || type, o);
   
   const thisify = f => f({});
   
   const log = (...ss) =>
     (console.log(...ss), ss[ss.length - 1]);
   
   // TRAMPOLINE
   
   const monadRec = o => {
     while (o.tag === "Chain")
       o = o.fm(o.chain);
   
     return o.tag === "Of"
       ? o.of
       : _throw(new TypeError("unknown trampoline tag"));
   };
   
   // tags
   
   const Chain = chain => fm =>
     ({tag: "Chain", fm, chain});
   
   
   const Of = of =>
     ({tag: "Of", of});
   
   // Monad
   
   const recOf = Of;
   
   const recChain = mx => fm =>
     mx.tag === "Chain" ? Chain(mx.chain) (x => recChain(mx.fm(x)) (fm))
       : mx.tag === "Of" ? fm(mx.of)
       : _throw(new TypeError("unknown trampoline tag"));
   
   // MAIN
   
   const foo = taskOfT;
   
   const bar = taskAndT(
     taskLiftT(recChain) (Of(1)))
       (taskLiftT(recChain) (Of(2))); // yields TaskT
   
   const main = bar.taskt(x => Of(log(x))); // yields Chain({fm, chain: TaskT})
   
   monadRec(main); // yields [TaskT, TaskT] but [1, 2] desired

---

^[1] Why is there no IO transformer in Haskell?