{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
-- |

module Test.Sandwich.Shutdown where

import Control.Concurrent.Async
import Control.Concurrent.STM
import Test.Sandwich.Types.RunTree


cancelNode :: RunNode context -> IO ()
cancelNode :: RunNode context -> IO ()
cancelNode RunNode context
node = TVar Status -> IO Status
forall a. TVar a -> IO a
readTVarIO (RunNodeCommonWithStatus
  (TVar Status) (Var (Seq LogEntry)) (Var Bool)
-> TVar Status
forall s l t. RunNodeCommonWithStatus s l t -> s
runTreeStatus (RunNodeCommonWithStatus
   (TVar Status) (Var (Seq LogEntry)) (Var Bool)
 -> TVar Status)
-> RunNodeCommonWithStatus
     (TVar Status) (Var (Seq LogEntry)) (Var Bool)
-> TVar Status
forall a b. (a -> b) -> a -> b
$ RunNode context
-> RunNodeCommonWithStatus
     (TVar Status) (Var (Seq LogEntry)) (Var Bool)
forall context s l t.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeCommon RunNode context
node) IO Status -> (Status -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Running {UTCTime
Async Result
statusAsync :: Status -> Async Result
statusStartTime :: Status -> UTCTime
statusAsync :: Async Result
statusStartTime :: UTCTime
..} -> Async Result -> IO ()
forall a. Async a -> IO ()
cancel Async Result
statusAsync
  Status
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()