Add Runtime.Bus with channel-based effect interpreter

src/HomeAssistant/Runtime/Bus.hs

@@ -0,0 +1,52 @@
+{-# LANGUAGE LambdaCase #-}
+
+module HomeAssistant.Runtime.Bus
+  ( Bus(..)
+  , CallIdGen(..)
+  , mkCallIdGen
+  , newBus
+  , channelHassEval
+  ) where
+
+import Control.Concurrent.STM
+  ( TChan
+  , TVar
+  , atomically
+  , newBroadcastTChanIO
+  , newTChanIO
+  , newTVarIO
+  , writeTChan
+  )
+import Data.Aeson (Value)
+import Data.IORef (atomicModifyIORef', newIORef)
+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
+-- writer, conn holds the current websocket (Nothing before first connect).
+data Bus = Bus
+  { busInbound  :: TChan Value
+  , busOutbound :: TChan Service
+  , busConn     :: TVar (Maybe Connection)
+  , busGen      :: CallIdGen
+  }
+
+newBus :: Int -> IO Bus
+newBus start = Bus
+  <$> newBroadcastTChanIO
+  <*> newTChanIO
+  <*> newTVarIO Nothing
+  <*> mkCallIdGen start
+
+channelHassEval :: Bus -> HASSEff a -> IO a
+channelHassEval bus = \case
+  CallService svc -> atomically $ writeTChan (busOutbound bus) svc
+  Pure a          -> pure a
+
+newtype CallIdGen = CallIdGen { generateCallId :: IO Int }
+
+mkCallIdGen :: Int -> IO CallIdGen
+mkCallIdGen start = do
+  gen <- newIORef start
+  pure $ CallIdGen $ atomicModifyIORef' gen (\old -> let new = old + 1 in new `seq` (new, new))