Simplify Awaitable and move to Quasar.Awaitable

quasar.cabal

@@ -76,6 +76,7 @@ library
     transformers,
     unordered-containers,
   exposed-modules:
+    Quasar.Awaitable
     Quasar.Core
     Quasar.Observable
     Quasar.Observable.Delta

src/Quasar/Awaitable.hs

+module Quasar.Awaitable (
+  IsAwaitable(..),
+  awaitSTM,
+  Awaitable,
+  successfulAwaitable,
+  failedAwaitable,
+  completedAwaitable,
+  awaitableFromSTM,
+  peekAwaitable,
+) where
+
+
+import Control.Concurrent.STM
+import Control.Monad.Catch
+import Quasar.Prelude
+
+
+class IsAwaitable r a | a -> r where
+  peekSTM :: a -> STM (Maybe (Either SomeException r))
+  peekSTM = peekSTM . toAwaitable
+
+  toAwaitable :: a -> Awaitable r
+  toAwaitable x = Awaitable (peekSTM x)
+
+  {-# MINIMAL toAwaitable | peekSTM #-}
+
+
+-- | Wait until the promise is settled and return the result.
+awaitSTM :: IsAwaitable r a => a -> STM (Either SomeException r)
+awaitSTM = peekSTM >=> maybe retry pure
+
+
+newtype Awaitable r = Awaitable (STM (Maybe (Either SomeException r)))
+
+instance IsAwaitable r (Awaitable r) where
+  peekSTM (Awaitable x) = x
+  toAwaitable = id
+
+instance Functor Awaitable where
+  fmap fn = Awaitable . fmap (fmap (fmap fn)) . peekSTM
+
+
+completedAwaitable :: Either SomeException r -> Awaitable r
+completedAwaitable = Awaitable . pure . Just
+
+successfulAwaitable :: r -> Awaitable r
+successfulAwaitable = completedAwaitable . Right
+
+failedAwaitable :: SomeException -> Awaitable r
+failedAwaitable = completedAwaitable . Left
+
+
+peekAwaitable :: (IsAwaitable r a, MonadIO m) => a -> m (Maybe (Either SomeException r))
+peekAwaitable = liftIO . atomically . peekSTM
+
+
+awaitableFromSTM :: STM (Maybe (Either SomeException r)) -> IO (Awaitable r)
+awaitableFromSTM fn = do
+  cache <- newTVarIO (Left fn)
+  pure . Awaitable $
+    readTVar cache >>= \case
+      Left generatorFn -> do
+        value <- generatorFn
+        writeTVar cache (Right value)
+        pure value
+      Right value -> pure value
+

src/Quasar/Core.hs

 module Quasar.Core (
-  -- * Awaitable
-  IsAwaitable(..),
-  awaitSTM,
-  Awaitable,
-  successfulAwaitable,
-  failedAwaitable,
-  completedAwaitable,
-  peekAwaitable,
-
-  -- * AsyncVar
-  AsyncVar,
-  newAsyncVar,
-  putAsyncVar,
-
   -- * AsyncIO
   AsyncIO,
   async,
@@ -20,6 +6,11 @@ module Quasar.Core (
   runAsyncIO,
   awaitResult,
 
+  -- * AsyncVar
+  AsyncVar,
+  newAsyncVar,
+  putAsyncVar,
+
   -- * Disposable
   IsDisposable(..),
   Disposable,
@@ -37,69 +28,9 @@ import Control.Exception (MaskingState(..), getMaskingState)
 import Control.Monad.Catch
 import Data.Maybe (isJust)
 import Data.Void (absurd)
+import Quasar.Awaitable
 import Quasar.Prelude
 
--- * Awaitable
-
-class IsAwaitable r a | a -> r where
-  peekSTM :: a -> STM (Maybe (Either SomeException r))
-  peekSTM = peekSTM . toAwaitable
-
-  toAwaitable :: a -> Awaitable r
-  toAwaitable = SomeAwaitable
-
-  {-# MINIMAL toAwaitable | peekSTM #-}
-
-
--- | Wait until the promise is settled and return the result.
-awaitSTM :: IsAwaitable r a => a -> STM (Either SomeException r)
-awaitSTM = peekSTM >=> maybe retry pure
-
-
-data Awaitable r = forall a. IsAwaitable r a => SomeAwaitable a
-
-instance IsAwaitable r (Awaitable r) where
-  peekSTM (SomeAwaitable x) = peekSTM x
-  toAwaitable = id
-
-instance Functor Awaitable where
-  fmap fn = toAwaitable . FnAwaitable . fmap (fmap (fmap fn)) . peekSTM
-
-
-
-newtype CompletedAwaitable r = CompletedAwaitable (Either SomeException r)
-instance IsAwaitable r (CompletedAwaitable r) where
-  peekSTM (CompletedAwaitable value) = pure $ Just value
-
-completedAwaitable :: Either SomeException r -> Awaitable r
-completedAwaitable = toAwaitable . CompletedAwaitable
-
-successfulAwaitable :: r -> Awaitable r
-successfulAwaitable = completedAwaitable . Right
-
-failedAwaitable :: SomeException -> Awaitable r
-failedAwaitable = completedAwaitable . Left
-
-
-peekAwaitable :: (IsAwaitable r a, MonadIO m) => a -> m (Maybe (Either SomeException r))
-peekAwaitable = liftIO . atomically . peekSTM
-
-
-newtype FnAwaitable r = FnAwaitable (STM (Maybe (Either SomeException r)))
-instance IsAwaitable r (FnAwaitable r) where
-  peekSTM (FnAwaitable fn) = fn
-
-awaitableSTM :: STM (Maybe (Either SomeException r)) -> IO (Awaitable r)
-awaitableSTM fn = do
-  cache <- newTVarIO (Left fn)
-  pure . toAwaitable . FnAwaitable $
-    readTVar cache >>= \case
-      Left generatorFn -> do
-        value <- generatorFn
-        writeTVar cache (Right value)
-        pure value
-      Right value -> pure value
-
 
 -- * AsyncIO
 
@@ -266,7 +197,7 @@ awaitEither :: (IsAwaitable ra a , IsAwaitable rb b) => a -> b -> AsyncIO (Eithe
 awaitEither x y = AsyncIOPlumbing $ \_ _ -> AsyncIOAsync <$> awaitEitherPlumbing x y
 
 awaitEitherPlumbing :: (IsAwaitable ra a , IsAwaitable rb b) => a -> b -> IO (Awaitable (Either ra rb))
-awaitEitherPlumbing x y = awaitableSTM $ peekEitherSTM x y
+awaitEitherPlumbing x y = awaitableFromSTM $ peekEitherSTM x y
 
 peekEitherSTM :: (IsAwaitable ra a , IsAwaitable rb b) => a -> b -> STM (Maybe (Either SomeException (Either ra rb)))
 peekEitherSTM x y =

test/Quasar/AsyncSpec.hs

@@ -6,6 +6,7 @@ import Control.Monad (void, (<=<))
 import Control.Monad.IO.Class
 import Prelude
 import Test.Hspec
+import Quasar.Awaitable
 import Quasar.Core
 import System.Timeout