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 :: forall context. RunNode context -> IO ()
cancelNode RunNode context
node = forall a. TVar a -> IO a
readTVarIO (forall s l t. RunNodeCommonWithStatus s l t -> s
runTreeStatus forall a b. (a -> b) -> a -> b
$ forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeCommon RunNode context
node) 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
..} -> forall a. Async a -> IO ()
cancel Async Result
statusAsync
  Status
NotStarted -> do
    UTCTime
now <- IO UTCTime
getCurrentTime
    forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> a -> STM ()
writeTVar (forall s l t. RunNodeCommonWithStatus s l t -> s
runTreeStatus forall a b. (a -> b) -> a -> b
$ forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeCommon RunNode context
node) (UTCTime -> UTCTime -> Result -> Status
Done UTCTime
now UTCTime
now Result
Cancelled)
  Done {} -> forall (m :: * -> *) a. Monad m => a -> m a
return ()