ki-async.hs

#!/usr/bin/env runghc

-- ki, unfork, stm

{-# LANGUAGE BlockArguments #-}

{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_GHC -threaded #-}

import Control.Concurrent qualified as Concurrent
import Control.Concurrent.STM qualified as STM
import Data.Foldable (for_)
import Ki qualified
import Prelude hiding (log)
import Unfork (unforkSyncIO_)

main :: IO ()
main = do
  log <- unforkSyncIO_ putStrLn

  log "parent: begin"

  Ki.scoped \scope -> do
    log "parent: spawning begin"

    for_ [1 .. 10 :: Int] \i ->
      Ki.fork scope do
        log $ "child" <> show i <> ": begin"
        Concurrent.threadDelay 2_000_000
        log $ "child" <> show i <> ": end"

    log "parent: spawning end"

    STM.atomically $ Ki.awaitAll scope

  log "parent: end"