Как объединить TaskT с экземпляром монады Trampoline, чтобы получить асинхронные вычисления без стека?

В этом фрагменте кода есть несколько проблем.

Проблема №1: для IO (то есть Task) нет монадного преобразователя

Хорошо известно, что для IO не существует преобразователя монад. ^[1] Ваш тип TaskT смоделирован после ContT, а ContT действительно является преобразователем монад. Однако вы используете TaskT для выполнения асинхронных вычислений, таких как setTimeout, и здесь возникает проблема.

Рассмотрим определение TaskT, которое похоже на ContT.

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

Следовательно, delayTaskT должен иметь тип (a -> b) -> Number -> a -> TaskT r m b.

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

Однако setTimeout(comp(k) (f), ms, x) возвращает идентификатор тайм-аута, который не соответствует типу m r. Обратите внимание, что k => setTimeout(comp(k) (f), ms, x) должен иметь тип (b -> m r) -> m r.

На самом деле невозможно вызвать значение типа m r, когда продолжение k вызывается асинхронно. Преобразователь монад ContT работает только для синхронных вычислений.

Тем не менее, мы можем определить Task как специализированную версию Cont.

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

Таким образом, всякий раз, когда Task присутствует в стеке преобразования монад, он всегда будет в основе, как и IO.

Если вы хотите сделать стек монад Task безопасным, прочитайте следующий ответ.

Проблема № 2: Функция foo имеет неправильный тип возвращаемого значения

Предположим на мгновение, что delayTaskT имеет правильный тип. Следующая проблема, как вы уже заметили, заключается в том, что foo имеет неправильный тип возвращаемого значения.

Проблема, по-видимому, заключается в том, что foo возвращает TaskT, завернутый в Chain, и этот завернутый TaskT полностью отделен от цепочки TaskT и, таким образом, никогда не оценивается/не запускается.

Я предполагаю, что ожидаемый тип foo — a -> TaskT r Trampoline a. Однако фактический тип foo — это a -> Trampoline (TaskT r m a). К счастью, это легко исправить.

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

Тип foo такой же, как taskOfT, то есть a -> TaskT r m a. Мы можем специализироваться m = Trampoline.

Проблема № 3: вы неправильно используете taskLiftT

Функция taskLiftT поднимает базовое монадическое вычисление на уровень TaskT.

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

Теперь вы применяете taskLiftT(recChain) к foo(1) и 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)

Однако, если мы используем правильное определение foo, то типы даже не будут совпадать.

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)

Если мы используем правильное определение foo, то есть два способа определить bar. Обратите внимание, что невозможно правильно определить foo с помощью setTimeout. Следовательно, я переопределил foo как taskOfT.

1. Используйте foo и не используйте 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.info(...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. Не используйте foo и используйте 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.info(...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]Почему в Haskell нет преобразователя ввода-вывода?