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?
There are several issues in this code snippet.
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.
foo
function has the wrong return typeLet'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 aTaskT
wrapped in aChain
and this wrappedTaskT
is completely decoupled from theTaskT
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
.
taskLiftT
correctlyThe 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
.
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
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