sandwich-0.2.0.0: src/Test/Sandwich/Shutdown.hs

module Test.Sandwich.Shutdown where

import Control.Concurrent.Async
import Control.Concurrent.STM
import Data.Time
import Test.Sandwich.Types.RunTree
import Test.Sandwich.Types.Spec


cancelNode :: RunNode context -> IO ()
cancelNode node = readTVarIO (runTreeStatus $ runNodeCommon node) >>= \case
  Running {..} -> cancel statusAsync
  NotStarted -> do
    now <- getCurrentTime
    atomically $ writeTVar (runTreeStatus $ runNodeCommon node) (Done now now Nothing Nothing Cancelled)
  Done {} -> return ()