context 0.2.0.0 → 0.2.0.1
raw patch · 8 files changed
+574/−576 lines, 8 filesdep ~basedep ~containersPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, containers
API changes (from Hackage documentation)
Files
- CHANGELOG.md +4/−0
- context.cabal +3/−3
- library/Context/Concurrent.hs +14/−15
- library/Context/Internal.hs +12/−14
- package.yaml +3/−3
- test-suite/Test/Context/ConcurrentSpec.hs +216/−217
- test-suite/Test/Context/ImplicitSpec.hs +79/−80
- test-suite/Test/ContextSpec.hs +243/−244
CHANGELOG.md view
@@ -1,5 +1,9 @@ # Change log +## 0.2.0.1++* Backwards compatibility with GHC 8.4 (@pbrisbin)+ ## 0.2.0.0 * Lift signatures from `IO` to `MonadIO`, `MonadThrow` and `MonadMask`
context.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: context-version: 0.2.0.0+version: 0.2.0.1 synopsis: Thread-indexed, nested contexts description: Thread-indexed storage around arbitrary context values. The interface supports nesting context values per thread, and at any point, the calling thread may@@ -43,8 +43,8 @@ library ghc-options: -Wall -fwarn-tabs -Wincomplete-uni-patterns -Wredundant-constraints build-depends:- base >=4.12 && <5- , containers >=0.6.0.1 && <0.7+ base >=4.11.1.0 && <5+ , containers >=0.5.11.0 && <0.7 , exceptions >=0.10.0 && <0.11 default-language: Haskell2010
library/Context/Concurrent.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE BlockArguments #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE RankNTypes #-} @@ -60,7 +59,7 @@ -- @since 0.1.0.0 forkIO :: IO () -> IO ThreadId forkIO action = do- Internal.withPropagator \propagate -> do+ Internal.withPropagator $ \propagate -> do Concurrent.forkIO $ propagate action -- | See 'Concurrent.forkFinally'.@@ -72,9 +71,9 @@ -- Control.Concurrent function. This enables us to propagate context a single -- time to make it available to both the thread's main action and terminating -- action.- Internal.withPropagator \propagate -> do- Exception.mask \restore -> do- Concurrent.forkIO $ propagate do+ Internal.withPropagator $ \propagate -> do+ Exception.mask $ \restore -> do+ Concurrent.forkIO $ propagate $ do Exception.try (restore action) >>= and_then -- | See 'Concurrent.forkIOWithUnmask'.@@ -82,8 +81,8 @@ -- @since 0.1.0.0 forkIOWithUnmask :: ((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId forkIOWithUnmask io = do- Internal.withPropagator \propagate -> do- Concurrent.forkIOWithUnmask \restore -> do+ Internal.withPropagator $ \propagate -> do+ Concurrent.forkIOWithUnmask $ \restore -> do propagate $ io restore -- | See 'Concurrent.forkOn'.@@ -91,7 +90,7 @@ -- @since 0.1.0.0 forkOn :: Int -> IO () -> IO ThreadId forkOn cpu action = do- Internal.withPropagator \propagate -> do+ Internal.withPropagator $ \propagate -> do Concurrent.forkOn cpu $ propagate action -- | See 'Concurrent.forkOnWithUnmask'.@@ -99,8 +98,8 @@ -- @since 0.1.0.0 forkOnWithUnmask :: Int -> ((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId forkOnWithUnmask cpu io = do- Internal.withPropagator \propagate -> do- Concurrent.forkOnWithUnmask cpu \restore -> do+ Internal.withPropagator $ \propagate -> do+ Concurrent.forkOnWithUnmask cpu $ \restore -> do propagate $ io restore -- | See 'Concurrent.forkOS'.@@ -108,7 +107,7 @@ -- @since 0.1.0.0 forkOS :: IO () -> IO ThreadId forkOS action = do- Internal.withPropagator \propagate -> do+ Internal.withPropagator $ \propagate -> do Concurrent.forkOS $ propagate action -- | See 'Concurrent.forkOSWithUnmask'.@@ -116,8 +115,8 @@ -- @since 0.1.0.0 forkOSWithUnmask :: ((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId forkOSWithUnmask io = do- Internal.withPropagator \propagate -> do- Concurrent.forkOSWithUnmask \restore -> do+ Internal.withPropagator $ \propagate -> do+ Concurrent.forkOSWithUnmask $ \restore -> do propagate $ io restore -- | See 'Concurrent.runInBoundThread'.@@ -125,7 +124,7 @@ -- @since 0.1.0.0 runInBoundThread :: IO a -> IO a runInBoundThread action =- Internal.withPropagator \propagate -> do+ Internal.withPropagator $ \propagate -> do Concurrent.runInBoundThread $ propagate action -- | See 'Concurrent.runInUnboundThread'.@@ -133,7 +132,7 @@ -- @since 0.1.0.0 runInUnboundThread :: IO a -> IO a runInUnboundThread action =- Internal.withPropagator \propagate -> do+ Internal.withPropagator $ \propagate -> do Concurrent.runInUnboundThread $ propagate action -- $intro
library/Context/Internal.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE BlockArguments #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-}@@ -128,7 +127,7 @@ -> ctx -> m () setDefault Store { ref } context = do- liftIO $ IORef.atomicModifyIORef' ref \state ->+ liftIO $ IORef.atomicModifyIORef' ref $ \state -> (state { def = Just context }, ()) throwContextNotFound@@ -159,11 +158,10 @@ mineMayOnDefault onDefault Store { ref } = do threadId <- liftIO $ Concurrent.myThreadId State { stacks, def } <- liftIO $ IORef.readIORef ref- pure- case Map.lookup threadId stacks of- Nothing -> onDefault def- Just [] -> bug "mineMayOnDefault"- Just (context : _rest) -> Just context+ pure $ case Map.lookup threadId stacks of+ Nothing -> onDefault def+ Just [] -> bug "mineMayOnDefault"+ Just (context : _rest) -> Just context -- | Register a context in the specified 'Store' on behalf of the calling -- thread, for the duration of the specified action.@@ -208,7 +206,7 @@ -> m a withStore propagationStrategy mContext f = do store <- newStore propagationStrategy mContext- Catch.finally (f store) do+ Catch.finally (f store) $ do case propagationStrategy of NoPropagation -> pure () LatestPropagation -> liftIO $ unregister registry store@@ -256,7 +254,7 @@ push :: Store ctx -> ctx -> IO () push Store { ref } context = do threadId <- Concurrent.myThreadId- IORef.atomicModifyIORef' ref \state@State { stacks } ->+ IORef.atomicModifyIORef' ref $ \state@State { stacks } -> case Map.lookup threadId stacks of Nothing -> (state { stacks = Map.insert threadId [context] stacks }, ())@@ -266,7 +264,7 @@ pop :: Store ctx -> IO () pop Store { ref } = do threadId <- Concurrent.myThreadId- IORef.atomicModifyIORef' ref \state@State { stacks } ->+ IORef.atomicModifyIORef' ref $ \state@State { stacks } -> case Map.lookup threadId stacks of Nothing -> bug "pop-1" Just [] -> bug "pop-2"@@ -341,8 +339,8 @@ withRegisteredPropagator Registry { ref } f = do stores <- IORef.readIORef ref propagator <- do- fmap (foldr (.) id) do- Traversable.for stores \case+ fmap (foldr (.) id) $ do+ Traversable.for stores $ \case MkAnyStore store -> do -- N.B. When propagating context and the "parent" thread doesn't -- have any specific context in this particular store but there is@@ -357,12 +355,12 @@ register :: Registry -> Store ctx -> IO () register Registry { ref } store@Store { key } = do- IORef.atomicModifyIORef' ref \stores ->+ IORef.atomicModifyIORef' ref $ \stores -> (Map.insert key (MkAnyStore store) stores, ()) unregister :: Registry -> Store ctx -> IO () unregister Registry { ref } Store { key } = do- IORef.atomicModifyIORef' ref \stores ->+ IORef.atomicModifyIORef' ref $ \stores -> (Map.delete key stores, ()) bug :: HasCallStack => String -> a
package.yaml view
@@ -1,5 +1,5 @@ name: context-version: '0.2.0.0'+version: '0.2.0.1' github: "jship/context" license: MIT license-file: LICENSE.md@@ -27,8 +27,8 @@ library: dependencies:- - base >=4.12 && <5- - containers >=0.6.0.1 && <0.7+ - base >=4.11.1.0 && <5+ - containers >=0.5.11.0 && <0.7 - exceptions >=0.10.0 && <0.11 source-dirs: library
test-suite/Test/Context/ConcurrentSpec.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE BlockArguments #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NoImplicitPrelude #-}@@ -19,414 +18,414 @@ spec :: Spec spec = do- describe "forkIO" do- describe "mineMay" do- it "empty stores" do+ describe "forkIO" $ do+ describe "mineMay" $ do+ it "empty stores" $ do threadDone <- Context.newEmptyMVar- Context.withEmptyStore @IO @Thing \store1 -> do- Context.withEmptyStore @IO @Char \store2 -> do- Monad.void $ Context.forkIO do+ Context.withEmptyStore @IO @Thing $ \store1 -> do+ Context.withEmptyStore @IO @Char $ \store2 -> do+ Monad.void $ Context.forkIO $ do Context.mineMay store1 `shouldReturn` Nothing Context.mineMay store2 `shouldReturn` Nothing Context.putMVar threadDone () Context.takeMVar threadDone- it "initially-empty stores with registered context" do+ it "initially-empty stores with registered context" $ do threadDone <- Context.newEmptyMVar- Context.withEmptyStore \store1 -> do- Context.use store1 Thing { stuff = 1 } do- Context.withEmptyStore \store2 -> do- Context.use store2 'a' do- Monad.void $ Context.forkIO do+ Context.withEmptyStore $ \store1 -> do+ Context.use store1 Thing { stuff = 1 } $ do+ Context.withEmptyStore $ \store2 -> do+ Context.use store2 'a' $ do+ Monad.void $ Context.forkIO $ do Context.mineMay store1 `shouldReturn` Just Thing { stuff = 1 } Context.mineMay store2 `shouldReturn` Just 'a' Context.putMVar threadDone () Context.takeMVar threadDone- it "initially-empty stores with nested contexts" do+ it "initially-empty stores with nested contexts" $ do threadDone <- Context.newEmptyMVar- Context.withEmptyStore \store1 -> do- Context.use store1 Thing { stuff = 1 } do- Context.use store1 Thing { stuff = 2 } do- Context.withEmptyStore \store2 -> do- Context.use store2 'a' do- Context.use store2 'b' do- Monad.void $ Context.forkIO do+ Context.withEmptyStore $ \store1 -> do+ Context.use store1 Thing { stuff = 1 } $ do+ Context.use store1 Thing { stuff = 2 } $ do+ Context.withEmptyStore $ \store2 -> do+ Context.use store2 'a' $ do+ Context.use store2 'b' $ do+ Monad.void $ Context.forkIO $ do Context.mineMay store1 `shouldReturn` Just Thing { stuff = 2 } Context.mineMay store2 `shouldReturn` Just 'b' Context.putMVar threadDone () Context.takeMVar threadDone- it "non-empty stores" do+ it "non-empty stores" $ do threadDone <- Context.newEmptyMVar- Context.withNonEmptyStore Thing { stuff = 1 } \store1 -> do- Context.withNonEmptyStore 'a' \store2 -> do- Monad.void $ Context.forkIO do+ Context.withNonEmptyStore Thing { stuff = 1 } $ \store1 -> do+ Context.withNonEmptyStore 'a' $ \store2 -> do+ Monad.void $ Context.forkIO $ do Context.mineMay store1 `shouldReturn` Just Thing { stuff = 1 } Context.mineMay store2 `shouldReturn` Just 'a' Context.putMVar threadDone () Context.takeMVar threadDone - describe "forkFinally" do- describe "mineMay" do- it "empty stores" do+ describe "forkFinally" $ do+ describe "mineMay" $ do+ it "empty stores" $ do threadDone <- Context.newEmptyMVar- Context.withEmptyStore @IO @Thing \store1 -> do- Context.withEmptyStore @IO @Char \store2 -> do+ Context.withEmptyStore @IO @Thing $ \store1 -> do+ Context.withEmptyStore @IO @Char $ \store2 -> do let checkStores = do Context.mineMay store1 `shouldReturn` Nothing Context.mineMay store2 `shouldReturn` Nothing- Monad.void $ Context.forkFinally checkStores \_eResult -> do+ Monad.void $ Context.forkFinally checkStores $ \_eResult -> do checkStores Context.putMVar threadDone () Context.takeMVar threadDone- it "initially-empty stores with registered context" do+ it "initially-empty stores with registered context" $ do threadDone <- Context.newEmptyMVar- Context.withEmptyStore \store1 -> do- Context.use store1 Thing { stuff = 1 } do- Context.withEmptyStore \store2 -> do- Context.use store2 'a' do+ Context.withEmptyStore $ \store1 -> do+ Context.use store1 Thing { stuff = 1 } $ do+ Context.withEmptyStore $ \store2 -> do+ Context.use store2 'a' $ do let checkStores = do Context.mineMay store1 `shouldReturn` Just Thing { stuff = 1 } Context.mineMay store2 `shouldReturn` Just 'a'- Monad.void $ Context.forkFinally checkStores \_eResult -> do+ Monad.void $ Context.forkFinally checkStores $ \_eResult -> do checkStores Context.putMVar threadDone () Context.takeMVar threadDone- it "initially-empty stores with nested contexts" do+ it "initially-empty stores with nested contexts" $ do threadDone <- Context.newEmptyMVar- Context.withEmptyStore \store1 -> do- Context.use store1 Thing { stuff = 1 } do- Context.use store1 Thing { stuff = 2 } do- Context.withEmptyStore \store2 -> do- Context.use store2 'a' do- Context.use store2 'b' do+ Context.withEmptyStore $ \store1 -> do+ Context.use store1 Thing { stuff = 1 } $ do+ Context.use store1 Thing { stuff = 2 } $ do+ Context.withEmptyStore $ \store2 -> do+ Context.use store2 'a' $ do+ Context.use store2 'b' $ do let checkStores = do Context.mineMay store1 `shouldReturn` Just Thing { stuff = 2 } Context.mineMay store2 `shouldReturn` Just 'b'- Monad.void $ Context.forkFinally checkStores \_eResult -> do+ Monad.void $ Context.forkFinally checkStores $ \_eResult -> do checkStores Context.putMVar threadDone () Context.takeMVar threadDone- it "non-empty stores" do+ it "non-empty stores" $ do threadDone <- Context.newEmptyMVar- Context.withNonEmptyStore Thing { stuff = 1 } \store1 -> do- Context.withNonEmptyStore 'a' \store2 -> do+ Context.withNonEmptyStore Thing { stuff = 1 } $ \store1 -> do+ Context.withNonEmptyStore 'a' $ \store2 -> do let checkStores = do Context.mineMay store1 `shouldReturn` Just Thing { stuff = 1 } Context.mineMay store2 `shouldReturn` Just 'a'- Monad.void $ Context.forkFinally checkStores \_eResult -> do+ Monad.void $ Context.forkFinally checkStores $ \_eResult -> do checkStores Context.putMVar threadDone () Context.takeMVar threadDone - describe "forkIOWithUnmask" do- describe "mineMay" do- it "empty stores" do+ describe "forkIOWithUnmask" $ do+ describe "mineMay" $ do+ it "empty stores" $ do threadDone <- Context.newEmptyMVar- Context.withEmptyStore @IO @Thing \store1 -> do- Context.withEmptyStore @IO @Char \store2 -> do- Monad.void $ Context.forkIOWithUnmask \_restore -> do+ Context.withEmptyStore @IO @Thing $ \store1 -> do+ Context.withEmptyStore @IO @Char $ \store2 -> do+ Monad.void $ Context.forkIOWithUnmask $ \_restore -> do Context.mineMay store1 `shouldReturn` Nothing Context.mineMay store2 `shouldReturn` Nothing Context.putMVar threadDone () Context.takeMVar threadDone- it "initially-empty stores with registered context" do+ it "initially-empty stores with registered context" $ do threadDone <- Context.newEmptyMVar- Context.withEmptyStore \store1 -> do- Context.use store1 Thing { stuff = 1 } do- Context.withEmptyStore \store2 -> do- Context.use store2 'a' do- Monad.void $ Context.forkIOWithUnmask \_restore -> do+ Context.withEmptyStore $ \store1 -> do+ Context.use store1 Thing { stuff = 1 } $ do+ Context.withEmptyStore $ \store2 -> do+ Context.use store2 'a' $ do+ Monad.void $ Context.forkIOWithUnmask $ \_restore -> do Context.mineMay store1 `shouldReturn` Just Thing { stuff = 1 } Context.mineMay store2 `shouldReturn` Just 'a' Context.putMVar threadDone () Context.takeMVar threadDone- it "initially-empty stores with nested contexts" do+ it "initially-empty stores with nested contexts" $ do threadDone <- Context.newEmptyMVar- Context.withEmptyStore \store1 -> do- Context.use store1 Thing { stuff = 1 } do- Context.use store1 Thing { stuff = 2 } do- Context.withEmptyStore \store2 -> do- Context.use store2 'a' do- Context.use store2 'b' do- Monad.void $ Context.forkIOWithUnmask \_restore -> do+ Context.withEmptyStore $ \store1 -> do+ Context.use store1 Thing { stuff = 1 } $ do+ Context.use store1 Thing { stuff = 2 } $ do+ Context.withEmptyStore $ \store2 -> do+ Context.use store2 'a' $ do+ Context.use store2 'b' $ do+ Monad.void $ Context.forkIOWithUnmask $ \_restore -> do Context.mineMay store1 `shouldReturn` Just Thing { stuff = 2 } Context.mineMay store2 `shouldReturn` Just 'b' Context.putMVar threadDone () Context.takeMVar threadDone- it "non-empty stores" do+ it "non-empty stores" $ do threadDone <- Context.newEmptyMVar- Context.withNonEmptyStore Thing { stuff = 1 } \store1 -> do- Context.withNonEmptyStore 'a' \store2 -> do- Monad.void $ Context.forkIOWithUnmask \_restore -> do+ Context.withNonEmptyStore Thing { stuff = 1 } $ \store1 -> do+ Context.withNonEmptyStore 'a' $ \store2 -> do+ Monad.void $ Context.forkIOWithUnmask $ \_restore -> do Context.mineMay store1 `shouldReturn` Just Thing { stuff = 1 } Context.mineMay store2 `shouldReturn` Just 'a' Context.putMVar threadDone () Context.takeMVar threadDone - describe "forkOn" do- describe "mineMay" do- it "empty stores" do+ describe "forkOn" $ do+ describe "mineMay" $ do+ it "empty stores" $ do threadDone <- Context.newEmptyMVar- Context.withEmptyStore @IO @Thing \store1 -> do- Context.withEmptyStore @IO @Char \store2 -> do- Monad.void $ Context.forkOn 1 do+ Context.withEmptyStore @IO @Thing $ \store1 -> do+ Context.withEmptyStore @IO @Char $ \store2 -> do+ Monad.void $ Context.forkOn 1 $ do Context.mineMay store1 `shouldReturn` Nothing Context.mineMay store2 `shouldReturn` Nothing Context.putMVar threadDone () Context.takeMVar threadDone- it "initially-empty stores with registered context" do+ it "initially-empty stores with registered context" $ do threadDone <- Context.newEmptyMVar- Context.withEmptyStore \store1 -> do- Context.use store1 Thing { stuff = 1 } do- Context.withEmptyStore \store2 -> do- Context.use store2 'a' do- Monad.void $ Context.forkOn 1 do+ Context.withEmptyStore $ \store1 -> do+ Context.use store1 Thing { stuff = 1 } $ do+ Context.withEmptyStore $ \store2 -> do+ Context.use store2 'a' $ do+ Monad.void $ Context.forkOn 1 $ do Context.mineMay store1 `shouldReturn` Just Thing { stuff = 1 } Context.mineMay store2 `shouldReturn` Just 'a' Context.putMVar threadDone () Context.takeMVar threadDone- it "initially-empty stores with nested contexts" do+ it "initially-empty stores with nested contexts" $ do threadDone <- Context.newEmptyMVar- Context.withEmptyStore \store1 -> do- Context.use store1 Thing { stuff = 1 } do- Context.use store1 Thing { stuff = 2 } do- Context.withEmptyStore \store2 -> do- Context.use store2 'a' do- Context.use store2 'b' do- Monad.void $ Context.forkOn 1 do+ Context.withEmptyStore $ \store1 -> do+ Context.use store1 Thing { stuff = 1 } $ do+ Context.use store1 Thing { stuff = 2 } $ do+ Context.withEmptyStore $ \store2 -> do+ Context.use store2 'a' $ do+ Context.use store2 'b' $ do+ Monad.void $ Context.forkOn 1 $ do Context.mineMay store1 `shouldReturn` Just Thing { stuff = 2 } Context.mineMay store2 `shouldReturn` Just 'b' Context.putMVar threadDone () Context.takeMVar threadDone- it "non-empty stores" do+ it "non-empty stores" $ do threadDone <- Context.newEmptyMVar- Context.withNonEmptyStore Thing { stuff = 1 } \store1 -> do- Context.withNonEmptyStore 'a' \store2 -> do- Monad.void $ Context.forkOn 1 do+ Context.withNonEmptyStore Thing { stuff = 1 } $ \store1 -> do+ Context.withNonEmptyStore 'a' $ \store2 -> do+ Monad.void $ Context.forkOn 1 $ do Context.mineMay store1 `shouldReturn` Just Thing { stuff = 1 } Context.mineMay store2 `shouldReturn` Just 'a' Context.putMVar threadDone () Context.takeMVar threadDone - describe "forkOnWithUnmask" do- describe "mineMay" do- it "empty stores" do+ describe "forkOnWithUnmask" $ do+ describe "mineMay" $ do+ it "empty stores" $ do threadDone <- Context.newEmptyMVar- Context.withEmptyStore @IO @Thing \store1 -> do- Context.withEmptyStore @IO @Char \store2 -> do- Monad.void $ Context.forkOnWithUnmask 1 \_restore -> do+ Context.withEmptyStore @IO @Thing $ \store1 -> do+ Context.withEmptyStore @IO @Char $ \store2 -> do+ Monad.void $ Context.forkOnWithUnmask 1 $ \_restore -> do Context.mineMay store1 `shouldReturn` Nothing Context.mineMay store2 `shouldReturn` Nothing Context.putMVar threadDone () Context.takeMVar threadDone- it "initially-empty stores with registered context" do+ it "initially-empty stores with registered context" $ do threadDone <- Context.newEmptyMVar- Context.withEmptyStore \store1 -> do- Context.use store1 Thing { stuff = 1 } do- Context.withEmptyStore \store2 -> do- Context.use store2 'a' do- Monad.void $ Context.forkOnWithUnmask 1 \_restore -> do+ Context.withEmptyStore $ \store1 -> do+ Context.use store1 Thing { stuff = 1 } $ do+ Context.withEmptyStore $ \store2 -> do+ Context.use store2 'a' $ do+ Monad.void $ Context.forkOnWithUnmask 1 $ \_restore -> do Context.mineMay store1 `shouldReturn` Just Thing { stuff = 1 } Context.mineMay store2 `shouldReturn` Just 'a' Context.putMVar threadDone () Context.takeMVar threadDone- it "initially-empty stores with nested contexts" do+ it "initially-empty stores with nested contexts" $ do threadDone <- Context.newEmptyMVar- Context.withEmptyStore \store1 -> do- Context.use store1 Thing { stuff = 1 } do- Context.use store1 Thing { stuff = 2 } do- Context.withEmptyStore \store2 -> do- Context.use store2 'a' do- Context.use store2 'b' do- Monad.void $ Context.forkOnWithUnmask 1 \_restore -> do+ Context.withEmptyStore $ \store1 -> do+ Context.use store1 Thing { stuff = 1 } $ do+ Context.use store1 Thing { stuff = 2 } $ do+ Context.withEmptyStore $ \store2 -> do+ Context.use store2 'a' $ do+ Context.use store2 'b' $ do+ Monad.void $ Context.forkOnWithUnmask 1 $ \_restore -> do Context.mineMay store1 `shouldReturn` Just Thing { stuff = 2 } Context.mineMay store2 `shouldReturn` Just 'b' Context.putMVar threadDone () Context.takeMVar threadDone- it "non-empty stores" do+ it "non-empty stores" $ do threadDone <- Context.newEmptyMVar- Context.withNonEmptyStore Thing { stuff = 1 } \store1 -> do- Context.withNonEmptyStore 'a' \store2 -> do- Monad.void $ Context.forkOnWithUnmask 1 \_restore -> do+ Context.withNonEmptyStore Thing { stuff = 1 } $ \store1 -> do+ Context.withNonEmptyStore 'a' $ \store2 -> do+ Monad.void $ Context.forkOnWithUnmask 1 $ \_restore -> do Context.mineMay store1 `shouldReturn` Just Thing { stuff = 1 } Context.mineMay store2 `shouldReturn` Just 'a' Context.putMVar threadDone () Context.takeMVar threadDone - describe "forkOS" do- describe "mineMay" do- it "empty stores" do+ describe "forkOS" $ do+ describe "mineMay" $ do+ it "empty stores" $ do threadDone <- Context.newEmptyMVar- Context.withEmptyStore @IO @Thing \store1 -> do- Context.withEmptyStore @IO @Char \store2 -> do- Monad.void $ Context.forkOS do+ Context.withEmptyStore @IO @Thing $ \store1 -> do+ Context.withEmptyStore @IO @Char $ \store2 -> do+ Monad.void $ Context.forkOS $ do Context.mineMay store1 `shouldReturn` Nothing Context.mineMay store2 `shouldReturn` Nothing Context.putMVar threadDone () Context.takeMVar threadDone- it "initially-empty stores with registered context" do+ it "initially-empty stores with registered context" $ do threadDone <- Context.newEmptyMVar- Context.withEmptyStore \store1 -> do- Context.use store1 Thing { stuff = 1 } do- Context.withEmptyStore \store2 -> do- Context.use store2 'a' do- Monad.void $ Context.forkOS do+ Context.withEmptyStore $ \store1 -> do+ Context.use store1 Thing { stuff = 1 } $ do+ Context.withEmptyStore $ \store2 -> do+ Context.use store2 'a' $ do+ Monad.void $ Context.forkOS $ do Context.mineMay store1 `shouldReturn` Just Thing { stuff = 1 } Context.mineMay store2 `shouldReturn` Just 'a' Context.putMVar threadDone () Context.takeMVar threadDone- it "initially-empty stores with nested contexts" do+ it "initially-empty stores with nested contexts" $ do threadDone <- Context.newEmptyMVar- Context.withEmptyStore \store1 -> do- Context.use store1 Thing { stuff = 1 } do- Context.use store1 Thing { stuff = 2 } do- Context.withEmptyStore \store2 -> do- Context.use store2 'a' do- Context.use store2 'b' do- Monad.void $ Context.forkOS do+ Context.withEmptyStore $ \store1 -> do+ Context.use store1 Thing { stuff = 1 } $ do+ Context.use store1 Thing { stuff = 2 } $ do+ Context.withEmptyStore $ \store2 -> do+ Context.use store2 'a' $ do+ Context.use store2 'b' $ do+ Monad.void $ Context.forkOS $ do Context.mineMay store1 `shouldReturn` Just Thing { stuff = 2 } Context.mineMay store2 `shouldReturn` Just 'b' Context.putMVar threadDone () Context.takeMVar threadDone- it "non-empty stores" do+ it "non-empty stores" $ do threadDone <- Context.newEmptyMVar- Context.withNonEmptyStore Thing { stuff = 1 } \store1 -> do- Context.withNonEmptyStore 'a' \store2 -> do- Monad.void $ Context.forkOS do+ Context.withNonEmptyStore Thing { stuff = 1 } $ \store1 -> do+ Context.withNonEmptyStore 'a' $ \store2 -> do+ Monad.void $ Context.forkOS $ do Context.mineMay store1 `shouldReturn` Just Thing { stuff = 1 } Context.mineMay store2 `shouldReturn` Just 'a' Context.putMVar threadDone () Context.takeMVar threadDone - describe "forkOSWithUnmask" do- describe "mineMay" do- it "empty stores" do+ describe "forkOSWithUnmask" $ do+ describe "mineMay" $ do+ it "empty stores" $ do threadDone <- Context.newEmptyMVar- Context.withEmptyStore @IO @Thing \store1 -> do- Context.withEmptyStore @IO @Char \store2 -> do- Monad.void $ Context.forkOSWithUnmask \_restore -> do+ Context.withEmptyStore @IO @Thing $ \store1 -> do+ Context.withEmptyStore @IO @Char $ \store2 -> do+ Monad.void $ Context.forkOSWithUnmask $ \_restore -> do Context.mineMay store1 `shouldReturn` Nothing Context.mineMay store2 `shouldReturn` Nothing Context.putMVar threadDone () Context.takeMVar threadDone- it "initially-empty stores with registered context" do+ it "initially-empty stores with registered context" $ do threadDone <- Context.newEmptyMVar- Context.withEmptyStore \store1 -> do- Context.use store1 Thing { stuff = 1 } do- Context.withEmptyStore \store2 -> do- Context.use store2 'a' do- Monad.void $ Context.forkOSWithUnmask \_restore -> do+ Context.withEmptyStore $ \store1 -> do+ Context.use store1 Thing { stuff = 1 } $ do+ Context.withEmptyStore $ \store2 -> do+ Context.use store2 'a' $ do+ Monad.void $ Context.forkOSWithUnmask $ \_restore -> do Context.mineMay store1 `shouldReturn` Just Thing { stuff = 1 } Context.mineMay store2 `shouldReturn` Just 'a' Context.putMVar threadDone () Context.takeMVar threadDone- it "initially-empty stores with nested contexts" do+ it "initially-empty stores with nested contexts" $ do threadDone <- Context.newEmptyMVar- Context.withEmptyStore \store1 -> do- Context.use store1 Thing { stuff = 1 } do- Context.use store1 Thing { stuff = 2 } do- Context.withEmptyStore \store2 -> do- Context.use store2 'a' do- Context.use store2 'b' do- Monad.void $ Context.forkOSWithUnmask \_restore -> do+ Context.withEmptyStore $ \store1 -> do+ Context.use store1 Thing { stuff = 1 } $ do+ Context.use store1 Thing { stuff = 2 } $ do+ Context.withEmptyStore $ \store2 -> do+ Context.use store2 'a' $ do+ Context.use store2 'b' $ do+ Monad.void $ Context.forkOSWithUnmask $ \_restore -> do Context.mineMay store1 `shouldReturn` Just Thing { stuff = 2 } Context.mineMay store2 `shouldReturn` Just 'b' Context.putMVar threadDone () Context.takeMVar threadDone- it "non-empty stores" do+ it "non-empty stores" $ do threadDone <- Context.newEmptyMVar- Context.withNonEmptyStore Thing { stuff = 1 } \store1 -> do- Context.withNonEmptyStore 'a' \store2 -> do- Monad.void $ Context.forkOSWithUnmask \_restore -> do+ Context.withNonEmptyStore Thing { stuff = 1 } $ \store1 -> do+ Context.withNonEmptyStore 'a' $ \store2 -> do+ Monad.void $ Context.forkOSWithUnmask $ \_restore -> do Context.mineMay store1 `shouldReturn` Just Thing { stuff = 1 } Context.mineMay store2 `shouldReturn` Just 'a' Context.putMVar threadDone () Context.takeMVar threadDone - describe "runInBoundThread" do- describe "mineMay" do- it "empty stores" do+ describe "runInBoundThread" $ do+ describe "mineMay" $ do+ it "empty stores" $ do threadDone <- Context.newEmptyMVar- Context.withEmptyStore @IO @Thing \store1 -> do- Context.withEmptyStore @IO @Char \store2 -> do- Context.runInBoundThread do+ Context.withEmptyStore @IO @Thing $ \store1 -> do+ Context.withEmptyStore @IO @Char $ \store2 -> do+ Context.runInBoundThread $ do Context.mineMay store1 `shouldReturn` Nothing Context.mineMay store2 `shouldReturn` Nothing Context.putMVar threadDone () Context.takeMVar threadDone- it "initially-empty stores with registered context" do+ it "initially-empty stores with registered context" $ do threadDone <- Context.newEmptyMVar- Context.withEmptyStore \store1 -> do- Context.use store1 Thing { stuff = 1 } do- Context.withEmptyStore \store2 -> do- Context.use store2 'a' do- Context.runInBoundThread do+ Context.withEmptyStore $ \store1 -> do+ Context.use store1 Thing { stuff = 1 } $ do+ Context.withEmptyStore $ \store2 -> do+ Context.use store2 'a' $ do+ Context.runInBoundThread $ do Context.mineMay store1 `shouldReturn` Just Thing { stuff = 1 } Context.mineMay store2 `shouldReturn` Just 'a' Context.putMVar threadDone () Context.takeMVar threadDone- it "initially-empty stores with nested contexts" do+ it "initially-empty stores with nested contexts" $ do threadDone <- Context.newEmptyMVar- Context.withEmptyStore \store1 -> do- Context.use store1 Thing { stuff = 1 } do- Context.use store1 Thing { stuff = 2 } do- Context.withEmptyStore \store2 -> do- Context.use store2 'a' do- Context.use store2 'b' do- Context.runInBoundThread do+ Context.withEmptyStore $ \store1 -> do+ Context.use store1 Thing { stuff = 1 } $ do+ Context.use store1 Thing { stuff = 2 } $ do+ Context.withEmptyStore $ \store2 -> do+ Context.use store2 'a' $ do+ Context.use store2 'b' $ do+ Context.runInBoundThread $ do Context.mineMay store1 `shouldReturn` Just Thing { stuff = 2 } Context.mineMay store2 `shouldReturn` Just 'b' Context.putMVar threadDone () Context.takeMVar threadDone- it "non-empty stores" do+ it "non-empty stores" $ do threadDone <- Context.newEmptyMVar- Context.withNonEmptyStore Thing { stuff = 1 } \store1 -> do- Context.withNonEmptyStore 'a' \store2 -> do- Context.runInBoundThread do+ Context.withNonEmptyStore Thing { stuff = 1 } $ \store1 -> do+ Context.withNonEmptyStore 'a' $ \store2 -> do+ Context.runInBoundThread $ do Context.mineMay store1 `shouldReturn` Just Thing { stuff = 1 } Context.mineMay store2 `shouldReturn` Just 'a' Context.putMVar threadDone () Context.takeMVar threadDone - describe "runInUnboundThread" do- describe "mineMay" do- it "empty stores" do+ describe "runInUnboundThread" $ do+ describe "mineMay" $ do+ it "empty stores" $ do threadDone <- Context.newEmptyMVar- Context.withEmptyStore @IO @Thing \store1 -> do- Context.withEmptyStore @IO @Char \store2 -> do- Context.runInUnboundThread do+ Context.withEmptyStore @IO @Thing $ \store1 -> do+ Context.withEmptyStore @IO @Char $ \store2 -> do+ Context.runInUnboundThread $ do Context.mineMay store1 `shouldReturn` Nothing Context.mineMay store2 `shouldReturn` Nothing Context.putMVar threadDone () Context.takeMVar threadDone- it "initially-empty stores with registered context" do+ it "initially-empty stores with registered context" $ do threadDone <- Context.newEmptyMVar- Context.withEmptyStore \store1 -> do- Context.use store1 Thing { stuff = 1 } do- Context.withEmptyStore \store2 -> do- Context.use store2 'a' do- Context.runInUnboundThread do+ Context.withEmptyStore $ \store1 -> do+ Context.use store1 Thing { stuff = 1 } $ do+ Context.withEmptyStore $ \store2 -> do+ Context.use store2 'a' $ do+ Context.runInUnboundThread $ do Context.mineMay store1 `shouldReturn` Just Thing { stuff = 1 } Context.mineMay store2 `shouldReturn` Just 'a' Context.putMVar threadDone () Context.takeMVar threadDone- it "initially-empty stores with nested contexts" do+ it "initially-empty stores with nested contexts" $ do threadDone <- Context.newEmptyMVar- Context.withEmptyStore \store1 -> do- Context.use store1 Thing { stuff = 1 } do- Context.use store1 Thing { stuff = 2 } do- Context.withEmptyStore \store2 -> do- Context.use store2 'a' do- Context.use store2 'b' do- Context.runInUnboundThread do+ Context.withEmptyStore $ \store1 -> do+ Context.use store1 Thing { stuff = 1 } $ do+ Context.use store1 Thing { stuff = 2 } $ do+ Context.withEmptyStore $ \store2 -> do+ Context.use store2 'a' $ do+ Context.use store2 'b' $ do+ Context.runInUnboundThread $ do Context.mineMay store1 `shouldReturn` Just Thing { stuff = 2 } Context.mineMay store2 `shouldReturn` Just 'b' Context.putMVar threadDone () Context.takeMVar threadDone- it "non-empty stores" do+ it "non-empty stores" $ do threadDone <- Context.newEmptyMVar- Context.withNonEmptyStore Thing { stuff = 1 } \store1 -> do- Context.withNonEmptyStore 'a' \store2 -> do- Context.runInUnboundThread do+ Context.withNonEmptyStore Thing { stuff = 1 } $ \store1 -> do+ Context.withNonEmptyStore 'a' $ \store2 -> do+ Context.runInUnboundThread $ do Context.mineMay store1 `shouldReturn` Just Thing { stuff = 1 } Context.mineMay store2 `shouldReturn` Just 'a' Context.putMVar threadDone ()
test-suite/Test/Context/ImplicitSpec.hs view
@@ -1,6 +1,5 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -{-# LANGUAGE BlockArguments #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleInstances #-}@@ -36,204 +35,204 @@ spec :: Spec spec = do- describe "emptyStore" do- describe "mineMay" do- it "empty" do+ describe "emptyStore" $ do+ describe "mineMay" $ do+ it "empty" $ do Context.mineMay `shouldReturn` Nothing- it "single context" do- Context.use Thing { stuff = 1 } do+ it "single context" $ do+ Context.use Thing { stuff = 1 } $ do Context.mineMay `shouldReturn` Just Thing { stuff = 1 } Context.mineMay `shouldReturn` Nothing- it "nested contexts" do- Context.use Thing { stuff = 1 } do+ it "nested contexts" $ do+ Context.use Thing { stuff = 1 } $ do Context.mineMay `shouldReturn` Just Thing { stuff = 1 }- Context.use Thing { stuff = 2 } do+ Context.use Thing { stuff = 2 } $ do Context.mineMay `shouldReturn` Just Thing { stuff = 2 }- Context.use Thing { stuff = 3 } do+ Context.use Thing { stuff = 3 } $ do Context.mineMay `shouldReturn` Just Thing { stuff = 3 } Context.mineMay `shouldReturn` Just Thing { stuff = 2 }- Context.use Thing { stuff = 4 } do+ Context.use Thing { stuff = 4 } $ do Context.mineMay `shouldReturn` Just Thing { stuff = 4 } Context.mineMay `shouldReturn` Just Thing { stuff = 1 } Context.mineMay `shouldReturn` Nothing- it "concurrent nested contexts" do+ it "concurrent nested contexts" $ do let mkContext i = Thing { stuff = i }- Async.forConcurrently_ [1 :: Int ..10] $ const do+ Async.forConcurrently_ [1 :: Int ..10] $ const $ do Context.mineMay `shouldReturn` Nothing- Context.use (mkContext 1) do+ Context.use (mkContext 1) $ do Context.mineMay `shouldReturn` Just (mkContext 1)- Context.use (mkContext 2) do+ Context.use (mkContext 2) $ do Context.mineMay `shouldReturn` Just (mkContext 2)- Context.use (mkContext 3) do+ Context.use (mkContext 3) $ do Context.mineMay `shouldReturn` Just (mkContext 3) Context.mineMay `shouldReturn` Just (mkContext 2)- Context.use (mkContext 4) do+ Context.use (mkContext 4) $ do Context.mineMay `shouldReturn` Just (mkContext 4) Context.mineMay `shouldReturn` Just (mkContext 1) Context.mineMay `shouldReturn` Nothing Context.mineMay `shouldReturn` Nothing - describe "minesMay" do- it "empty" do+ describe "minesMay" $ do+ it "empty" $ do Context.minesMay stuff `shouldReturn` Nothing- it "single context" do- Context.use Thing { stuff = 1 } do+ it "single context" $ do+ Context.use Thing { stuff = 1 } $ do Context.minesMay stuff `shouldReturn` Just 1 Context.minesMay stuff `shouldReturn` Nothing- it "nested contexts" do- Context.use Thing { stuff = 1 } do+ it "nested contexts" $ do+ Context.use Thing { stuff = 1 } $ do Context.minesMay stuff `shouldReturn` Just 1- Context.use Thing { stuff = 2 } do+ Context.use Thing { stuff = 2 } $ do Context.minesMay stuff `shouldReturn` Just 2- Context.use Thing { stuff = 3 } do+ Context.use Thing { stuff = 3 } $ do Context.minesMay stuff `shouldReturn` Just 3 Context.minesMay stuff `shouldReturn` Just 2- Context.use Thing { stuff = 4 } do+ Context.use Thing { stuff = 4 } $ do Context.minesMay stuff `shouldReturn` Just 4 Context.minesMay stuff `shouldReturn` Just 1 Context.minesMay stuff `shouldReturn` Nothing- it "concurrent nested contexts" do+ it "concurrent nested contexts" $ do let mkContext i = Thing { stuff = i }- Async.forConcurrently_ [1 :: Int ..10] $ const do+ Async.forConcurrently_ [1 :: Int ..10] $ const $ do Context.minesMay stuff `shouldReturn` Nothing- Context.use (mkContext 1) do+ Context.use (mkContext 1) $ do Context.minesMay stuff `shouldReturn` Just 1- Context.use (mkContext 2) do+ Context.use (mkContext 2) $ do Context.minesMay stuff `shouldReturn` Just 2- Context.use (mkContext 3) do+ Context.use (mkContext 3) $ do Context.minesMay stuff `shouldReturn` Just 3 Context.minesMay stuff `shouldReturn` Just 2- Context.use (mkContext 4) do+ Context.use (mkContext 4) $ do Context.minesMay stuff `shouldReturn` Just 4 Context.minesMay stuff `shouldReturn` Just 1 Context.minesMay stuff `shouldReturn` Nothing Context.minesMay stuff `shouldReturn` Nothing - describe "mine" do- it "empty" do+ describe "mine" $ do+ it "empty" $ do threadId <- Concurrent.myThreadId Context.mine `shouldThrow` notFound threadId- it "single context" do+ it "single context" $ do threadId <- Concurrent.myThreadId- Context.use Thing { stuff = 1 } do+ Context.use Thing { stuff = 1 } $ do Context.mine `shouldReturn` Thing { stuff = 1 } Context.mine `shouldThrow` notFound threadId- it "nested contexts" do+ it "nested contexts" $ do threadId <- Concurrent.myThreadId- Context.use Thing { stuff = 1 } do+ Context.use Thing { stuff = 1 } $ do Context.mine `shouldReturn` Thing { stuff = 1 }- Context.use Thing { stuff = 2 } do+ Context.use Thing { stuff = 2 } $ do Context.mine `shouldReturn` Thing { stuff = 2 }- Context.use Thing { stuff = 3 } do+ Context.use Thing { stuff = 3 } $ do Context.mine `shouldReturn` Thing { stuff = 3 } Context.mine `shouldReturn` Thing { stuff = 2 }- Context.use Thing { stuff = 4 } do+ Context.use Thing { stuff = 4 } $ do Context.mine `shouldReturn` Thing { stuff = 4 } Context.mine `shouldReturn` Thing { stuff = 1 } Context.mine `shouldThrow` notFound threadId- it "concurrent nested contexts" do+ it "concurrent nested contexts" $ do let mkContext i = Thing { stuff = i } initThreadId <- Concurrent.myThreadId- Async.forConcurrently_ [1 :: Int ..10] $ const do+ Async.forConcurrently_ [1 :: Int ..10] $ const $ do threadId <- Concurrent.myThreadId Context.mine `shouldThrow` notFound threadId- Context.use (mkContext 1) do+ Context.use (mkContext 1) $ do Context.mine `shouldReturn` mkContext 1- Context.use (mkContext 2) do+ Context.use (mkContext 2) $ do Context.mine `shouldReturn` mkContext 2- Context.use (mkContext 3) do+ Context.use (mkContext 3) $ do Context.mine `shouldReturn` mkContext 3 Context.mine `shouldReturn` mkContext 2- Context.use (mkContext 4) do+ Context.use (mkContext 4) $ do Context.mine `shouldReturn` mkContext 4 Context.mine `shouldReturn` mkContext 1 Context.mine `shouldThrow` notFound threadId Context.mine `shouldThrow` notFound initThreadId - describe "mines" do- it "empty" do+ describe "mines" $ do+ it "empty" $ do threadId <- Concurrent.myThreadId Context.mines stuff `shouldThrow` notFound threadId- it "single context" do+ it "single context" $ do threadId <- Concurrent.myThreadId- Context.use Thing { stuff = 1 } do+ Context.use Thing { stuff = 1 } $ do Context.mines stuff `shouldReturn` 1 Context.mines stuff `shouldThrow` notFound threadId- it "nested contexts" do+ it "nested contexts" $ do threadId <- Concurrent.myThreadId- Context.use Thing { stuff = 1 } do+ Context.use Thing { stuff = 1 } $ do Context.mines stuff `shouldReturn` 1- Context.use Thing { stuff = 2 } do+ Context.use Thing { stuff = 2 } $ do Context.mines stuff `shouldReturn` 2- Context.use Thing { stuff = 3 } do+ Context.use Thing { stuff = 3 } $ do Context.mines stuff `shouldReturn` 3 Context.mines stuff `shouldReturn` 2- Context.use Thing { stuff = 4 } do+ Context.use Thing { stuff = 4 } $ do Context.mines stuff `shouldReturn` 4 Context.mines stuff `shouldReturn` 1 Context.mines stuff `shouldThrow` notFound threadId- it "concurrent nested contexts" do+ it "concurrent nested contexts" $ do let mkContext i = Thing { stuff = i } initThreadId <- Concurrent.myThreadId- Async.forConcurrently_ [1 :: Int ..10] $ const do+ Async.forConcurrently_ [1 :: Int ..10] $ const $ do threadId <- Concurrent.myThreadId Context.mine `shouldThrow` notFound threadId- Context.use (mkContext 1) do+ Context.use (mkContext 1) $ do Context.mines stuff `shouldReturn` 1- Context.use (mkContext 2) do+ Context.use (mkContext 2) $ do Context.mines stuff `shouldReturn` 2- Context.use (mkContext 3) do+ Context.use (mkContext 3) $ do Context.mines stuff `shouldReturn` 3 Context.mines stuff `shouldReturn` 2- Context.use (mkContext 4) do+ Context.use (mkContext 4) $ do Context.mines stuff `shouldReturn` 4 Context.mines stuff `shouldReturn` 1 Context.mines stuff `shouldThrow` notFound threadId Context.mines stuff `shouldThrow` notFound initThreadId - describe "adjust" do- it "empty" do+ describe "adjust" $ do+ it "empty" $ do threadId <- Concurrent.myThreadId Context.adjust modifier (error "does not get here") `shouldThrow` notFound threadId- it "single context" do+ it "single context" $ do threadId <- Concurrent.myThreadId- Context.use Thing { stuff = 1 } do+ Context.use Thing { stuff = 1 } $ do Context.mine `shouldReturn` Thing { stuff = 1 }- Context.adjust modifier do+ Context.adjust modifier $ do Context.mine `shouldReturn` Thing { stuff = 2 } Context.mine `shouldReturn` Thing { stuff = 1 } Context.mine `shouldThrow` notFound threadId- it "nested contexts" do+ it "nested contexts" $ do threadId <- Concurrent.myThreadId- Context.use Thing { stuff = 1 } do- Context.adjust modifier do+ Context.use Thing { stuff = 1 } $ do+ Context.adjust modifier $ do Context.mine `shouldReturn` Thing { stuff = 2 }- Context.use Thing { stuff = 3 } do+ Context.use Thing { stuff = 3 } $ do Context.mine `shouldReturn` Thing { stuff = 3 }- Context.use Thing { stuff = 4 } do+ Context.use Thing { stuff = 4 } $ do Context.mine `shouldReturn` Thing { stuff = 4 } Context.mine `shouldReturn` Thing { stuff = 3 }- Context.use Thing { stuff = 4 } do+ Context.use Thing { stuff = 4 } $ do Context.mine `shouldReturn` Thing { stuff = 4 } Context.mine `shouldReturn` Thing { stuff = 2 } Context.mine `shouldReturn` Thing { stuff = 1 } Context.mine `shouldThrow` notFound threadId- it "concurrent nested contexts" do+ it "concurrent nested contexts" $ do let mkContext i = Thing { stuff = i } initThreadId <- Concurrent.myThreadId- Async.forConcurrently_ [1 :: Int ..10] $ const do+ Async.forConcurrently_ [1 :: Int ..10] $ const $ do threadId <- Concurrent.myThreadId Context.mine `shouldThrow` notFound threadId- Context.use (mkContext 1) do- Context.adjust modifier do+ Context.use (mkContext 1) $ do+ Context.adjust modifier $ do Context.mine `shouldReturn` mkContext 2- Context.use (mkContext 3) do+ Context.use (mkContext 3) $ do Context.mine `shouldReturn` mkContext 3- Context.use (mkContext 4) do+ Context.use (mkContext 4) $ do Context.mine `shouldReturn` mkContext 4 Context.mine `shouldReturn` mkContext 3- Context.use (mkContext 5) do+ Context.use (mkContext 5) $ do Context.mine `shouldReturn` mkContext 5 Context.mine `shouldReturn` mkContext 2 Context.mine `shouldReturn` mkContext 1
test-suite/Test/ContextSpec.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE BlockArguments #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NoImplicitPrelude #-}@@ -25,544 +24,544 @@ spec :: Spec spec = do- describe "withEmptyStore" do- describe "mineMay" do- it "empty" do- Context.withEmptyStore @IO @Thing \store -> do+ describe "withEmptyStore" $ do+ describe "mineMay" $ do+ it "empty" $ do+ Context.withEmptyStore @IO @Thing $ \store -> do Context.mineMay store `shouldReturn` Nothing- it "single context" do- Context.withEmptyStore @IO @Thing \store -> do- Context.use store Thing { stuff = 1 } do+ it "single context" $ do+ Context.withEmptyStore @IO @Thing $ \store -> do+ Context.use store Thing { stuff = 1 } $ do Context.mineMay store `shouldReturn` Just Thing { stuff = 1 } Context.mineMay store `shouldReturn` Nothing- it "nested contexts" do- Context.withEmptyStore @IO @Thing \store -> do- Context.use store Thing { stuff = 1 } do+ it "nested contexts" $ do+ Context.withEmptyStore @IO @Thing $ \store -> do+ Context.use store Thing { stuff = 1 } $ do Context.mineMay store `shouldReturn` Just Thing { stuff = 1 }- Context.use store Thing { stuff = 2 } do+ Context.use store Thing { stuff = 2 } $ do Context.mineMay store `shouldReturn` Just Thing { stuff = 2 }- Context.use store Thing { stuff = 3 } do+ Context.use store Thing { stuff = 3 } $ do Context.mineMay store `shouldReturn` Just Thing { stuff = 3 } Context.mineMay store `shouldReturn` Just Thing { stuff = 2 }- Context.use store Thing { stuff = 4 } do+ Context.use store Thing { stuff = 4 } $ do Context.mineMay store `shouldReturn` Just Thing { stuff = 4 } Context.mineMay store `shouldReturn` Just Thing { stuff = 1 } Context.mineMay store `shouldReturn` Nothing- it "concurrent nested contexts" do+ it "concurrent nested contexts" $ do let mkContext i = Thing { stuff = i }- Context.withEmptyStore @IO @Thing \store -> do- Async.forConcurrently_ [1 :: Int ..10] $ const do+ Context.withEmptyStore @IO @Thing $ \store -> do+ Async.forConcurrently_ [1 :: Int ..10] $ const $ do Context.mineMay store `shouldReturn` Nothing- Context.use store (mkContext 1) do+ Context.use store (mkContext 1) $ do Context.mineMay store `shouldReturn` Just (mkContext 1)- Context.use store (mkContext 2) do+ Context.use store (mkContext 2) $ do Context.mineMay store `shouldReturn` Just (mkContext 2)- Context.use store (mkContext 3) do+ Context.use store (mkContext 3) $ do Context.mineMay store `shouldReturn` Just (mkContext 3) Context.mineMay store `shouldReturn` Just (mkContext 2)- Context.use store (mkContext 4) do+ Context.use store (mkContext 4) $ do Context.mineMay store `shouldReturn` Just (mkContext 4) Context.mineMay store `shouldReturn` Just (mkContext 1) Context.mineMay store `shouldReturn` Nothing Context.mineMay store `shouldReturn` Nothing - describe "minesMay" do- it "empty" do- Context.withEmptyStore @IO @Thing \store -> do+ describe "minesMay" $ do+ it "empty" $ do+ Context.withEmptyStore @IO @Thing $ \store -> do Context.minesMay store stuff `shouldReturn` Nothing- it "single context" do- Context.withEmptyStore @IO @Thing \store -> do- Context.use store Thing { stuff = 1 } do+ it "single context" $ do+ Context.withEmptyStore @IO @Thing $ \store -> do+ Context.use store Thing { stuff = 1 } $ do Context.minesMay store stuff `shouldReturn` Just 1 Context.minesMay store stuff `shouldReturn` Nothing- it "nested contexts" do- Context.withEmptyStore @IO @Thing \store -> do- Context.use store Thing { stuff = 1 } do+ it "nested contexts" $ do+ Context.withEmptyStore @IO @Thing $ \store -> do+ Context.use store Thing { stuff = 1 } $ do Context.minesMay store stuff `shouldReturn` Just 1- Context.use store Thing { stuff = 2 } do+ Context.use store Thing { stuff = 2 } $ do Context.minesMay store stuff `shouldReturn` Just 2- Context.use store Thing { stuff = 3 } do+ Context.use store Thing { stuff = 3 } $ do Context.minesMay store stuff `shouldReturn` Just 3 Context.minesMay store stuff `shouldReturn` Just 2- Context.use store Thing { stuff = 4 } do+ Context.use store Thing { stuff = 4 } $ do Context.minesMay store stuff `shouldReturn` Just 4 Context.minesMay store stuff `shouldReturn` Just 1 Context.minesMay store stuff `shouldReturn` Nothing- it "concurrent nested contexts" do+ it "concurrent nested contexts" $ do let mkContext i = Thing { stuff = i }- Context.withEmptyStore @IO @Thing \store -> do- Async.forConcurrently_ [1 :: Int ..10] $ const do+ Context.withEmptyStore @IO @Thing $ \store -> do+ Async.forConcurrently_ [1 :: Int ..10] $ const $ do Context.minesMay store stuff `shouldReturn` Nothing- Context.use store (mkContext 1) do+ Context.use store (mkContext 1) $ do Context.minesMay store stuff `shouldReturn` Just 1- Context.use store (mkContext 2) do+ Context.use store (mkContext 2) $ do Context.minesMay store stuff `shouldReturn` Just 2- Context.use store (mkContext 3) do+ Context.use store (mkContext 3) $ do Context.minesMay store stuff `shouldReturn` Just 3 Context.minesMay store stuff `shouldReturn` Just 2- Context.use store (mkContext 4) do+ Context.use store (mkContext 4) $ do Context.minesMay store stuff `shouldReturn` Just 4 Context.minesMay store stuff `shouldReturn` Just 1 Context.minesMay store stuff `shouldReturn` Nothing Context.minesMay store stuff `shouldReturn` Nothing - describe "mine" do- it "empty" do- Context.withEmptyStore @IO @Thing \store -> do+ describe "mine" $ do+ it "empty" $ do+ Context.withEmptyStore @IO @Thing $ \store -> do threadId <- Concurrent.myThreadId Context.mine store `shouldThrow` notFound threadId- it "single context" do- Context.withEmptyStore @IO @Thing \store -> do+ it "single context" $ do+ Context.withEmptyStore @IO @Thing $ \store -> do threadId <- Concurrent.myThreadId- Context.use store Thing { stuff = 1 } do+ Context.use store Thing { stuff = 1 } $ do Context.mine store `shouldReturn` Thing { stuff = 1 } Context.mine store `shouldThrow` notFound threadId- it "nested contexts" do- Context.withEmptyStore @IO @Thing \store -> do+ it "nested contexts" $ do+ Context.withEmptyStore @IO @Thing $ \store -> do threadId <- Concurrent.myThreadId- Context.use store Thing { stuff = 1 } do+ Context.use store Thing { stuff = 1 } $ do Context.mine store `shouldReturn` Thing { stuff = 1 }- Context.use store Thing { stuff = 2 } do+ Context.use store Thing { stuff = 2 } $ do Context.mine store `shouldReturn` Thing { stuff = 2 }- Context.use store Thing { stuff = 3 } do+ Context.use store Thing { stuff = 3 } $ do Context.mine store `shouldReturn` Thing { stuff = 3 } Context.mine store `shouldReturn` Thing { stuff = 2 }- Context.use store Thing { stuff = 4 } do+ Context.use store Thing { stuff = 4 } $ do Context.mine store `shouldReturn` Thing { stuff = 4 } Context.mine store `shouldReturn` Thing { stuff = 1 } Context.mine store `shouldThrow` notFound threadId- it "concurrent nested contexts" do+ it "concurrent nested contexts" $ do let mkContext i = Thing { stuff = i } initThreadId <- Concurrent.myThreadId- Context.withEmptyStore @IO @Thing \store -> do- Async.forConcurrently_ [1 :: Int ..10] $ const do+ Context.withEmptyStore @IO @Thing $ \store -> do+ Async.forConcurrently_ [1 :: Int ..10] $ const $ do threadId <- Concurrent.myThreadId Context.mine store `shouldThrow` notFound threadId- Context.use store (mkContext 1) do+ Context.use store (mkContext 1) $ do Context.mine store `shouldReturn` mkContext 1- Context.use store (mkContext 2) do+ Context.use store (mkContext 2) $ do Context.mine store `shouldReturn` mkContext 2- Context.use store (mkContext 3) do+ Context.use store (mkContext 3) $ do Context.mine store `shouldReturn` mkContext 3 Context.mine store `shouldReturn` mkContext 2- Context.use store (mkContext 4) do+ Context.use store (mkContext 4) $ do Context.mine store `shouldReturn` mkContext 4 Context.mine store `shouldReturn` mkContext 1 Context.mine store `shouldThrow` notFound threadId Context.mine store `shouldThrow` notFound initThreadId - describe "mines" do- it "empty" do- Context.withEmptyStore @IO @Thing \store -> do+ describe "mines" $ do+ it "empty" $ do+ Context.withEmptyStore @IO @Thing $ \store -> do threadId <- Concurrent.myThreadId Context.mines store stuff `shouldThrow` notFound threadId- it "single context" do- Context.withEmptyStore @IO @Thing \store -> do+ it "single context" $ do+ Context.withEmptyStore @IO @Thing $ \store -> do threadId <- Concurrent.myThreadId- Context.use store Thing { stuff = 1 } do+ Context.use store Thing { stuff = 1 } $ do Context.mines store stuff `shouldReturn` 1 Context.mines store stuff `shouldThrow` notFound threadId- it "nested contexts" do- Context.withEmptyStore @IO @Thing \store -> do+ it "nested contexts" $ do+ Context.withEmptyStore @IO @Thing $ \store -> do threadId <- Concurrent.myThreadId- Context.use store Thing { stuff = 1 } do+ Context.use store Thing { stuff = 1 } $ do Context.mines store stuff `shouldReturn` 1- Context.use store Thing { stuff = 2 } do+ Context.use store Thing { stuff = 2 } $ do Context.mines store stuff `shouldReturn` 2- Context.use store Thing { stuff = 3 } do+ Context.use store Thing { stuff = 3 } $ do Context.mines store stuff `shouldReturn` 3 Context.mines store stuff `shouldReturn` 2- Context.use store Thing { stuff = 4 } do+ Context.use store Thing { stuff = 4 } $ do Context.mines store stuff `shouldReturn` 4 Context.mines store stuff `shouldReturn` 1 Context.mines store stuff `shouldThrow` notFound threadId- it "concurrent nested contexts" do+ it "concurrent nested contexts" $ do let mkContext i = Thing { stuff = i } initThreadId <- Concurrent.myThreadId- Context.withEmptyStore @IO @Thing \store -> do- Async.forConcurrently_ [1 :: Int ..10] $ const do+ Context.withEmptyStore @IO @Thing $ \store -> do+ Async.forConcurrently_ [1 :: Int ..10] $ const $ do threadId <- Concurrent.myThreadId Context.mine store `shouldThrow` notFound threadId- Context.use store (mkContext 1) do+ Context.use store (mkContext 1) $ do Context.mines store stuff `shouldReturn` 1- Context.use store (mkContext 2) do+ Context.use store (mkContext 2) $ do Context.mines store stuff `shouldReturn` 2- Context.use store (mkContext 3) do+ Context.use store (mkContext 3) $ do Context.mines store stuff `shouldReturn` 3 Context.mines store stuff `shouldReturn` 2- Context.use store (mkContext 4) do+ Context.use store (mkContext 4) $ do Context.mines store stuff `shouldReturn` 4 Context.mines store stuff `shouldReturn` 1 Context.mines store stuff `shouldThrow` notFound threadId Context.mines store stuff `shouldThrow` notFound initThreadId - describe "adjust" do- it "empty" do- Context.withEmptyStore @IO @Thing \store -> do+ describe "adjust" $ do+ it "empty" $ do+ Context.withEmptyStore @IO @Thing $ \store -> do threadId <- Concurrent.myThreadId Context.adjust store modifier (error "does not get here") `shouldThrow` notFound threadId- it "single context" do- Context.withEmptyStore @IO @Thing \store -> do+ it "single context" $ do+ Context.withEmptyStore @IO @Thing $ \store -> do threadId <- Concurrent.myThreadId- Context.use store Thing { stuff = 1 } do+ Context.use store Thing { stuff = 1 } $ do Context.mine store `shouldReturn` Thing { stuff = 1 }- Context.adjust store modifier do+ Context.adjust store modifier $ do Context.mine store `shouldReturn` Thing { stuff = 2 } Context.mine store `shouldReturn` Thing { stuff = 1 } Context.mine store `shouldThrow` notFound threadId- it "nested contexts" do- Context.withEmptyStore @IO @Thing \store -> do+ it "nested contexts" $ do+ Context.withEmptyStore @IO @Thing $ \store -> do threadId <- Concurrent.myThreadId- Context.use store Thing { stuff = 1 } do- Context.adjust store modifier do+ Context.use store Thing { stuff = 1 } $ do+ Context.adjust store modifier $ do Context.mine store `shouldReturn` Thing { stuff = 2 }- Context.use store Thing { stuff = 3 } do+ Context.use store Thing { stuff = 3 } $ do Context.mine store `shouldReturn` Thing { stuff = 3 }- Context.use store Thing { stuff = 4 } do+ Context.use store Thing { stuff = 4 } $ do Context.mine store `shouldReturn` Thing { stuff = 4 } Context.mine store `shouldReturn` Thing { stuff = 3 }- Context.use store Thing { stuff = 4 } do+ Context.use store Thing { stuff = 4 } $ do Context.mine store `shouldReturn` Thing { stuff = 4 } Context.mine store `shouldReturn` Thing { stuff = 2 } Context.mine store `shouldReturn` Thing { stuff = 1 } Context.mine store `shouldThrow` notFound threadId- it "concurrent nested contexts" do+ it "concurrent nested contexts" $ do let mkContext i = Thing { stuff = i } initThreadId <- Concurrent.myThreadId- Context.withEmptyStore @IO @Thing \store -> do- Async.forConcurrently_ [1 :: Int ..10] $ const do+ Context.withEmptyStore @IO @Thing $ \store -> do+ Async.forConcurrently_ [1 :: Int ..10] $ const $ do threadId <- Concurrent.myThreadId Context.mine store `shouldThrow` notFound threadId- Context.use store (mkContext 1) do- Context.adjust store modifier do+ Context.use store (mkContext 1) $ do+ Context.adjust store modifier $ do Context.mine store `shouldReturn` mkContext 2- Context.use store (mkContext 3) do+ Context.use store (mkContext 3) $ do Context.mine store `shouldReturn` mkContext 3- Context.use store (mkContext 4) do+ Context.use store (mkContext 4) $ do Context.mine store `shouldReturn` mkContext 4 Context.mine store `shouldReturn` mkContext 3- Context.use store (mkContext 5) do+ Context.use store (mkContext 5) $ do Context.mine store `shouldReturn` mkContext 5 Context.mine store `shouldReturn` mkContext 2 Context.mine store `shouldReturn` mkContext 1 Context.mine store `shouldThrow` notFound threadId Context.mine store `shouldThrow` notFound initThreadId - describe "setDefault" do- it "setting default converts store to non-empty" do- Context.withEmptyStore @IO @Thing \store -> do+ describe "setDefault" $ do+ it "setting default converts store to non-empty" $ do+ Context.withEmptyStore @IO @Thing $ \store -> do Context.mineMay store `shouldReturn` Nothing Context.setDefault store Thing { stuff = 1 } Context.mineMay store `shouldReturn` Just Thing { stuff = 1 } Context.setDefault store Thing { stuff = 2 } Context.mineMay store `shouldReturn` Just Thing { stuff = 2 } - describe "withNonEmptyStore" do- describe "mineMay" do- it "default" do- Context.withNonEmptyStore Thing { stuff = 0 } \store -> do+ describe "withNonEmptyStore" $ do+ describe "mineMay" $ do+ it "default" $ do+ Context.withNonEmptyStore Thing { stuff = 0 } $ \store -> do Context.mineMay store `shouldReturn` Just Thing { stuff = 0 }- it "single context" do- Context.withNonEmptyStore Thing { stuff = 0 } \store -> do- Context.use store Thing { stuff = 1 } do+ it "single context" $ do+ Context.withNonEmptyStore Thing { stuff = 0 } $ \store -> do+ Context.use store Thing { stuff = 1 } $ do Context.mineMay store `shouldReturn` Just Thing { stuff = 1 } Context.mineMay store `shouldReturn` Just Thing { stuff = 0 }- it "nested contexts" do- Context.withNonEmptyStore Thing { stuff = 0 } \store -> do- Context.use store Thing { stuff = 1 } do+ it "nested contexts" $ do+ Context.withNonEmptyStore Thing { stuff = 0 } $ \store -> do+ Context.use store Thing { stuff = 1 } $ do Context.mineMay store `shouldReturn` Just Thing { stuff = 1 }- Context.use store Thing { stuff = 2 } do+ Context.use store Thing { stuff = 2 } $ do Context.mineMay store `shouldReturn` Just Thing { stuff = 2 }- Context.use store Thing { stuff = 3 } do+ Context.use store Thing { stuff = 3 } $ do Context.mineMay store `shouldReturn` Just Thing { stuff = 3 } Context.mineMay store `shouldReturn` Just Thing { stuff = 2 }- Context.use store Thing { stuff = 4 } do+ Context.use store Thing { stuff = 4 } $ do Context.mineMay store `shouldReturn` Just Thing { stuff = 4 } Context.mineMay store `shouldReturn` Just Thing { stuff = 1 } Context.mineMay store `shouldReturn` Just Thing { stuff = 0 }- it "concurrent nested contexts" do+ it "concurrent nested contexts" $ do let mkContext i = Thing { stuff = i }- Context.withNonEmptyStore (mkContext 0) \store -> do- Async.forConcurrently_ [1 :: Int ..10] $ const do+ Context.withNonEmptyStore (mkContext 0) $ \store -> do+ Async.forConcurrently_ [1 :: Int ..10] $ const $ do Context.mineMay store `shouldReturn` Just (mkContext 0)- Context.use store (mkContext 1) do+ Context.use store (mkContext 1) $ do Context.mineMay store `shouldReturn` Just (mkContext 1)- Context.use store (mkContext 2) do+ Context.use store (mkContext 2) $ do Context.mineMay store `shouldReturn` Just (mkContext 2)- Context.use store (mkContext 3) do+ Context.use store (mkContext 3) $ do Context.mineMay store `shouldReturn` Just (mkContext 3) Context.mineMay store `shouldReturn` Just (mkContext 2)- Context.use store (mkContext 4) do+ Context.use store (mkContext 4) $ do Context.mineMay store `shouldReturn` Just (mkContext 4) Context.mineMay store `shouldReturn` Just (mkContext 1) Context.mineMay store `shouldReturn` Just (mkContext 0) Context.mineMay store `shouldReturn` Just (mkContext 0) - describe "minesMay" do- it "default" do- Context.withNonEmptyStore Thing { stuff = 0 } \store -> do+ describe "minesMay" $ do+ it "default" $ do+ Context.withNonEmptyStore Thing { stuff = 0 } $ \store -> do Context.minesMay store stuff `shouldReturn` Just 0- it "single context" do- Context.withNonEmptyStore Thing { stuff = 0 } \store -> do- Context.use store Thing { stuff = 1 } do+ it "single context" $ do+ Context.withNonEmptyStore Thing { stuff = 0 } $ \store -> do+ Context.use store Thing { stuff = 1 } $ do Context.minesMay store stuff `shouldReturn` Just 1 Context.minesMay store stuff `shouldReturn` Just 0- it "nested contexts" do- Context.withNonEmptyStore Thing { stuff = 0 } \store -> do- Context.use store Thing { stuff = 1 } do+ it "nested contexts" $ do+ Context.withNonEmptyStore Thing { stuff = 0 } $ \store -> do+ Context.use store Thing { stuff = 1 } $ do Context.minesMay store stuff `shouldReturn` Just 1- Context.use store Thing { stuff = 2 } do+ Context.use store Thing { stuff = 2 } $ do Context.minesMay store stuff `shouldReturn` Just 2- Context.use store Thing { stuff = 3 } do+ Context.use store Thing { stuff = 3 } $ do Context.minesMay store stuff `shouldReturn` Just 3 Context.minesMay store stuff `shouldReturn` Just 2- Context.use store Thing { stuff = 4 } do+ Context.use store Thing { stuff = 4 } $ do Context.minesMay store stuff `shouldReturn` Just 4 Context.minesMay store stuff `shouldReturn` Just 1 Context.minesMay store stuff `shouldReturn` Just 0- it "concurrent nested contexts" do+ it "concurrent nested contexts" $ do let mkContext i = Thing { stuff = i }- Context.withNonEmptyStore (mkContext 0) \store -> do- Async.forConcurrently_ [1 :: Int ..10] $ const do+ Context.withNonEmptyStore (mkContext 0) $ \store -> do+ Async.forConcurrently_ [1 :: Int ..10] $ const $ do Context.minesMay store stuff `shouldReturn` Just 0- Context.use store (mkContext 1) do+ Context.use store (mkContext 1) $ do Context.minesMay store stuff `shouldReturn` Just 1- Context.use store (mkContext 2) do+ Context.use store (mkContext 2) $ do Context.minesMay store stuff `shouldReturn` Just 2- Context.use store (mkContext 3) do+ Context.use store (mkContext 3) $ do Context.minesMay store stuff `shouldReturn` Just 3 Context.minesMay store stuff `shouldReturn` Just 2- Context.use store (mkContext 4) do+ Context.use store (mkContext 4) $ do Context.minesMay store stuff `shouldReturn` Just 4 Context.minesMay store stuff `shouldReturn` Just 1 Context.minesMay store stuff `shouldReturn` Just 0 Context.minesMay store stuff `shouldReturn` Just 0 - describe "mine" do- it "default" do- Context.withNonEmptyStore Thing { stuff = 0 } \store -> do+ describe "mine" $ do+ it "default" $ do+ Context.withNonEmptyStore Thing { stuff = 0 } $ \store -> do Context.mine store `shouldReturn` Thing { stuff = 0 }- it "single context" do- Context.withNonEmptyStore Thing { stuff = 0 } \store -> do- Context.use store Thing { stuff = 1 } do+ it "single context" $ do+ Context.withNonEmptyStore Thing { stuff = 0 } $ \store -> do+ Context.use store Thing { stuff = 1 } $ do Context.mine store `shouldReturn` Thing { stuff = 1 } Context.mine store `shouldReturn` Thing { stuff = 0 }- it "nested contexts" do- Context.withNonEmptyStore Thing { stuff = 0 } \store -> do- Context.use store Thing { stuff = 1 } do+ it "nested contexts" $ do+ Context.withNonEmptyStore Thing { stuff = 0 } $ \store -> do+ Context.use store Thing { stuff = 1 } $ do Context.mine store `shouldReturn` Thing { stuff = 1 }- Context.use store Thing { stuff = 2 } do+ Context.use store Thing { stuff = 2 } $ do Context.mine store `shouldReturn` Thing { stuff = 2 }- Context.use store Thing { stuff = 3 } do+ Context.use store Thing { stuff = 3 } $ do Context.mine store `shouldReturn` Thing { stuff = 3 } Context.mine store `shouldReturn` Thing { stuff = 2 }- Context.use store Thing { stuff = 4 } do+ Context.use store Thing { stuff = 4 } $ do Context.mine store `shouldReturn` Thing { stuff = 4 } Context.mine store `shouldReturn` Thing { stuff = 1 } Context.mine store `shouldReturn` Thing { stuff = 0 }- it "concurrent nested contexts" do+ it "concurrent nested contexts" $ do let mkContext i = Thing { stuff = i }- Context.withNonEmptyStore (mkContext 0) \store -> do- Async.forConcurrently_ [1 :: Int ..10] $ const do+ Context.withNonEmptyStore (mkContext 0) $ \store -> do+ Async.forConcurrently_ [1 :: Int ..10] $ const $ do Context.mine store `shouldReturn` mkContext 0- Context.use store (mkContext 1) do+ Context.use store (mkContext 1) $ do Context.mine store `shouldReturn` mkContext 1- Context.use store (mkContext 2) do+ Context.use store (mkContext 2) $ do Context.mine store `shouldReturn` mkContext 2- Context.use store (mkContext 3) do+ Context.use store (mkContext 3) $ do Context.mine store `shouldReturn` mkContext 3 Context.mine store `shouldReturn` mkContext 2- Context.use store (mkContext 4) do+ Context.use store (mkContext 4) $ do Context.mine store `shouldReturn` mkContext 4 Context.mine store `shouldReturn` mkContext 1 Context.mine store `shouldReturn` mkContext 0 Context.mine store `shouldReturn` mkContext 0 - describe "mines" do- it "default" do- Context.withNonEmptyStore Thing { stuff = 0 } \store -> do+ describe "mines" $ do+ it "default" $ do+ Context.withNonEmptyStore Thing { stuff = 0 } $ \store -> do Context.mines store stuff `shouldReturn` 0- it "single context" do- Context.withNonEmptyStore Thing { stuff = 0 } \store -> do- Context.use store Thing { stuff = 1 } do+ it "single context" $ do+ Context.withNonEmptyStore Thing { stuff = 0 } $ \store -> do+ Context.use store Thing { stuff = 1 } $ do Context.mines store stuff `shouldReturn` 1 Context.mines store stuff `shouldReturn` 0- it "nested contexts" do- Context.withNonEmptyStore Thing { stuff = 0 } \store -> do- Context.use store Thing { stuff = 1 } do+ it "nested contexts" $ do+ Context.withNonEmptyStore Thing { stuff = 0 } $ \store -> do+ Context.use store Thing { stuff = 1 } $ do Context.mines store stuff `shouldReturn` 1- Context.use store Thing { stuff = 2 } do+ Context.use store Thing { stuff = 2 } $ do Context.mines store stuff `shouldReturn` 2- Context.use store Thing { stuff = 3 } do+ Context.use store Thing { stuff = 3 } $ do Context.mines store stuff `shouldReturn` 3 Context.mines store stuff `shouldReturn` 2- Context.use store Thing { stuff = 4 } do+ Context.use store Thing { stuff = 4 } $ do Context.mines store stuff `shouldReturn` 4 Context.mines store stuff `shouldReturn` 1 Context.mines store stuff `shouldReturn` 0- it "concurrent nested contexts" do+ it "concurrent nested contexts" $ do let mkContext i = Thing { stuff = i }- Context.withNonEmptyStore (mkContext 0) \store -> do- Async.forConcurrently_ [1 :: Int ..10] $ const do+ Context.withNonEmptyStore (mkContext 0) $ \store -> do+ Async.forConcurrently_ [1 :: Int ..10] $ const $ do Context.mines store stuff `shouldReturn` 0- Context.use store (mkContext 1) do+ Context.use store (mkContext 1) $ do Context.mines store stuff `shouldReturn` 1- Context.use store (mkContext 2) do+ Context.use store (mkContext 2) $ do Context.mines store stuff `shouldReturn` 2- Context.use store (mkContext 3) do+ Context.use store (mkContext 3) $ do Context.mines store stuff `shouldReturn` 3 Context.mines store stuff `shouldReturn` 2- Context.use store (mkContext 4) do+ Context.use store (mkContext 4) $ do Context.mines store stuff `shouldReturn` 4 Context.mines store stuff `shouldReturn` 1 Context.mines store stuff `shouldReturn` 0 Context.mines store stuff `shouldReturn` 0 - describe "adjust" do- it "default" do- Context.withNonEmptyStore Thing { stuff = 1 } \store -> do- Context.adjust store modifier do+ describe "adjust" $ do+ it "default" $ do+ Context.withNonEmptyStore Thing { stuff = 1 } $ \store -> do+ Context.adjust store modifier $ do Context.mine store `shouldReturn` Thing { stuff = 2 } Context.mine store `shouldReturn` Thing { stuff = 1 }- it "single context" do- Context.withNonEmptyStore Thing { stuff = 0 } \store -> do- Context.use store Thing { stuff = 1 } do+ it "single context" $ do+ Context.withNonEmptyStore Thing { stuff = 0 } $ \store -> do+ Context.use store Thing { stuff = 1 } $ do Context.mine store `shouldReturn` Thing { stuff = 1 }- Context.adjust store modifier do+ Context.adjust store modifier $ do Context.mine store `shouldReturn` Thing { stuff = 2 } Context.mine store `shouldReturn` Thing { stuff = 1 } Context.mine store `shouldReturn` Thing { stuff = 0 }- it "nested contexts" do- Context.withNonEmptyStore Thing { stuff = 0 } \store -> do- Context.use store Thing { stuff = 1 } do- Context.adjust store modifier do+ it "nested contexts" $ do+ Context.withNonEmptyStore Thing { stuff = 0 } $ \store -> do+ Context.use store Thing { stuff = 1 } $ do+ Context.adjust store modifier $ do Context.mine store `shouldReturn` Thing { stuff = 2 }- Context.use store Thing { stuff = 3 } do+ Context.use store Thing { stuff = 3 } $ do Context.mine store `shouldReturn` Thing { stuff = 3 }- Context.use store Thing { stuff = 4 } do+ Context.use store Thing { stuff = 4 } $ do Context.mine store `shouldReturn` Thing { stuff = 4 } Context.mine store `shouldReturn` Thing { stuff = 3 }- Context.use store Thing { stuff = 4 } do+ Context.use store Thing { stuff = 4 } $ do Context.mine store `shouldReturn` Thing { stuff = 4 } Context.mine store `shouldReturn` Thing { stuff = 2 } Context.mine store `shouldReturn` Thing { stuff = 1 } Context.mine store `shouldReturn` Thing { stuff = 0 }- it "concurrent nested contexts" do+ it "concurrent nested contexts" $ do let mkContext i = Thing { stuff = i }- Context.withNonEmptyStore (mkContext 0) \store -> do- Async.forConcurrently_ [1 :: Int ..10] $ const do+ Context.withNonEmptyStore (mkContext 0) $ \store -> do+ Async.forConcurrently_ [1 :: Int ..10] $ const $ do Context.mine store `shouldReturn` mkContext 0- Context.use store (mkContext 1) do- Context.adjust store modifier do+ Context.use store (mkContext 1) $ do+ Context.adjust store modifier $ do Context.mine store `shouldReturn` mkContext 2- Context.use store (mkContext 3) do+ Context.use store (mkContext 3) $ do Context.mine store `shouldReturn` mkContext 3- Context.use store (mkContext 4) do+ Context.use store (mkContext 4) $ do Context.mine store `shouldReturn` mkContext 4 Context.mine store `shouldReturn` mkContext 3- Context.use store (mkContext 5) do+ Context.use store (mkContext 5) $ do Context.mine store `shouldReturn` mkContext 5 Context.mine store `shouldReturn` mkContext 2 Context.mine store `shouldReturn` mkContext 1 Context.mine store `shouldReturn` mkContext 0 Context.mine store `shouldReturn` mkContext 0 - describe "setDefault" do- it "setting default overrides initial default" do- Context.withNonEmptyStore Thing { stuff = 1 } \store -> do+ describe "setDefault" $ do+ it "setting default overrides initial default" $ do+ Context.withNonEmptyStore Thing { stuff = 1 } $ \store -> do Context.mineMay store `shouldReturn` Just Thing { stuff = 1 } Context.setDefault store Thing { stuff = 2 } Context.mineMay store `shouldReturn` Just Thing { stuff = 2 } - describe "viewMay" do- it "empty" do- Context.withEmptyStore @IO @Thing \store -> do+ describe "viewMay" $ do+ it "empty" $ do+ Context.withEmptyStore @IO @Thing $ \store -> do let storeView = fmap toOtherThing $ Context.toView store Context.viewMay storeView `shouldReturn` Nothing- it "single context" do- Context.withEmptyStore @IO @Thing \store -> do+ it "single context" $ do+ Context.withEmptyStore @IO @Thing $ \store -> do let storeView = fmap toOtherThing $ Context.toView store- Context.use store Thing { stuff = 1 } do+ Context.use store Thing { stuff = 1 } $ do Context.viewMay storeView `shouldReturn` Just OtherThing { otherStuff = 1 } Context.viewMay storeView `shouldReturn` Nothing- it "nested contexts" do- Context.withEmptyStore @IO @Thing \store -> do+ it "nested contexts" $ do+ Context.withEmptyStore @IO @Thing $ \store -> do let storeView = fmap toOtherThing $ Context.toView store- Context.use store Thing { stuff = 1 } do+ Context.use store Thing { stuff = 1 } $ do Context.viewMay storeView `shouldReturn` Just OtherThing { otherStuff = 1 }- Context.use store Thing { stuff = 2 } do+ Context.use store Thing { stuff = 2 } $ do Context.viewMay storeView `shouldReturn` Just OtherThing { otherStuff = 2 }- Context.use store Thing { stuff = 3 } do+ Context.use store Thing { stuff = 3 } $ do Context.viewMay storeView `shouldReturn` Just OtherThing { otherStuff = 3 } Context.viewMay storeView `shouldReturn` Just OtherThing { otherStuff = 2 }- Context.use store Thing { stuff = 4 } do+ Context.use store Thing { stuff = 4 } $ do Context.viewMay storeView `shouldReturn` Just OtherThing { otherStuff = 4 } Context.viewMay storeView `shouldReturn` Just OtherThing { otherStuff = 1 } Context.viewMay storeView `shouldReturn` Nothing- it "concurrent nested contexts" do+ it "concurrent nested contexts" $ do let mkContext i = Thing { stuff = i }- Context.withEmptyStore @IO @Thing \store -> do+ Context.withEmptyStore @IO @Thing $ \store -> do let storeView = fmap toOtherThing $ Context.toView store- Async.forConcurrently_ [1 :: Int ..10] $ const do+ Async.forConcurrently_ [1 :: Int ..10] $ const $ do Context.viewMay storeView `shouldReturn` Nothing- Context.use store (mkContext 1) do+ Context.use store (mkContext 1) $ do Context.viewMay storeView `shouldReturn` Just (toOtherThing $ mkContext 1)- Context.use store (mkContext 2) do+ Context.use store (mkContext 2) $ do Context.viewMay storeView `shouldReturn` Just (toOtherThing $ mkContext 2)- Context.use store (mkContext 3) do+ Context.use store (mkContext 3) $ do Context.viewMay storeView `shouldReturn` Just (toOtherThing $ mkContext 3) Context.viewMay storeView `shouldReturn` Just (toOtherThing $ mkContext 2)- Context.use store (mkContext 4) do+ Context.use store (mkContext 4) $ do Context.viewMay storeView `shouldReturn` Just (toOtherThing $ mkContext 4) Context.viewMay storeView `shouldReturn` Just (toOtherThing $ mkContext 1) Context.viewMay storeView `shouldReturn` Nothing Context.viewMay storeView `shouldReturn` Nothing - describe "view" do- it "empty" do- Context.withEmptyStore @IO @Thing \store -> do+ describe "view" $ do+ it "empty" $ do+ Context.withEmptyStore @IO @Thing $ \store -> do let storeView = fmap toOtherThing $ Context.toView store threadId <- Concurrent.myThreadId Context.view storeView `shouldThrow` notFound threadId- it "single context" do- Context.withEmptyStore @IO @Thing \store -> do+ it "single context" $ do+ Context.withEmptyStore @IO @Thing $ \store -> do let storeView = fmap toOtherThing $ Context.toView store threadId <- Concurrent.myThreadId- Context.use store Thing { stuff = 1 } do+ Context.use store Thing { stuff = 1 } $ do Context.view storeView `shouldReturn` OtherThing { otherStuff = 1 } Context.view storeView `shouldThrow` notFound threadId- it "nested contexts" do- Context.withEmptyStore @IO @Thing \store -> do+ it "nested contexts" $ do+ Context.withEmptyStore @IO @Thing $ \store -> do let storeView = fmap toOtherThing $ Context.toView store threadId <- Concurrent.myThreadId- Context.use store Thing { stuff = 1 } do+ Context.use store Thing { stuff = 1 } $ do Context.view storeView `shouldReturn` OtherThing { otherStuff = 1 }- Context.use store Thing { stuff = 2 } do+ Context.use store Thing { stuff = 2 } $ do Context.view storeView `shouldReturn` OtherThing { otherStuff = 2 }- Context.use store Thing { stuff = 3 } do+ Context.use store Thing { stuff = 3 } $ do Context.view storeView `shouldReturn` OtherThing { otherStuff = 3 } Context.view storeView `shouldReturn` OtherThing { otherStuff = 2 }- Context.use store Thing { stuff = 4 } do+ Context.use store Thing { stuff = 4 } $ do Context.view storeView `shouldReturn` OtherThing { otherStuff = 4 } Context.view storeView `shouldReturn` OtherThing { otherStuff = 1 } Context.view storeView `shouldThrow` notFound threadId- it "concurrent nested contexts" do+ it "concurrent nested contexts" $ do let mkContext i = Thing { stuff = i } initThreadId <- Concurrent.myThreadId- Context.withEmptyStore @IO @Thing \store -> do+ Context.withEmptyStore @IO @Thing $ \store -> do let storeView = fmap toOtherThing $ Context.toView store- Async.forConcurrently_ [1 :: Int ..10] $ const do+ Async.forConcurrently_ [1 :: Int ..10] $ const $ do threadId <- Concurrent.myThreadId Context.view storeView `shouldThrow` notFound threadId- Context.use store (mkContext 1) do+ Context.use store (mkContext 1) $ do Context.view storeView `shouldReturn` (toOtherThing $ mkContext 1)- Context.use store (mkContext 2) do+ Context.use store (mkContext 2) $ do Context.view storeView `shouldReturn` (toOtherThing $ mkContext 2)- Context.use store (mkContext 3) do+ Context.use store (mkContext 3) $ do Context.view storeView `shouldReturn` (toOtherThing $ mkContext 3) Context.view storeView `shouldReturn` (toOtherThing $ mkContext 2)- Context.use store (mkContext 4) do+ Context.use store (mkContext 4) $ do Context.view storeView `shouldReturn` (toOtherThing $ mkContext 4) Context.view storeView `shouldReturn` (toOtherThing $ mkContext 1) Context.view storeView `shouldThrow` notFound threadId