module Test where

import Control.Concurrent
import Control.Exception
import Data.Foldable
import Data.Traversable
import GHC.TopHandler
import GHC.Wasm.Prim

-- Same thing used internally by threadDelay when JSFFI is used
foreign import javascript safe "new Promise(res => setTimeout(res, $1 / 1000))"
  js_lazy_sleep :: Int -> IO ()

foreign export ccall "testWouldBlock"
  testWouldBlock :: IO ()

-- When a Haskell function exported via C FFI attempts to block on an
-- async JSFFI import, a WouldBlockException will be thrown. Also note
-- that we need to explicitly flushStdHandles, which is required for
-- non-main exports in C FFI. In JSFFI, it's always done automatically
-- for every export though.
testWouldBlock :: IO ()
testWouldBlock = catch (threadDelay 1000000) $ \WouldBlockException -> do
  print WouldBlockException
  flushStdHandles

foreign export javascript "testLazySleep"
  testLazySleep :: Int -> Int -> IO ()

-- If async JSFFI import blocks the caller eagerly, then this would
-- sleep for t*n milliseconds, causing a noticable delay when running
-- this test case.
testLazySleep :: Int -> Int -> IO ()
testLazySleep t n = do
  thunks <- for [1..n] $ \_ -> js_lazy_sleep t
  for_ thunks evaluate
  putStrLn "zzzzzzz"

foreign export javascript "testThreadDelay"
  testThreadDelay :: Int -> Int -> IO ()

-- Some folks may still prefer to wrap their async JSFFI imports to
-- always block on waiting for the result and only expose the wrapper
-- functions. So doing concurrent requests would require forking a
-- thread per request. Which is also fine.
testThreadDelay :: Int -> Int -> IO ()
testThreadDelay t n = do
  mvars <- for [1..n] $ \_ -> newEmptyMVar
  for_ mvars $ \mv -> forkFinally (threadDelay t) $ putMVar mv
  for_ mvars takeMVar
  putStrLn "i sleep"

foreign export javascript "testInterruptingSleep"
  testInterruptingSleep :: IO ()

-- When a thread is blocked waiting for an async JSFFI import call to
-- return, it can be interrupted by a Haskell async exception. The
-- async exception will not magically cancel the pending JavaScript
-- Promise, nor will it enqueue the target thread for execution. Only
-- when that Promise actually resolves or rejects, the thread will be
-- waken up again.
--
-- The current way JSFFI handles async exception is not completely
-- satisfactory, but it's a good enough balance between implementation
-- difficulty and ease of usage.
testInterruptingSleep :: IO ()
testInterruptingSleep = do
  mv <- newEmptyMVar
  tid <- forkIO $ catch (threadDelay 1000000 *> putMVar mv (Right ())) $ \(e :: SomeException) -> putMVar mv $ Left e
  -- Without this, the thread we forked earlier likely have not even
  -- performed the call yet. It will be interrupted and silently
  -- dropped without a chance to be waken up, so the MVar will remain
  -- empty and this thread will also be suspended without waking up,
  -- eventually propagating as a "never fulfilled top-level await"
  -- error to the JavaScript host.
  threadDelay 1000
  killThread tid
  print =<< takeMVar mv
