module Kafka.Worker.Stopping ( init, stopReason, stopTakingRequests, runUnlessStopping, Stopping, ) where import qualified Control.Concurrent.Async as Async import qualified Control.Concurrent.MVar as MVar import qualified Prelude newtype Stopping = Stopping (MVar.MVar Text) init :: Prelude.IO Stopping init :: IO Stopping init = IO (MVar Text) forall a. IO (MVar a) MVar.newEmptyMVar IO (MVar Text) -> (IO (MVar Text) -> IO Stopping) -> IO Stopping forall a b. a -> (a -> b) -> b |> (MVar Text -> Stopping) -> IO (MVar Text) -> IO Stopping forall (m :: * -> *) a value. Functor m => (a -> value) -> m a -> m value map MVar Text -> Stopping Stopping stopReason :: Stopping -> Prelude.IO (Maybe Text) stopReason :: Stopping -> IO (Maybe Text) stopReason (Stopping MVar Text stopping) = MVar Text -> IO (Maybe Text) forall a. MVar a -> IO (Maybe a) MVar.tryReadMVar MVar Text stopping stopTakingRequests :: Stopping -> Text -> Prelude.IO () stopTakingRequests :: Stopping -> Text -> IO () stopTakingRequests (Stopping MVar Text stopping) Text reason = do String -> IO () Prelude.putStrLn String "Gracefully shutting down..." MVar Text -> Text -> IO Bool forall a. MVar a -> a -> IO Bool MVar.tryPutMVar MVar Text stopping Text reason IO Bool -> (IO Bool -> IO ()) -> IO () forall a b. a -> (a -> b) -> b |> (Bool -> ()) -> IO Bool -> IO () forall (m :: * -> *) a value. Functor m => (a -> value) -> m a -> m value map (\Bool _ -> ()) runUnlessStopping :: Stopping -> a -> Prelude.IO a -> Prelude.IO a runUnlessStopping :: Stopping -> a -> IO a -> IO a runUnlessStopping (Stopping MVar Text stopping) a stoppingVal IO a action = IO () -> IO a -> IO (Either () a) forall a b. IO a -> IO b -> IO (Either a b) Async.race (MVar Text -> IO Text forall a. MVar a -> IO a MVar.readMVar MVar Text stopping IO Text -> (IO Text -> IO ()) -> IO () forall a b. a -> (a -> b) -> b |> (Text -> ()) -> IO Text -> IO () forall (m :: * -> *) a value. Functor m => (a -> value) -> m a -> m value map (\Text _ -> ())) IO a action IO (Either () a) -> (IO (Either () a) -> IO a) -> IO a forall a b. a -> (a -> b) -> b |> (Either () a -> a) -> IO (Either () a) -> IO a forall (m :: * -> *) a value. Functor m => (a -> value) -> m a -> m value map ( \Either () a either -> case Either () a either of Prelude.Left () -> a stoppingVal Prelude.Right a r -> a r )