module Development.IDE.Core.WorkerThread
(withWorkerQueue, awaitRunInThread)
where
import Control.Concurrent.Async (withAsync)
import Control.Concurrent.STM
import Control.Concurrent.Strict (newBarrier, signalBarrier,
waitBarrier)
import Control.Monad (forever)
import Control.Monad.Cont (ContT (ContT))
withWorkerQueue :: (t -> IO a) -> ContT () IO (TQueue t)
withWorkerQueue :: forall t a. (t -> IO a) -> ContT () IO (TQueue t)
withWorkerQueue t -> IO a
workerAction = ((TQueue t -> IO ()) -> IO ()) -> ContT () IO (TQueue t)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((TQueue t -> IO ()) -> IO ()) -> ContT () IO (TQueue t))
-> ((TQueue t -> IO ()) -> IO ()) -> ContT () IO (TQueue t)
forall a b. (a -> b) -> a -> b
$ \TQueue t -> IO ()
mainAction -> do
TQueue t
q <- IO (TQueue t)
forall a. IO (TQueue a)
newTQueueIO
IO Any -> (Async Any -> IO ()) -> IO ()
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync (TQueue t -> IO Any
forall {b}. TQueue t -> IO b
writerThread TQueue t
q) ((Async Any -> IO ()) -> IO ()) -> (Async Any -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Async Any
_ -> TQueue t -> IO ()
mainAction TQueue t
q
where
writerThread :: TQueue t -> IO b
writerThread TQueue t
q =
IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO a -> IO b) -> IO a -> IO b
forall a b. (a -> b) -> a -> b
$ do
t
l <- STM t -> IO t
forall a. STM a -> IO a
atomically (STM t -> IO t) -> STM t -> IO t
forall a b. (a -> b) -> a -> b
$ TQueue t -> STM t
forall a. TQueue a -> STM a
readTQueue TQueue t
q
t -> IO a
workerAction t
l
awaitRunInThread :: TQueue (IO ()) -> IO result -> IO result
awaitRunInThread :: forall result. TQueue (IO ()) -> IO result -> IO result
awaitRunInThread TQueue (IO ())
q IO result
act = do
Barrier result
barrier <- IO (Barrier result)
forall a. IO (Barrier a)
newBarrier
STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TQueue (IO ()) -> IO () -> STM ()
forall a. TQueue a -> a -> STM ()
writeTQueue TQueue (IO ())
q (IO () -> STM ()) -> IO () -> STM ()
forall a b. (a -> b) -> a -> b
$ do
result
res <- IO result
act
Barrier result -> result -> IO ()
forall a. Partial => Barrier a -> a -> IO ()
signalBarrier Barrier result
barrier result
res
Barrier result -> IO result
forall a. Barrier a -> IO a
waitBarrier Barrier result
barrier