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
|
||||
( atomically
|
||||
, dupTChanIO
|
||||
, dupTChan
|
||||
, readTChan
|
||||
, writeTChan
|
||||
)
|
||||
@@ -74,8 +74,8 @@ spec :: Spec
|
||||
spec = describe "Bus" $ do
|
||||
it "broadcasts inbound messages to every dup'd channel in order" $ do
|
||||
bus <- newBus 0
|
||||
p1 <- dupTChanIO (busInbound bus)
|
||||
p2 <- dupTChanIO (busInbound bus)
|
||||
p1 <- atomically (dupTChan (busInbound bus))
|
||||
p2 <- atomically (dupTChan (busInbound bus))
|
||||
atomically $ writeTChan (busInbound bus) (Number 1)
|
||||
atomically $ writeTChan (busInbound bus) (Number 2)
|
||||
r1 <- atomically $ (,) <$> readTChan p1 <*> readTChan p1
|
||||
@@ -165,7 +165,7 @@ import HomeAssistant.Controller (HASSEff (..), Service)
|
||||
import Network.WebSockets (Connection)
|
||||
|
||||
-- | 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).
|
||||
data Bus = Bus
|
||||
{ busInbound :: TChan Value
|
||||
@@ -492,7 +492,7 @@ module HomeAssistant.Runtime
|
||||
|
||||
import AFRP (Event (..), Mealy (..))
|
||||
import Control.Concurrent.Async (mapConcurrently_)
|
||||
import Control.Concurrent.STM (atomically, dupTChanIO, readTChan)
|
||||
import Control.Concurrent.STM (atomically, dupTChan, readTChan)
|
||||
import Data.Aeson (Value)
|
||||
import qualified Data.Text as T
|
||||
import Data.Time (getCurrentTime)
|
||||
@@ -518,7 +518,7 @@ controllers = [Controller "light" lightController]
|
||||
-- initial state; messages broadcast during the restart window are lost.
|
||||
runController :: Bus -> Controller -> IO Void
|
||||
runController bus (Controller _name machine) = do
|
||||
inbound <- dupTChanIO (busInbound bus)
|
||||
inbound <- atomically (dupTChan (busInbound bus))
|
||||
go inbound machine
|
||||
where
|
||||
go inbound f = do
|
||||
|
||||
Reference in New Issue
Block a user