context-0.2.0.0: test-suite/Test/ContextSpec.hs
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TypeApplications #-}
module Test.ContextSpec
( spec
) where
import Control.Concurrent (ThreadId)
import Prelude
import Test.Hspec
import qualified Context
import qualified Control.Concurrent as Concurrent
import qualified Control.Concurrent.Async as Async
data Thing = Thing
{ stuff :: Int
} deriving stock (Eq, Show)
data OtherThing = OtherThing
{ otherStuff :: Int
} deriving stock (Eq, Show)
spec :: Spec
spec = 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
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
Context.mineMay store `shouldReturn` Just Thing { stuff = 1 }
Context.use store Thing { stuff = 2 } do
Context.mineMay store `shouldReturn` Just Thing { stuff = 2 }
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.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
let mkContext i = Thing { stuff = i }
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.mineMay store `shouldReturn` Just (mkContext 1)
Context.use store (mkContext 2) do
Context.mineMay store `shouldReturn` Just (mkContext 2)
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.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
Context.minesMay store stuff `shouldReturn` Nothing
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
Context.minesMay store stuff `shouldReturn` Just 1
Context.use store Thing { stuff = 2 } do
Context.minesMay store stuff `shouldReturn` Just 2
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.minesMay store stuff `shouldReturn` Just 4
Context.minesMay store stuff `shouldReturn` Just 1
Context.minesMay store stuff `shouldReturn` Nothing
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.minesMay store stuff `shouldReturn` Nothing
Context.use store (mkContext 1) do
Context.minesMay store stuff `shouldReturn` Just 1
Context.use store (mkContext 2) do
Context.minesMay store stuff `shouldReturn` Just 2
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.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
threadId <- Concurrent.myThreadId
Context.mine store `shouldThrow` notFound threadId
it "single context" do
Context.withEmptyStore @IO @Thing \store -> do
threadId <- Concurrent.myThreadId
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
threadId <- Concurrent.myThreadId
Context.use store Thing { stuff = 1 } do
Context.mine store `shouldReturn` Thing { stuff = 1 }
Context.use store Thing { stuff = 2 } do
Context.mine store `shouldReturn` Thing { stuff = 2 }
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.mine store `shouldReturn` Thing { stuff = 4 }
Context.mine store `shouldReturn` Thing { stuff = 1 }
Context.mine store `shouldThrow` notFound threadId
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
threadId <- Concurrent.myThreadId
Context.mine store `shouldThrow` notFound threadId
Context.use store (mkContext 1) do
Context.mine store `shouldReturn` mkContext 1
Context.use store (mkContext 2) do
Context.mine store `shouldReturn` mkContext 2
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.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
threadId <- Concurrent.myThreadId
Context.mines store stuff `shouldThrow` notFound threadId
it "single context" do
Context.withEmptyStore @IO @Thing \store -> do
threadId <- Concurrent.myThreadId
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
threadId <- Concurrent.myThreadId
Context.use store Thing { stuff = 1 } do
Context.mines store stuff `shouldReturn` 1
Context.use store Thing { stuff = 2 } do
Context.mines store stuff `shouldReturn` 2
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.mines store stuff `shouldReturn` 4
Context.mines store stuff `shouldReturn` 1
Context.mines store stuff `shouldThrow` notFound threadId
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
threadId <- Concurrent.myThreadId
Context.mine store `shouldThrow` notFound threadId
Context.use store (mkContext 1) do
Context.mines store stuff `shouldReturn` 1
Context.use store (mkContext 2) do
Context.mines store stuff `shouldReturn` 2
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.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
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
threadId <- Concurrent.myThreadId
Context.use store Thing { stuff = 1 } do
Context.mine store `shouldReturn` Thing { stuff = 1 }
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
threadId <- Concurrent.myThreadId
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.mine store `shouldReturn` Thing { stuff = 3 }
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.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
let mkContext i = Thing { stuff = i }
initThreadId <- Concurrent.myThreadId
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.mine store `shouldReturn` mkContext 2
Context.use store (mkContext 3) do
Context.mine store `shouldReturn` mkContext 3
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.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
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
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
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
Context.mineMay store `shouldReturn` Just Thing { stuff = 1 }
Context.use store Thing { stuff = 2 } do
Context.mineMay store `shouldReturn` Just Thing { stuff = 2 }
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.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
let mkContext i = Thing { stuff = i }
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.mineMay store `shouldReturn` Just (mkContext 1)
Context.use store (mkContext 2) do
Context.mineMay store `shouldReturn` Just (mkContext 2)
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.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
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
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
Context.minesMay store stuff `shouldReturn` Just 1
Context.use store Thing { stuff = 2 } do
Context.minesMay store stuff `shouldReturn` Just 2
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.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
let mkContext i = Thing { stuff = i }
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.minesMay store stuff `shouldReturn` Just 1
Context.use store (mkContext 2) do
Context.minesMay store stuff `shouldReturn` Just 2
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.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
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
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.mine store `shouldReturn` Thing { stuff = 1 }
Context.use store Thing { stuff = 2 } do
Context.mine store `shouldReturn` Thing { stuff = 2 }
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.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
let mkContext i = Thing { stuff = i }
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.mine store `shouldReturn` mkContext 1
Context.use store (mkContext 2) do
Context.mine store `shouldReturn` mkContext 2
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.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
Context.mines store stuff `shouldReturn` 0
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
Context.mines store stuff `shouldReturn` 1
Context.use store Thing { stuff = 2 } do
Context.mines store stuff `shouldReturn` 2
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.mines store stuff `shouldReturn` 4
Context.mines store stuff `shouldReturn` 1
Context.mines store stuff `shouldReturn` 0
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.mines store stuff `shouldReturn` 0
Context.use store (mkContext 1) do
Context.mines store stuff `shouldReturn` 1
Context.use store (mkContext 2) do
Context.mines store stuff `shouldReturn` 2
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.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
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
Context.mine store `shouldReturn` Thing { stuff = 1 }
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
Context.mine store `shouldReturn` Thing { stuff = 2 }
Context.use store Thing { stuff = 3 } do
Context.mine store `shouldReturn` Thing { stuff = 3 }
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.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
let mkContext i = Thing { stuff = i }
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.mine store `shouldReturn` mkContext 2
Context.use store (mkContext 3) do
Context.mine store `shouldReturn` mkContext 3
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.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
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
let storeView = fmap toOtherThing $ Context.toView store
Context.viewMay storeView `shouldReturn` Nothing
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.viewMay storeView `shouldReturn` Just OtherThing { otherStuff = 1 }
Context.viewMay storeView `shouldReturn` Nothing
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.viewMay storeView `shouldReturn` Just OtherThing { otherStuff = 1 }
Context.use store Thing { stuff = 2 } do
Context.viewMay storeView `shouldReturn` Just OtherThing { otherStuff = 2 }
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.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
let mkContext i = Thing { stuff = i }
Context.withEmptyStore @IO @Thing \store -> do
let storeView = fmap toOtherThing $ Context.toView store
Async.forConcurrently_ [1 :: Int ..10] $ const do
Context.viewMay storeView `shouldReturn` Nothing
Context.use store (mkContext 1) do
Context.viewMay storeView `shouldReturn` Just (toOtherThing $ mkContext 1)
Context.use store (mkContext 2) do
Context.viewMay storeView `shouldReturn` Just (toOtherThing $ mkContext 2)
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.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
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
let storeView = fmap toOtherThing $ Context.toView store
threadId <- Concurrent.myThreadId
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
let storeView = fmap toOtherThing $ Context.toView store
threadId <- Concurrent.myThreadId
Context.use store Thing { stuff = 1 } do
Context.view storeView `shouldReturn` OtherThing { otherStuff = 1 }
Context.use store Thing { stuff = 2 } do
Context.view storeView `shouldReturn` OtherThing { otherStuff = 2 }
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.view storeView `shouldReturn` OtherThing { otherStuff = 4 }
Context.view storeView `shouldReturn` OtherThing { otherStuff = 1 }
Context.view storeView `shouldThrow` notFound threadId
it "concurrent nested contexts" do
let mkContext i = Thing { stuff = i }
initThreadId <- Concurrent.myThreadId
Context.withEmptyStore @IO @Thing \store -> do
let storeView = fmap toOtherThing $ Context.toView store
Async.forConcurrently_ [1 :: Int ..10] $ const do
threadId <- Concurrent.myThreadId
Context.view storeView `shouldThrow` notFound threadId
Context.use store (mkContext 1) do
Context.view storeView `shouldReturn` (toOtherThing $ mkContext 1)
Context.use store (mkContext 2) do
Context.view storeView `shouldReturn` (toOtherThing $ mkContext 2)
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.view storeView `shouldReturn` (toOtherThing $ mkContext 4)
Context.view storeView `shouldReturn` (toOtherThing $ mkContext 1)
Context.view storeView `shouldThrow` notFound threadId
Context.view storeView `shouldThrow` notFound initThreadId
notFound :: ThreadId -> Context.NotFoundException -> Bool
notFound threadId notFoundEx =
Context.NotFoundException { Context.threadId } == notFoundEx
modifier :: Thing -> Thing
modifier thing = thing { stuff = 2 * stuff thing }
toOtherThing :: Thing -> OtherThing
toOtherThing Thing { stuff } = OtherThing { otherStuff = stuff }