module Network.QUIC.Windows (
    windowsThreadBlockHack,
) where

import Control.Concurrent
import qualified Control.Exception as CE
import Control.Monad

windowsThreadBlockHack :: IO a -> IO a
windowsThreadBlockHack :: forall a. IO a -> IO a
windowsThreadBlockHack IO a
act = do
    MVar (Either SomeException a)
var <- IO (MVar (Either SomeException a))
forall a. IO (MVar a)
forall {a}. IO (MVar (Either SomeException a))
newEmptyMVar :: IO (MVar (Either CE.SomeException a))
    -- Catch and rethrow even async exceptions, so don't bother with UnliftIO
    IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ThreadId -> IO ()) -> (IO () -> IO ThreadId) -> IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ThreadId
forkIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO a -> IO (Either SomeException a)
forall e a. Exception e => IO a -> IO (Either e a)
CE.try IO a
act IO (Either SomeException a)
-> (Either SomeException a -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MVar (Either SomeException a) -> Either SomeException a -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Either SomeException a)
var
    Either SomeException a
res <- MVar (Either SomeException a) -> IO (Either SomeException a)
forall a. MVar a -> IO a
takeMVar MVar (Either SomeException a)
var
    case Either SomeException a
res of
        Left SomeException
e -> SomeException -> IO ()
forall a. Show a => a -> IO ()
print SomeException
e IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SomeException -> IO a
forall e a. Exception e => e -> IO a
CE.throwIO SomeException
e
        Right a
r -> a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r