forever :: IO () -> IO () можно написать, если что. Сейчас нерабочий пример попробую, уж очень загадочно

вот это помогло

Ну то есть да, проблема в том, что один из этих тредов начинает крутиться вечно и не переключается на читающий никогда

у -fno-omit-yields какие подводные камни?

asyncBounded кстати наверное еще бы помог

Вот это вот работает (без всяких тредов), видимо я что то не так понял

Теоретически меньшая производительность однопоточного кода, в середину всяких циклов нужно пихать yield

чуть выше я уже писал, что минимальный нерабочий пример работает

Короче я бы предложил взять Broadcast из пакета concurrent-extra и сделать как-то так (если я правильно запомнил Ваш полный код)

main :: IO ()
main = do
  bell <- Broadcast.new

  let
    thread1 maybeold = do
      b <- listen bell
      maybe mempty cancel maybeold
      if b
         then thread1 . Just =<< async do forever $ putStrLn "foo" >> threadDelay 1e6
         else thread1 Nothing

    thread2 maybeold = do
      b <- listen bell
      maybe mempty cancel maybeold
      if b
         then thread2 . Just =<< async do forever $ putStrLn "bar" >> threadDelay 1e6
         else thread2 Nothing

  void $ forkIO $ thread1 Nothing
  void $ forkIO $ thread2 Nothing

  void $ forever $ do
    flag <- readLn @Int
    signal bell $ flag == 1

Поллить мвар даже с yieldом идея по мне так себе, просто так проц нагружаем, эффективнее в цикле брать значение из мвара, убивать старый тред с форевером (если был), запускать новый и опять ждать следующего значения из мвара. Тогда если читающий консоль тред записал фолс остальные не крутятся в цикле, а просто спят пока новый сигнал не придет и не мешают другим работать. Читающий тред соответственно должен делать putMVar вместо костыльного modifyMVar . const.

Но брать один мвар из нескольких потоков не получится - возьмет только один из них, остальные будут спать дальше. Кмк лучше всего тут взять Broadcast, который как раз позволяет многим потокам увидеть одну запись (ну или можно использовать стандартный Chan и делать на нем dupChan) (Но теперь надо об исключениях думать, если в listen прилетит то форевер-тред утечет)

А вообще не вариант прямо в потоке ввода убивать старые потоки и запускать новые с нужными действиями?

Ну и как всегда все это дело можно обобщить в что-то типа

subscribe :: Broadcast a -> (a -> IO ()) -> IO ()
subscribe broad fn = go =<< async mempty
  where
    go old = do
      v <- listen broad `finally` uninterruptibleCancel old
      go =<< async do fn v

и юзать как

main :: IO ()
main = do
  bell <- Broadcast.new

  void $ forkIO $ subscribe bell \b -> when b $ forever $ putStrLn "foo" >> threadDelay 1e6
  void $ forkIO $ subscribe bell \b -> when b $ forever $ putStrLn "bar" >> threadDelay 1e6

  void $ forever $ do
    flag <- readLn @Int
    signal bell $ flag == 1

Лол

Рантайнм гарантирует, что все треды рано или поздно получат мвар. Или там какие-то _нюансы_?

В гхц кооперативная многозадачность, тред рано или поздно получит мвар если шедулер когда-нибудь запустится, а IIUC он запустится только если произойдет аллокация/io. Так что если есть цикл который не вызывает шедулер и при этом останавливается только если вмешается другой поток он начинает работать вечно (если не дать -fno-omit-yields или вставить явный yield руками)

Iiuc?

if i understand correctly

Прикол

Да можно написать рекурсивную функцию, которая не выделяет память и никогда не возвращается и рантайм встанет колом

Точно кооперативная?

Емнип вытесняющая