From 7f26db8d8513429511e2db3349850c23c41392d4 Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Sun, 22 Aug 2021 19:20:00 +0200
Subject: [PATCH] Fix warnings
---
quasar.cabal | 2 --
src/Quasar/Awaitable.hs | 8 +++---
src/Quasar/Core.hs | 9 +++----
src/Quasar/Observable.hs | 27 ++++++++-----------
src/Quasar/Observable/ObservableHashMap.hs | 1 -
test/Quasar/AsyncSpec.hs | 4 ---
.../Observable/ObservableHashMapSpec.hs | 3 +--
7 files changed, 19 insertions(+), 35 deletions(-)
diff --git a/quasar.cabal b/quasar.cabal
index 6592098..50fd701 100644
--- a/quasar.cabal
+++ b/quasar.cabal
@@ -67,7 +67,6 @@ library
build-depends:
base >=4.7 && <5,
binary,
- containers,
exceptions,
ghc-prim,
hashable,
@@ -99,7 +98,6 @@ test-suite quasar-test
base >=4.7 && <5,
hspec,
quasar,
- stm,
unordered-containers,
main-is: Spec.hs
other-modules:
diff --git a/src/Quasar/Awaitable.hs b/src/Quasar/Awaitable.hs
index afabb41..c182c80 100644
--- a/src/Quasar/Awaitable.hs
+++ b/src/Quasar/Awaitable.hs
@@ -8,6 +8,7 @@ module Quasar.Awaitable (
successfulAwaitable,
failedAwaitable,
completedAwaitable,
+ simpleAwaitable,
-- * Awaiting multiple awaitables
cacheAwaitable,
@@ -29,11 +30,8 @@ module Quasar.Awaitable (
import Control.Concurrent.STM
import Control.Monad.Catch
-import Control.Monad.Fix (mfix)
import Control.Monad.Reader
-import Control.Monad.Trans.Class
import Control.Monad.Trans.Maybe
-import Data.Bifunctor (bimap)
import Quasar.Prelude
@@ -102,9 +100,9 @@ instance Monad m => MonadQuerySTM (ReaderT (QueryFn m) m) where
QueryFn querySTMFn <- ask
lift $ querySTMFn query
-data QueryFn m = QueryFn (forall a. STM (Maybe a) -> m a)
+newtype QueryFn m = QueryFn (forall a. STM (Maybe a) -> m a)
-runQueryT :: forall m a. Monad m => (forall b. STM (Maybe b) -> m b) -> ReaderT (QueryFn m) m a -> m a
+runQueryT :: forall m a. (forall b. STM (Maybe b) -> m b) -> ReaderT (QueryFn m) m a -> m a
runQueryT queryFn action = runReaderT action (QueryFn queryFn)
diff --git a/src/Quasar/Core.hs b/src/Quasar/Core.hs
index 6ef0bd4..08646c8 100644
--- a/src/Quasar/Core.hs
+++ b/src/Quasar/Core.hs
@@ -43,7 +43,6 @@ import Control.Concurrent.STM
import Control.Monad.Catch
import Control.Monad.Reader
import Data.HashSet
-import Data.Sequence
import Quasar.Awaitable
import Quasar.Prelude
@@ -99,7 +98,7 @@ data ResourceManager = ResourceManager {
}
instance IsDisposable ResourceManager where
- toDisposable x = undefined
+ toDisposable = undefined
-- | A task that is running asynchronously. It has a result and can fail.
@@ -268,7 +267,7 @@ instance IsDisposable CombinedDisposable where
dispose (CombinedDisposable x y) = liftA2 (<>) (dispose x) (dispose y)
isDisposed (CombinedDisposable x y) = liftA2 (<>) (isDisposed x) (isDisposed y)
-data ListDisposable = ListDisposable [Disposable]
+newtype ListDisposable = ListDisposable [Disposable]
instance IsDisposable ListDisposable where
dispose (ListDisposable disposables) = mconcat <$> traverse dispose disposables
@@ -297,7 +296,7 @@ noDisposable = mempty
--
-- The synchronous part of the `dispose`-Function will be run immediately but the resulting `Awaitable` will be passed to the resource manager.
disposeEventually :: (IsDisposable a, MonadIO m) => ResourceManager -> a -> m ()
-disposeEventually resourceManager disposable = liftIO $ do
+disposeEventually _resourceManager disposable = liftIO $ do
disposeCompleted <- dispose disposable
peekAwaitable disposeCompleted >>= \case
Just (Left ex) -> throwIO ex
@@ -312,7 +311,7 @@ boundDisposable action = do
-- | Creates an `Disposable` that is bound to a ResourceManager. It will automatically be disposed when the resource manager is disposed.
attachDisposeAction :: MonadIO m => ResourceManager -> IO (Awaitable ()) -> m Disposable
-attachDisposeAction = undefined
+attachDisposeAction _resourceManager _action = liftIO undefined
-- | Attaches a dispose action to a ResourceManager. It will automatically be run when the resource manager is disposed.
attachDisposeAction_ :: MonadIO m => ResourceManager -> IO (Awaitable ()) -> m ()
diff --git a/src/Quasar/Observable.hs b/src/Quasar/Observable.hs
index 19f05a8..bd2eb26 100644
--- a/src/Quasar/Observable.hs
+++ b/src/Quasar/Observable.hs
@@ -35,16 +35,12 @@ import Control.Concurrent.MVar
import Control.Concurrent.STM
import Control.Monad.Catch
import Control.Monad.Except
-import Control.Monad.Reader
import Control.Monad.Trans.Maybe
import Data.HashMap.Strict qualified as HM
-import Data.IORef
import Data.Unique
import Quasar.Awaitable
import Quasar.Core
-import Quasar.Disposable
import Quasar.Prelude
-import System.IO (fixIO)
data ObservableMessage a
@@ -85,11 +81,10 @@ class IsRetrievable v o => IsObservable v o | o -> v where
-- | Observe until the callback returns `False`. The callback will also be unsubscribed when the `ResourceManager` is disposed.
observeWhile :: (IsObservable v o, HasResourceManager m) => o -> (ObservableMessage v -> IO Bool) -> m Disposable
observeWhile observable callback = do
- resourceManager <- askResourceManager
disposeVar <- liftIO $ newTVarIO False
innerDisposable <- liftIO $ observe observable \msg -> do
- disposeRequested <- atomically $ readTVar disposeVar
+ disposeRequested <- readTVarIO disposeVar
unless disposeRequested do
continue <- callback msg
unless continue $ atomically $ writeTVar disposeVar True
@@ -170,7 +165,7 @@ instance IsRetrievable r (BindObservable r) where
awaitResult $ retrieve $ fn x
instance IsObservable r (BindObservable r) where
- observe :: forall r. (BindObservable r) -> (ObservableMessage r -> IO ()) -> IO Disposable
+ observe :: BindObservable r -> (ObservableMessage r -> IO ()) -> IO Disposable
observe (BindObservable fx fn) callback = do
-- Create a resource manager to ensure all subscriptions are cleaned up when disposing.
resourceManager <- newResourceManager unlimitedResourceManagerConfiguration
@@ -205,20 +200,20 @@ instance IsObservable r (BindObservable r) where
pure $ do
disposeEventually resourceManager oldDisposable
- newDisposable <-
+ disposable <-
unmask (outerMessageHandler key observableMessage)
`onException`
atomically (putTMVar disposableVar noDisposable)
- atomically $ putTMVar disposableVar newDisposable
+ atomically $ putTMVar disposableVar disposable
-- When already disposing no new handlers should be registered
True -> pure $ pure ()
where
outerMessageHandler key (ObservableUpdate x) = observe (fn x) (innerCallback key)
- outerMessageHandler key (ObservableLoading) = noDisposable <$ callback ObservableLoading
- outerMessageHandler key (ObservableNotAvailable ex) = noDisposable <$ callback (ObservableNotAvailable ex)
+ outerMessageHandler _ ObservableLoading = noDisposable <$ callback ObservableLoading
+ outerMessageHandler _ (ObservableNotAvailable ex) = noDisposable <$ callback (ObservableNotAvailable ex)
innerCallback :: Unique -> ObservableMessage r -> IO ()
innerCallback key x = do
@@ -238,7 +233,7 @@ instance IsRetrievable r (CatchObservable e r) where
awaitResult (retrieve fx) `catch` \ex -> awaitResult (retrieve (fn ex))
instance IsObservable r (CatchObservable e r) where
- observe :: forall e r. (CatchObservable e r) -> (ObservableMessage r -> IO ()) -> IO Disposable
+ observe :: CatchObservable e r -> (ObservableMessage r -> IO ()) -> IO Disposable
observe (CatchObservable fx fn) callback = do
-- Create a resource manager to ensure all subscriptions are cleaned up when disposing.
resourceManager <- newResourceManager unlimitedResourceManagerConfiguration
@@ -273,19 +268,19 @@ instance IsObservable r (CatchObservable e r) where
pure $ do
disposeEventually resourceManager oldDisposable
- newDisposable <-
+ disposable <-
unmask (outerMessageHandler key observableMessage)
`onException`
atomically (putTMVar disposableVar noDisposable)
- atomically $ putTMVar disposableVar newDisposable
+ atomically $ putTMVar disposableVar disposable
-- When already disposing no new handlers should be registered
True -> pure $ pure ()
where
- outerMessageHandler key msg@(ObservableNotAvailable (fromException -> Just ex)) = observe (fn ex) (innerCallback key)
- outerMessageHandler key msg = noDisposable <$ callback msg
+ outerMessageHandler key (ObservableNotAvailable (fromException -> Just ex)) = observe (fn ex) (innerCallback key)
+ outerMessageHandler _ msg = noDisposable <$ callback msg
innerCallback :: Unique -> ObservableMessage r -> IO ()
innerCallback key x = do
diff --git a/src/Quasar/Observable/ObservableHashMap.hs b/src/Quasar/Observable/ObservableHashMap.hs
index 085d288..eeb9db7 100644
--- a/src/Quasar/Observable/ObservableHashMap.hs
+++ b/src/Quasar/Observable/ObservableHashMap.hs
@@ -14,7 +14,6 @@ import Data.HashMap.Strict qualified as HM
import Data.Maybe (isJust)
import Language.Haskell.TH.Syntax (mkName, nameBase)
import Lens.Micro.Platform
-import Quasar.Awaitable
import Quasar.Disposable
import Quasar.Observable
import Quasar.Observable.Delta
diff --git a/test/Quasar/AsyncSpec.hs b/test/Quasar/AsyncSpec.hs
index 9c78132..098af3f 100644
--- a/test/Quasar/AsyncSpec.hs
+++ b/test/Quasar/AsyncSpec.hs
@@ -1,7 +1,6 @@
module Quasar.AsyncSpec (spec) where
import Control.Concurrent
-import Control.Concurrent.STM
import Control.Monad (void)
import Control.Monad.IO.Class
import Prelude
@@ -10,9 +9,6 @@ import Quasar.Awaitable
import Quasar.Core
import System.Timeout
-shouldSatisfyM :: (HasCallStack, Show a) => IO a -> (a -> Bool) -> Expectation
-shouldSatisfyM action expected = action >>= (`shouldSatisfy` expected)
-
spec :: Spec
spec = parallel $ do
describe "AsyncVar" $ do
diff --git a/test/Quasar/Observable/ObservableHashMapSpec.hs b/test/Quasar/Observable/ObservableHashMapSpec.hs
index 7f808db..147fb61 100644
--- a/test/Quasar/Observable/ObservableHashMapSpec.hs
+++ b/test/Quasar/Observable/ObservableHashMapSpec.hs
@@ -1,12 +1,11 @@
module Quasar.Observable.ObservableHashMapSpec (spec) where
-import Quasar.Awaitable
import Quasar.Disposable
import Quasar.Observable
import Quasar.Observable.Delta
import Quasar.Observable.ObservableHashMap qualified as OM
-import Control.Monad ((<=<), void)
+import Control.Monad (void)
import Data.HashMap.Strict qualified as HM
import Data.IORef
import Prelude
--
GitLab