{-
Module : Development.IDE.Core.WorkerThread
Author : @soulomoon
SPDX-License-Identifier: Apache-2.0

Description : This module provides an API for managing worker threads in the IDE.
see Note [Serializing runs in separate thread]
-}
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))

{-
Note [Serializing runs in separate thread]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We often want to take long-running actions using some resource that cannot be shared.
In this instance it is useful to have a queue of jobs to run using the resource.
Like the db writes, session loading in session loader, shake session restarts.

Originally we used various ways to implement this, but it was hard to maintain and error prone.
Moreover, we can not stop these threads uniformly when we are shutting down the server.
-}

-- | 'withWorkerQueue' creates a new 'TQueue', and launches a worker
-- thread which polls the queue for requests and runs the given worker
-- function on them.
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' queues up an 'IO' action to be run by a worker thread,
-- and then blocks until the result is computed.
awaitRunInThread :: TQueue (IO ()) -> IO result -> IO result
awaitRunInThread :: forall result. TQueue (IO ()) -> IO result -> IO result
awaitRunInThread TQueue (IO ())
q IO result
act = do
    -- Take an action from TQueue, run it and
    -- use barrier to wait for the result
    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