From f59ef36742ff63b1588d6cd16740f66cf42c0496 Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Mon, 26 Jul 2021 00:58:14 +0200
Subject: [PATCH] Remove CancellationToken
---
src/Quasar/Core.hs | 45 ----------------------------------------
test/Quasar/AsyncSpec.hs | 9 --------
2 files changed, 54 deletions(-)
diff --git a/src/Quasar/Core.hs b/src/Quasar/Core.hs
index 4d44ba6..82d68a1 100644
--- a/src/Quasar/Core.hs
+++ b/src/Quasar/Core.hs
@@ -5,9 +5,6 @@ module Quasar.Core (
await,
runAsyncIO,
awaitResult,
-
- -- * Cancellation
- withCancellationToken,
) where
import Control.Concurrent (forkIOWithUnmask)
@@ -165,45 +162,3 @@ peekEitherSTM x y =
Just (Left ex) -> pure (Just (Left ex))
Just (Right r) -> pure (Just (Right (Right r)))
Nothing -> pure Nothing
-
-
--- * Cancellation
-
-newtype CancellationToken = CancellationToken (AsyncVar Void)
-
-instance IsAwaitable Void CancellationToken where
- toAwaitable (CancellationToken var) = toAwaitable var
-
-newCancellationToken :: IO CancellationToken
-newCancellationToken = CancellationToken <$> newAsyncVar
-
-cancel :: Exception e => CancellationToken -> e -> IO ()
-cancel (CancellationToken var) = failAsyncVar_ var . toException
-
-isCancellationRequested :: CancellationToken -> IO Bool
-isCancellationRequested (CancellationToken var) = isJust <$> peekAwaitable var
-
-cancellationState :: CancellationToken -> IO (Maybe SomeException)
-cancellationState (CancellationToken var) = (either Just (const Nothing) =<<) <$> peekAwaitable var
-
-throwIfCancellationRequested :: CancellationToken -> IO ()
-throwIfCancellationRequested (CancellationToken var) =
- peekAwaitable var >>= \case
- Just (Left ex) -> throwIO ex
- _ -> pure ()
-
-awaitUnlessCancellationRequested :: IsAwaitable a b => CancellationToken -> b -> AsyncIO a
-awaitUnlessCancellationRequested cancellationToken = fmap (either absurd id) . awaitEither cancellationToken . toAwaitable
-
-
-withCancellationToken :: (CancellationToken -> IO a) -> IO a
-withCancellationToken action = do
- cancellationToken <- newCancellationToken
- resultMVar :: MVar (Either SomeException a) <- newEmptyMVar
-
- uninterruptibleMask $ \unmask -> do
- void $ forkIOWithUnmask $ \threadUnmask -> do
- putMVar resultMVar =<< try (threadUnmask (action cancellationToken))
-
- -- TODO test if it is better to run readMVar recursively or to keep it uninterruptible
- either throwIO pure =<< (unmask (readMVar resultMVar) `catchAll` (\ex -> cancel cancellationToken ex >> readMVar resultMVar))
diff --git a/test/Quasar/AsyncSpec.hs b/test/Quasar/AsyncSpec.hs
index c1a00cc..5feed6d 100644
--- a/test/Quasar/AsyncSpec.hs
+++ b/test/Quasar/AsyncSpec.hs
@@ -69,12 +69,3 @@ spec = parallel $ do
-- Use bind to create an AsyncIOPlumbing, which is the interesting case that uses `uninterruptibleMask` when run
await never >>= pure
result `shouldBe` Nothing
-
- describe "CancellationToken" $ do
- it "propagates outer exceptions to the cancellation token" $ do
- result <- timeout 100000 $ withCancellationToken (runAsyncIO . await)
- result `shouldBe` Nothing
-
- it "can return a value after cancellation" $ do
- result <- timeout 100000 $ withCancellationToken (fmap (either (const True) (const False)) . atomically . awaitSTM)
- result `shouldBe` Just True
--
GitLab