Fix plan: use atomically dupTChan, not nonexistent dupTChanIO

This commit is contained in:
2026-08-20 19:31:17 +03:00
parent 78248388ac
commit 6c7060e46e
@@ -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