{-

Unlike the async unfork functions, the blocking version doesn't require us to spawn any threads. We just grab an MVar to ensure mutual exclusion while the action runs.

Synchronous unforking can recover from exceptions thrown by the action (in contrast with the async functions, where an exception in the queue loop crashes both threads).

-}

module Unfork.Sync (unforkSyncIO, unforkSyncIO_) where

import Prelude (IO, pure)

import Control.Exception.Safe (bracket)

import qualified Control.Concurrent.MVar as MVar

{- |

    Unforks an action by blocking on a mutex lock

    Related functions:

      - Use 'unforkSyncIO_' if you don't need the action's result
      - Consider instead using 'Unfork.unforkAsyncIO', which uses a queue and a separate thread, to avoid blocking

-}

unforkSyncIO ::
    (task -> IO result) -- ^ Action that needs to be run serially
    -> IO (task -> IO result) -- ^ The unforked action

unforkSyncIO :: (task -> IO result) -> IO (task -> IO result)
unforkSyncIO task -> IO result
action = do
    MVar ()
lock <- () -> IO (MVar ())
forall a. a -> IO (MVar a)
MVar.newMVar ()
    (task -> IO result) -> IO (task -> IO result)
forall (f :: * -> *) a. Applicative f => a -> f a
pure \task
x ->
        IO () -> (() -> IO ()) -> (() -> IO result) -> IO result
forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (MVar () -> IO ()
forall a. MVar a -> IO a
MVar.takeMVar MVar ()
lock) (MVar () -> () -> IO ()
forall a. MVar a -> a -> IO ()
MVar.putMVar MVar ()
lock) \() ->
            task -> IO result
action task
x

{- |

    Unforks an action by blocking on a mutex lock, discarding the action's result

    Related functions:

      - Use 'unforkSyncIO' if you need the action's result
      - Consider instead using 'Unfork.unforkAsyncIO_', which uses a queue and a separate thread, to avoid blocking

-}

unforkSyncIO_ ::
    (task -> IO result) -- ^ Action that needs to be run serially
    -> IO (task -> IO ()) -- ^ The unforked action

unforkSyncIO_ :: (task -> IO result) -> IO (task -> IO ())
unforkSyncIO_ task -> IO result
action =
    (task -> IO ()) -> IO (task -> IO ())
forall task result. (task -> IO result) -> IO (task -> IO result)
unforkSyncIO \task
x -> do
        result
_ <- task -> IO result
action task
x
        () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()