diff --git a/src/Hedgehog/Extras/Test/Base.hs b/src/Hedgehog/Extras/Test/Base.hs index b4b8bc3e..f20f6136 100644 --- a/src/Hedgehog/Extras/Test/Base.hs +++ b/src/Hedgehog/Extras/Test/Base.hs @@ -148,6 +148,7 @@ import qualified System.Environment as IO import qualified System.Info as IO import qualified System.IO as IO import qualified System.IO.Temp as IO +import qualified System.Timeout as IO {- HLINT ignore "Reduce duplication" -} @@ -208,17 +209,19 @@ workspace prefixPath f = => FilePath -> Int -> m () - removeWorkspaceRetries ws retries = GHC.withFrozenCallStack $ do - result <- try (liftIO (IO.removePathForcibly ws)) - case result of - Right () -> return () - Left (_ :: IOException) -> do - if retries > 0 - then do - liftIO (IO.threadDelay 100000) -- wait 100ms before retrying - removeWorkspaceRetries ws (retries - 1) - else do - failMessage GHC.callStack "Failed to remove workspace directory after multiple attempts" + removeWorkspaceRetries ws retries = + GHC.withFrozenCallStack $ do + result <- try (liftIO (IO.timeout (5 * 1000) (IO.removePathForcibly ws))) + case result of + Right (Just ()) -> return () + Right Nothing -> pure () + Left (_ :: IOException) -> do + if retries > 0 + then do + liftIO (IO.threadDelay 100000) -- wait 100ms before retrying + removeWorkspaceRetries ws (retries - 1) + else do + failMessage GHC.callStack "Failed to remove workspace directory after multiple attempts" -- | Create a workspace directory which will exist for at least the duration of