Fix plan: use atomically dupTChan, not nonexistent dupTChanIO
This commit is contained in:
@@ -61,7 +61,7 @@ module BusSpec (spec) where
|
|||||||
|
|
||||||
import Control.Concurrent.STM
|
import Control.Concurrent.STM
|
||||||
( atomically
|
( atomically
|
||||||
, dupTChanIO
|
, dupTChan
|
||||||
, readTChan
|
, readTChan
|
||||||
, writeTChan
|
, writeTChan
|
||||||
)
|
)
|
||||||
@@ -74,8 +74,8 @@ spec :: Spec
|
|||||||
spec = describe "Bus" $ do
|
spec = describe "Bus" $ do
|
||||||
it "broadcasts inbound messages to every dup'd channel in order" $ do
|
it "broadcasts inbound messages to every dup'd channel in order" $ do
|
||||||
bus <- newBus 0
|
bus <- newBus 0
|
||||||
p1 <- dupTChanIO (busInbound bus)
|
p1 <- atomically (dupTChan (busInbound bus))
|
||||||
p2 <- dupTChanIO (busInbound bus)
|
p2 <- atomically (dupTChan (busInbound bus))
|
||||||
atomically $ writeTChan (busInbound bus) (Number 1)
|
atomically $ writeTChan (busInbound bus) (Number 1)
|
||||||
atomically $ writeTChan (busInbound bus) (Number 2)
|
atomically $ writeTChan (busInbound bus) (Number 2)
|
||||||
r1 <- atomically $ (,) <$> readTChan p1 <*> readTChan p1
|
r1 <- atomically $ (,) <$> readTChan p1 <*> readTChan p1
|
||||||
@@ -165,7 +165,7 @@ import HomeAssistant.Controller (HASSEff (..), Service)
|
|||||||
import Network.WebSockets (Connection)
|
import Network.WebSockets (Connection)
|
||||||
|
|
||||||
-- | Shared runtime state: inbound is a broadcast channel (controllers
|
-- | Shared runtime state: inbound is a broadcast channel (controllers
|
||||||
-- read from 'dupTChanIO' copies), outbound queues service calls for the
|
-- read from 'dupTChan' copies), outbound queues service calls for the
|
||||||
-- writer, conn holds the current websocket (Nothing before first connect).
|
-- writer, conn holds the current websocket (Nothing before first connect).
|
||||||
data Bus = Bus
|
data Bus = Bus
|
||||||
{ busInbound :: TChan Value
|
{ busInbound :: TChan Value
|
||||||
@@ -492,7 +492,7 @@ module HomeAssistant.Runtime
|
|||||||
|
|
||||||
import AFRP (Event (..), Mealy (..))
|
import AFRP (Event (..), Mealy (..))
|
||||||
import Control.Concurrent.Async (mapConcurrently_)
|
import Control.Concurrent.Async (mapConcurrently_)
|
||||||
import Control.Concurrent.STM (atomically, dupTChanIO, readTChan)
|
import Control.Concurrent.STM (atomically, dupTChan, readTChan)
|
||||||
import Data.Aeson (Value)
|
import Data.Aeson (Value)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Data.Time (getCurrentTime)
|
import Data.Time (getCurrentTime)
|
||||||
@@ -518,7 +518,7 @@ controllers = [Controller "light" lightController]
|
|||||||
-- initial state; messages broadcast during the restart window are lost.
|
-- initial state; messages broadcast during the restart window are lost.
|
||||||
runController :: Bus -> Controller -> IO Void
|
runController :: Bus -> Controller -> IO Void
|
||||||
runController bus (Controller _name machine) = do
|
runController bus (Controller _name machine) = do
|
||||||
inbound <- dupTChanIO (busInbound bus)
|
inbound <- atomically (dupTChan (busInbound bus))
|
||||||
go inbound machine
|
go inbound machine
|
||||||
where
|
where
|
||||||
go inbound f = do
|
go inbound f = do
|
||||||
|
|||||||
Reference in New Issue
Block a user