Works

2026-08-21 13:15:31 +03:00
parent dfc744842d
commit e50a505a13
16 changed files with 85 additions and 3072 deletions
@@ -1,6 +1,6 @@
 { mkDerivation, aeson, annotated-exception, async, base, bytestring
-, hedgehog, hspec, hspec-hedgehog, lens, lens-aeson, lib, network
+, hedgehog, hspec, hspec-hedgehog, katip, lens, lens-aeson, lib
-, stm, text, time, uuid, websockets
+, network, stm, text, time, uuid, websockets
 }:
 mkDerivation {
  pname = "home-assistant-controller";
@@ -9,8 +9,8 @@ mkDerivation {
  isLibrary = true;
  isExecutable = true;
  libraryHaskellDepends = [
-    aeson annotated-exception async base bytestring lens lens-aeson
+    aeson annotated-exception async base bytestring katip lens
-    network stm text time uuid websockets
+    lens-aeson network stm text time uuid websockets
  ];
  executableHaskellDepends = [ base ];
  testHaskellDepends = [
@@ -1,874 +0,0 @@
 # Concurrent Runtime Implementation Plan
 > **For agentic workers:** REQUIRED SUB-SKILL: Use superpowers:subagent-driven-development (recommended) or superpowers:executing-plans to implement this plan task-by-task. Steps use checkbox (`- [ ]`) syntax for tracking.
 **Goal:** Support multiple controllers over a single websocket connection: one reader thread broadcasting to per-controller channels, a writer thread sending queued service calls, supervised worker threads with backoff restarts, and reconnect-on-network-failure.
 **Architecture:** A `Bus` (broadcast `TChan` inbound, `TChan` outbound, `TVar (Maybe Connection)`, existing `CallIdGen`) connects a reader thread (connect/auth/subscribe/receive-broadcast; restart = reconnect) and a writer thread to N controller threads, each stepping a `Mealy HASSEff` machine over its own dup'd channel. Slice 1 wires them with `mapConcurrently_` (any crash exits). Slice 2 wraps each worker in `supervised` (annotated-exception, exponential backoff, `Fatal` rethrow).
 **Tech Stack:** Haskell (GHC 9.10, GHC2024), stm, async, annotated-exception, websockets, aeson, hspec, hedgehog. Nix/cabal build.
 **Spec:** `docs/superpowers/specs/2026-08-20-concurrent-runtime-design.md`
 ## Global Constraints
 - Run cabal only through the devShell: `nix develop -c cabal build` / `nix develop -c cabal test`.
 - After changing the .cabal file, regenerate the derivation: `nix run nixpkgs#cabal2nix -- ./. > default.nix`. Never edit it by hand.
 - `-Wall` (common `warnings` stanza) must produce zero warnings.
 - Comments are minimal, contract-style: describe what, not how.
 - Never read, print, or commit `secrets.yaml`.
 - Commit after every task. Message style: short imperative, no prefix (see `git log`).
 - Unit tests: hspec. Property tests: hedgehog.
 - Modules are vertical (split by feature/concept, not layer).
 ## File Structure
 | File | Responsibility |
 |---|---|
 | `src/HomeAssistant/Runtime/Bus.hs` (create) | Shared channels + connection cell + call-id gen + channel interpreter |
 | `src/HomeAssistant/Runtime/Connection.hs` (create) | Reader/writer thread actions, pure `encodeService` |
 | `src/HomeAssistant/Runtime/Supervisor.hs` (create, slice 2) | Generic restart-with-backoff combinator, `Backoff`, `Fatal` |
 | `src/HomeAssistant/Runtime.hs` (rewrite) | Glue: `Controller`, `runController`, `controllers`, `defaultMain`, `step`, `dryRunHassEval` |
 | `src/HomeAssistant/Controller.hs` (1-word change) | Derive `Eq` on `Service` (tests need it) |
 | `test/Main.hs` (rewrite) | hspec runner |
 | `test/BusSpec.hs`, `test/ConnectionSpec.hs`, `test/RuntimeSpec.hs`, `test/SupervisorSpec.hs`, `test/BackoffProp.hs` (create) | Specs |
 | `home-assistant-controller.cabal` | Deps + module lists per task |
 Slices: Tasks 1–3 = slice 1 (concurrency). Tasks 4–5 = slice 2 (robustness).
 ---
 ### Task 1: Bus module
 **Files:**
 - Create: `src/HomeAssistant/Runtime/Bus.hs`
 - Modify: `src/HomeAssistant/Runtime.hs` (move `CallIdGen` out, re-export from Bus)
 - Modify: `src/HomeAssistant/Controller.hs:43` (derive `Eq`)
 - Modify: `home-assistant-controller.cabal` (exposed module, `stm` dep, test deps)
 - Rewrite: `test/Main.hs`
 - Create: `test/BusSpec.hs`
 **Interfaces:**
 - Consumes: `HASSEff(..)`, `Service` from `HomeAssistant.Controller`.
 - Produces (Bus exports): `Bus(..)` with fields `busInbound :: TChan Value`, `busOutbound :: TChan Service`, `busConn :: TVar (Maybe WS.Connection)`, `busGen :: CallIdGen`; `CallIdGen(..)` (record field `generateCallId :: IO Int`); `mkCallIdGen :: Int -> IO CallIdGen`; `newBus :: Int -> IO Bus`; `channelHassEval :: Bus -> HASSEff a -> IO a`.
 - [ ] **Step 1: Write the failing test**
 `test/BusSpec.hs`:
 ```haskell
 module BusSpec (spec) where
 import Control.Concurrent.STM
  ( atomically
  , dupTChan
  , readTChan
  , writeTChan
  )
 import Data.Aeson (Value (..))
 import HomeAssistant.Controller (HASSEff (..), Service (..))
 import HomeAssistant.Runtime.Bus
 import Test.Hspec
 spec :: Spec
 spec = describe "Bus" $ do
  it "broadcasts inbound messages to every dup'd channel in order" $ do
    bus <- newBus 0
    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
    r2 <- atomically $ (,) <$> readTChan p2 <*> readTChan p2
    r1 `shouldBe` (Number 1, Number 2)
    r2 `shouldBe` (Number 1, Number 2)
  it "channelHassEval writes CallService to the outbound channel" $ do
    bus <- newBus 0
    let svc = Service "light" "turn_on" Nothing "light.bedroom_masse"
    channelHassEval bus (CallService svc)
    atomically (readTChan (busOutbound bus)) `shouldReturn` svc
  it "channelHassEval leaves Pure untouched" $ do
    bus <- newBus 0
    channelHassEval bus (Pure 42) `shouldReturn` (42 :: Int)
  it "generates unique sequential call ids" $ do
    gen <- mkCallIdGen 0
    a <- generateCallId gen
    b <- generateCallId gen
    (a, b) `shouldBe` (1, 2)
 ```
 `test/Main.hs`:
 ```haskell
 module Main (main) where
 import Test.Hspec (hspec)
 import qualified BusSpec
 main :: IO ()
 main = hspec BusSpec.spec
 ```
 In `home-assistant-controller.cabal`:
 Library section: add to `exposed-modules`: `HomeAssistant.Runtime.Bus`; add to `build-depends`: `stm`.
 Test suite section: add `other-modules: BusSpec` and set:
 ```
    build-depends:
        base ^>=4.20.2.0,
        home-assistant-controller,
        hspec,
        stm,
        aeson,
        text
 ```
 In `src/HomeAssistant/Controller.hs` change line 43 from `deriving Show` to `deriving (Show, Eq)`.
 - [ ] **Step 2: Run test to verify it fails**
 Run: `nix develop -c cabal test`
 Expected: FAIL — compile error, `Could not find module 'HomeAssistant.Runtime.Bus'`.
 - [ ] **Step 3: Write the implementation**
 `src/HomeAssistant/Runtime/Bus.hs`:
 ```haskell
 {-# 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 'dupTChan' 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))
 ```
 Then in `src/HomeAssistant/Runtime.hs`:
 - Delete the local `newtype CallIdGen`/`mkCallIdGen` definitions (lines 105–110).
 - Add import: `import HomeAssistant.Runtime.Bus (CallIdGen(..), mkCallIdGen)`.
 - Export list stays the same (`CallIdGen`, `mkCallIdGen` now re-exported from Bus).
 - [ ] **Step 4: Regenerate the nix derivation**
 Run: `nix run nixpkgs#cabal2nix -- ./. > default.nix`
 Expected: no output; `git diff default.nix` shows the new `stm`/test dependencies.
 - [ ] **Step 5: Run tests to verify they pass**
 Run: `nix develop -c cabal build && nix develop -c cabal test`
 Expected: build with zero warnings; 4 examples, 0 failures.
 - [ ] **Step 6: Commit**
 ```bash
 git add src test home-assistant-controller.cabal default.nix
 git commit -m "Add Runtime.Bus with channel-based effect interpreter"
 ```
 ---
 ### Task 2: Connection module (reader/writer actions)
 **Files:**
 - Create: `src/HomeAssistant/Runtime/Connection.hs`
 - Create: `test/ConnectionSpec.hs`
 - Modify: `test/Main.hs`, `home-assistant-controller.cabal`
 **Interfaces:**
 - Consumes: `Bus(..)`, `CallIdGen(..)` from Task 1.
 - Produces (Connection exports): `readerAction :: String -> Int -> String -> Bus -> IO Void` (host, port, token; restart = reconnect); `writerAction :: Bus -> IO Void`; `encodeService :: Int -> Service -> Data.Aeson.Value`.
 **Background for the implementer (verified facts, do not re-verify):**
 - `WS.runClient` runs the `ClientApp` under `bracket` and closes the socket/stream when the app throws — reconnects do not leak fds.
 - Exceptions from `WS.receiveData` (e.g. `ConnectionClosed`) are what make the reader restartable; connect failures throw `IOException`.
 - HA sends a `result` ack for `subscribe_events`; we deliberately do not read it — it flows to controllers and is filtered out by their entity-id lenses (same as current behavior).
 - [ ] **Step 1: Write the failing test**
 `test/ConnectionSpec.hs`:
 ```haskell
 module ConnectionSpec (spec) where
 import Data.Aeson (object, (.=))
 import Data.Text (Text)
 import HomeAssistant.Controller (Service (..))
 import HomeAssistant.Runtime.Connection (encodeService)
 import Test.Hspec
 spec :: Spec
 spec = describe "encodeService" $ do
  it "encodes a call_service message" $
    encodeService 7 (Service "light" "turn_on" Nothing "light.bedroom_masse")
      `shouldBe` object
        [ "id" .= (7 :: Int)
        , "type" .= ("call_service" :: Text)
        , "domain" .= ("light" :: Text)
        , "service" .= ("turn_on" :: Text)
        , "target" .= object ["entity_id" .= ("light.bedroom_masse" :: Text)]
        ]
  it "includes service_data when present" $
    encodeService 8 (Service "light" "turn_on" (Just (object ["brightness" .= (200 :: Int)])) "light.bedroom_masse")
      `shouldBe` object
        [ "id" .= (8 :: Int)
        , "type" .= ("call_service" :: Text)
        , "domain" .= ("light" :: Text)
        , "service" .= ("turn_on" :: Text)
        , "target" .= object ["entity_id" .= ("light.bedroom_masse" :: Text)]
        , "service_data" .= object ["brightness" .= (200 :: Int)]
        ]
 ```
 `test/Main.hs`: add `import qualified ConnectionSpec` and change `main` to:
 ```haskell
 main :: IO ()
 main = hspec $ do
  BusSpec.spec
  ConnectionSpec.spec
 ```
 Cabal: library `exposed-modules` += `HomeAssistant.Runtime.Connection`; test `other-modules` += `ConnectionSpec`.
 - [ ] **Step 2: Run test to verify it fails**
 Run: `nix develop -c cabal test`
 Expected: FAIL — `Could not find module 'HomeAssistant.Runtime.Connection'`.
 - [ ] **Step 3: Write the implementation**
 `src/HomeAssistant/Runtime/Connection.hs`:
 ```haskell
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 module HomeAssistant.Runtime.Connection
  ( readerAction
  , writerAction
  , encodeService
  ) where
 import Control.Concurrent.STM
  ( atomically
  , readTChan
  , readTVar
  , retry
  , writeTChan
  , writeTVar
  )
 import Control.Lens ((^?))
 import Control.Monad (forever)
 import Data.Aeson (Value, eitherDecode, encode, object, (.=))
 import Data.Aeson.Lens (key, _String)
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.Text as T
 import Data.Void (Void)
 import HomeAssistant.Controller (Service (..))
 import HomeAssistant.Runtime.Bus
 import qualified Network.WebSockets as WS
 -- | Connect, authenticate, subscribe, then receive and broadcast forever.
 -- Restarting this action reconnects. All setup sends happen before the
 -- connection is published in the bus, so only the writer sends afterwards.
 readerAction :: String -> Int -> String -> Bus -> IO Void
 readerAction host port token bus =
  WS.runClient host port "/api/websocket" $ \conn -> do
    handshake conn token
    subscribe bus conn
    atomically $ writeTVar (busConn bus) (Just conn)
    putStrLn "[reader] connected"
    receiveLoop bus conn
 handshake :: WS.Connection -> String -> IO ()
 handshake conn token = do
  required <- receiveJSON conn
  expectType "auth_required" required
  WS.sendTextData conn $ encode $ object
    [ "type"         .= ("auth" :: T.Text)
    , "access_token" .= token
    ]
  ok <- receiveJSON conn
  expectType "auth_ok" ok
 expectType :: T.Text -> Value -> IO ()
 expectType expected msg =
  case msg ^? key "type" . _String of
    Just t | t == expected -> pure ()
    _ -> fail $ "expected " <> T.unpack expected <> ", got: " <> show msg
 subscribe :: Bus -> WS.Connection -> IO ()
 subscribe bus conn = do
  sid <- generateCallId (busGen bus)
  WS.sendTextData conn $ encode $ object
    [ "id"         .= sid
    , "type"       .= ("subscribe_events" :: T.Text)
    , "event_type" .= ("state_changed" :: T.Text)
    ]
 -- | Undecodable messages are skipped: reconnecting cannot fix a decode
 -- problem, so crashing here would only produce a hot restart loop.
 receiveLoop :: Bus -> WS.Connection -> IO Void
 receiveLoop bus conn = forever $ do
  msg <- WS.receiveData conn :: IO BL.ByteString
  case eitherDecode msg of
    Left err -> putStrLn $ "[reader] skipping undecodable message: " <> err
    Right v  -> atomically $ writeTChan (busInbound bus) v
 receiveJSON :: WS.Connection -> IO Value
 receiveJSON conn = do
  msg <- WS.receiveData conn
  case eitherDecode msg of
    Left err -> fail $ "Invalid JSON from Home Assistant: " ++ err
    Right x  -> pure x
 writerAction :: Bus -> IO Void
 writerAction bus = forever $ do
  svc <- atomically $ readTChan (busOutbound bus)
  conn <- atomically $ readTVar (busConn bus) >>= maybe retry pure
  callId <- generateCallId (busGen bus)
  WS.sendTextData conn $ encode $ encodeService callId svc
 encodeService :: Int -> Service -> Value
 encodeService callId Service{..} = object $
  [ "id"      .= callId
  , "type"    .= ("call_service" :: T.Text)
  , "domain"  .= serviceDomain
  , "service" .= serviceName
  , "target"  .= object ["entity_id" .= serviceTarget]
  ] <> maybe [] (\d -> ["service_data" .= d]) serviceData
 ```
 - [ ] **Step 4: Run tests to verify they pass**
 Run: `nix develop -c cabal build && nix develop -c cabal test`
 Expected: zero warnings; 6 examples, 0 failures.
 - [ ] **Step 5: Commit**
 ```bash
 git add src test home-assistant-controller.cabal
 git commit -m "Add Runtime.Connection reader and writer actions"
 ```
 ---
 ### Task 3: Runtime rewrite — controller threads and wiring (completes slice 1)
 **Files:**
 - Rewrite: `src/HomeAssistant/Runtime.hs`
 - Create: `test/RuntimeSpec.hs`
 - Modify: `test/Main.hs`, `home-assistant-controller.cabal`
 **Interfaces:**
 - Consumes: `Bus(..)`, `newBus`, `channelHassEval`, `CallIdGen(..)`, `mkCallIdGen` (Task 1); `readerAction`, `writerAction` (Task 2).
 - Produces (Runtime exports): `defaultMain :: IO ()`, `step`, `dryRunHassEval`, `CallIdGen`, `mkCallIdGen`, `Controller(..)` with `data Controller = forall b. Controller T.Text (HASS (Event Value) b)`, `runController :: Bus -> Controller -> IO Void`.
 - Removes exports: `app`, `hassEval`, `wsCallService`, `receiveJSON` (deleted or internal to Connection). The `get_states` debug dump goes away.
 **Background:** `mapConcurrently_` rethrows the first worker exception and cancels the rest — a crash exits the process, same as today. That is intended for slice 1.
 - [ ] **Step 1: Write the failing test**
 `test/RuntimeSpec.hs`:
 ```haskell
 {-# LANGUAGE OverloadedStrings #-}
 module RuntimeSpec (spec) where
 import Control.Concurrent (threadDelay)
 import Control.Concurrent.Async (async)
 import Control.Concurrent.STM (atomically, readTChan, writeTChan)
 import Data.Aeson (Value, object, (.=))
 import Data.Text (Text)
 import HomeAssistant.Controller (light, lightController)
 import HomeAssistant.Runtime (Controller (..), runController)
 import HomeAssistant.Runtime.Bus
 import Test.Hspec
 spec :: Spec
 spec = describe "runController" $ do
  it "feeds inbound events through the machine and forwards service calls" $ do
    bus <- newBus 0
    _ <- async (runController bus (Controller "test" lightController))
    threadDelay 100000 -- let the controller dup its inbound channel
    atomically $ writeTChan (busInbound bus) (doorEvent "on")  -- initial value: no change event
    atomically $ writeTChan (busInbound bus) (doorEvent "off") -- door closes: lights on
    atomically $ writeTChan (busInbound bus) (doorEvent "on")  -- door opens: lights off
    svc1 <- atomically (readTChan (busOutbound bus))
    svc2 <- atomically (readTChan (busOutbound bus))
    svc1 `shouldBe` light True
    svc2 `shouldBe` light False
 doorEvent :: Text -> Value
 doorEvent state = object
  [ "event" .= object
    [ "data" .= object
      [ "entity_id" .= ("binary_sensor.makuuhuone_ovi_contact" :: Text)
      , "new_state" .= object ["state" .= state]
      ]
    ]
  ]
 ```
 Note: the first event only seeds the machine (`changes` does not fire on the initial value), hence two expected service calls, not three.
 `test/Main.hs`: add `import qualified RuntimeSpec`; run all three specs. Cabal: test `other-modules` += `RuntimeSpec`, test `build-depends` += `async`.
 - [ ] **Step 2: Run test to verify it fails**
 Run: `nix develop -c cabal test`
 Expected: FAIL — `Controller` / `runController` not in scope.
 - [ ] **Step 3: Rewrite the Runtime module**
 Replace `src/HomeAssistant/Runtime.hs` entirely with:
 ```haskell
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 module HomeAssistant.Runtime
  ( defaultMain
  , step
  , CallIdGen
  , mkCallIdGen
  , dryRunHassEval
  , Controller(..)
  , runController
  ) where
 import AFRP (Event (..), Mealy (..))
 import Control.Concurrent.Async (mapConcurrently_)
 import Control.Concurrent.STM (atomically, dupTChan, readTChan)
 import Data.Aeson (Value)
 import qualified Data.Text as T
 import Data.Time (getCurrentTime)
 import Data.Void (Void)
 import HomeAssistant.Controller (HASS, HASSEff (..), lightController)
 import HomeAssistant.Runtime.Bus
 import HomeAssistant.Runtime.Connection (readerAction, writerAction)
 import Network.Socket (withSocketsDo)
 import System.Environment (getEnv)
 step :: (forall x. eff x -> IO x) -> Mealy eff a b -> a -> IO (b, Mealy eff a b)
 step nt (Mealy f) a = do
  now <- getCurrentTime
  f nt now a
 data Controller = forall b. Controller T.Text (HASS (Event Value) b)
 controllers :: [Controller]
 controllers = [Controller "light" lightController]
 -- | Steps the machine for every inbound message; service calls go to the
 -- bus. A restart re-dups the inbound channel and starts from the machine's
 -- initial state; messages broadcast during the restart window are lost.
 runController :: Bus -> Controller -> IO Void
 runController bus (Controller _name machine) = do
  inbound <- atomically (dupTChan (busInbound bus))
  go inbound machine
  where
    go inbound f = do
      msg <- atomically (readTChan inbound)
      (_, f') <- step (channelHassEval bus) f (Event msg)
      go inbound f'
 defaultMain :: IO ()
 defaultMain = withSocketsDo $ do
  token <- getEnv "HA_TOKEN"
  bus <- newBus 0
  mapConcurrently_ id $
    [ readerAction "last-resort-redux" 8123 token bus
    , writerAction bus
    ] ++ map (runController bus) controllers
 dryRunHassEval :: CallIdGen -> HASSEff a -> IO a
 dryRunHassEval gen = \case
  CallService x -> do
    callId <- generateCallId gen
    print (callId, x)
  Pure a -> pure a
 ```
 - [ ] **Step 4: Regenerate derivation and run tests**
 Run: `nix run nixpkgs#cabal2nix -- ./. > default.nix && nix develop -c cabal build && nix develop -c cabal test`
 Expected: zero warnings; 7 examples, 0 failures.
 - [ ] **Step 5: Commit**
 ```bash
 git add src test home-assistant-controller.cabal default.nix
 git commit -m "Run controllers on their own threads over the bus"
 ```
 ---
 ### Task 4: Supervisor module (starts slice 2)
 **Files:**
 - Create: `src/HomeAssistant/Runtime/Supervisor.hs`
 - Create: `test/SupervisorSpec.hs`, `test/BackoffProp.hs`
 - Modify: `test/Main.hs`, `home-assistant-controller.cabal`
 **Interfaces:**
 - Consumes: nothing from other runtime modules (generic).
 - Produces: `supervised :: Text -> Backoff -> IO Void -> IO Void`; `Backoff(..)` (`backoffBase`, `backoffCap`, `backoffQuiet`, all `NominalDiffTime`); `defaultBackoff` (= `Backoff 0.1 30 30`); `backoffDelay :: Backoff -> Int -> NominalDiffTime`; `nextAttempt :: Backoff -> NominalDiffTime -> Int -> Int`; `Fatal (..)` (`newtype Fatal = Fatal Text`).
 **Background (verified, do not re-verify):** `Control.Exception.Annotated` is built on safe-exceptions: its `catch`/`catches`/`try` only catch *synchronous* exceptions, so async exceptions propagate without any manual `SomeAsyncException` filtering. `catch @(AnnotatedException e)` sees through a single `AnnotatedException` wrapper (bare `e` gets an empty annotation set), which is how the `Fatal` handler below works.
 **Invariant (document in code):** actions passed to `supervised` must not be wrapped in `checkpoint`s around `Fatal`-throwing code — a double-wrapped `Fatal` is invisible to the handler and would restart instead of crashing. The reader honors this (Task 5).
 - [ ] **Step 1: Write the failing tests**
 `test/SupervisorSpec.hs`:
 ```haskell
 {-# LANGUAGE OverloadedStrings #-}
 module SupervisorSpec (spec) where
 import Control.Concurrent (newEmptyMVar, putMVar, readMVar, threadDelay)
 import Control.Concurrent.Async (async, cancel, poll, waitCatch)
 import Control.Exception (SomeException, fromException)
 import Control.Exception.Annotated (AnnotatedException (..), throw)
 import Control.Monad (forever)
 import Data.IORef (atomicModifyIORef', newIORef, readIORef)
 import Data.Maybe (isJust, isNothing)
 import HomeAssistant.Runtime.Supervisor
 import System.IO.Error (ioError, userError)
 import Test.Hspec
 tinyBackoff :: Backoff
 tinyBackoff = Backoff 0.001 0.002 0.001
 spec :: Spec
 spec = describe "supervised" $ do
  it "restarts a crashing action until it stays up" $ do
    counter <- newIORef (0 :: Int)
    up <- newEmptyMVar
    let action = do
          n <- atomicModifyIORef' counter (\c -> (c + 1, c + 1))
          if n < 3
            then ioError (userError "boom")
            else do putMVar up (); forever (threadDelay 1000000)
    sup <- async (supervised "test" tinyBackoff action)
    readMVar up
    threadDelay 50000
    status <- poll sup
    isNothing status `shouldBe` True
    readIORef counter `shouldReturn` 3
    cancel sup
  it "rethrows Fatal instead of restarting" $ do
    counter <- newIORef (0 :: Int)
    let action = do
          atomicModifyIORef' counter (\c -> (c + 1, c + 1))
          throw (Fatal "auth_invalid")
    sup <- async (supervised "test" tinyBackoff action)
    res <- waitCatch sup
    case res of
      Left se -> case fromException se :: Maybe (AnnotatedException Fatal) of
        Just _  -> pure ()
        Nothing -> expectationFailure "expected Fatal to propagate"
      Right _ -> expectationFailure "supervised returned"
    threadDelay 50000
    readIORef counter `shouldReturn` 1
  it "does not restart on async exceptions" $ do
    counter <- newIORef (0 :: Int)
    let action = do
          atomicModifyIORef' counter (\c -> (c + 1, c + 1))
          forever (threadDelay 1000000)
    sup <- async (supervised "test" tinyBackoff action)
    threadDelay 100000
    cancel sup
    threadDelay 100000
    readIORef counter `shouldReturn` 1
    status <- poll sup
    isJust status `shouldBe` True
  describe "nextAttempt" $ do
    it "resets after a quiet period" $
      nextAttempt tinyBackoff 0.001 5 `shouldBe` 1
    it "increments otherwise" $
      nextAttempt tinyBackoff 0.0005 5 `shouldBe` 6
  describe "backoffDelay" $ do
    it "starts at base" $ backoffDelay tinyBackoff 1 `shouldBe` 0.001
    it "doubles" $ backoffDelay tinyBackoff 2 `shouldBe` 0.002
    it "clamps at cap" $ backoffDelay tinyBackoff 3 `shouldBe` 0.002
 ```
 `test/BackoffProp.hs`:
 ```haskell
 module BackoffProp (spec) where
 import Data.Time (NominalDiffTime)
 import qualified Hedgehog.Gen as Gen
 import qualified Hedgehog.Range as Range
 import HomeAssistant.Runtime.Supervisor (Backoff (..), backoffDelay)
 import Test.Hspec (Spec, describe, it)
 import Test.Hspec.Hedgehog (hedgehog, forAll, (===))
 spec :: Spec
 spec = describe "backoffDelay" $
  it "doubles from base, clamped at cap" $ hedgehog $ do
    baseD <- forAll $ Gen.double (Range.constant 0.0001 10)
    ratio <- forAll $ Gen.double (Range.constant 1 100)
    let base = realToFrac baseD :: NominalDiffTime
        cap = realToFrac (baseD * ratio) :: NominalDiffTime
        backoff = Backoff base cap 1
        delays = map (backoffDelay backoff) [1 .. 100 :: Int]
    head delays === min cap base
    mapM_ (\(a, b) -> b === min cap (a * 2)) (zip delays (drop 1 delays))
 ```
 (`hspec-hedgehog` provides the `hedgehog` bridge — plain hedgehog 1.5 has
 no hspec integration — and re-exports `forAll` and `(===)`.)
 `test/Main.hs`: add imports and run all five specs. Cabal: library `exposed-modules` += `HomeAssistant.Runtime.Supervisor`, library `build-depends` += `annotated-exception`; test `other-modules` += `SupervisorSpec, BackoffProp`, test `build-depends` += `hedgehog, hspec-hedgehog, annotated-exception, time`.
 - [ ] **Step 2: Run tests to verify they fail**
 Run: `nix develop -c cabal test`
 Expected: FAIL — `Could not find module 'HomeAssistant.Runtime.Supervisor'`.
 - [ ] **Step 3: Write the implementation**
 `src/HomeAssistant/Runtime/Supervisor.hs`:
 ```haskell
 {-# LANGUAGE ScopedTypeVariables #-}
 module HomeAssistant.Runtime.Supervisor
  ( supervised
  , Backoff(..)
  , defaultBackoff
  , backoffDelay
  , nextAttempt
  , Fatal(..)
  ) where
 import Control.Concurrent (threadDelay)
 import Control.Exception.Annotated
  ( Exception
  , Handler (..)
  , SomeException
  , catches
  , displayException
  , throw
  )
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time (NominalDiffTime, diffUTCTime, getCurrentTime)
 import Data.Void (Void)
 -- | A failure that cannot be fixed by restarting; propagates out of
 -- 'supervised' and terminates the process.
 newtype Fatal = Fatal Text
  deriving (Show, Exception)
 data Backoff = Backoff
  { backoffBase  :: NominalDiffTime -- ^ Delay before the first restart
  , backoffCap   :: NominalDiffTime -- ^ Maximum delay between restarts
  , backoffQuiet :: NominalDiffTime -- ^ Uptime after which the delay resets
  }
  deriving (Eq, Show)
 defaultBackoff :: Backoff
 defaultBackoff = Backoff 0.1 30 30
 -- | Delay before the @attempt@-th restart: doubles from base, clamped at cap.
 backoffDelay :: Backoff -> Int -> NominalDiffTime
 backoffDelay (Backoff base cap _) attempt = go (attempt - 1) base
  where
    go 0 d = d
    go n d = go (n - 1) (min cap (d * 2))
 -- | Attempt number to use after a crash that ran for the given uptime.
 nextAttempt :: Backoff -> NominalDiffTime -> Int -> Int
 nextAttempt (Backoff _ _ quiet) uptime attempt
  | uptime >= quiet = 1
  | otherwise = attempt + 1
 -- | Runs the action forever, restarting it with backoff after synchronous
 -- exceptions; async exceptions propagate. 'Fatal' is rethrown (crashing the
 -- caller) rather than restarted. The action must never return normally and
 -- must not be wrapped in checkpoints around 'Fatal'-throwing code: a
 -- doubly-wrapped 'Fatal' is indistinguishable from a crash and would be
 -- restarted instead of escalated.
 supervised :: Text -> Backoff -> IO Void -> IO Void
 supervised name backoff action = go 1
  where
    go attempt = do
      start <- getCurrentTime
      outcome <- (action >> pure (Nothing :: Maybe (Either Fatal SomeException))) `catches`
        [ Handler $ \(f :: Fatal) -> pure (Just (Left f))
        , Handler $ \(e :: SomeException) -> pure (Just (Right e))
        ]
      case outcome of
        Nothing -> error "unreachable: supervised action returned"
        Just (Left f) -> throw f
        Just (Right e) -> do
          putStrLn $ "[" <> T.unpack name <> "] attempt " <> show attempt <> " crashed: " <> displayException e
          let delay = backoffDelay backoff attempt
          putStrLn $ "[" <> T.unpack name <> "] restarting in " <> show delay <> "s"
          threadDelay (round (realToFrac delay * 1000000))
          end <- getCurrentTime
          go (nextAttempt backoff (diffUTCTime end start) attempt)
 ```
 - [ ] **Step 4: Regenerate derivation and run tests**
 Run: `nix run nixpkgs#cabal2nix -- ./. > default.nix && nix develop -c cabal build && nix develop -c cabal test`
 Expected: zero warnings; 15 examples and 1 property, 0 failures.
 - [ ] **Step 5: Commit**
 ```bash
 git add src test home-assistant-controller.cabal default.nix
 git commit -m "Add supervisor with backoff restarts"
 ```
 ---
 ### Task 5: Supervised wiring and fatal auth (completes slice 2)
 **Files:**
 - Modify: `src/HomeAssistant/Runtime.hs` (defaultMain only)
 - Modify: `src/HomeAssistant/Runtime/Connection.hs` (Fatal in handshake)
 **Interfaces:**
 - Consumes: `supervised`, `defaultBackoff`, `Fatal` (Task 4).
 - Produces: no new exports; `defaultMain` behavior changes: workers are supervised, auth failure exits the process with `Fatal`.
 **Background:** `waitAny` rethrows the exception of the first completed async. Supervised workers only complete by rethrowing `Fatal`, so `waitAny` blocks forever in normal operation and propagates `Fatal` otherwise.
 - [ ] **Step 1: Change `defaultMain` in `src/HomeAssistant/Runtime.hs`**
 Update imports: replace `mapConcurrently_` with `async, waitAny` from `Control.Concurrent.Async`; add `absurd` to the `Data.Void` import; add `import HomeAssistant.Runtime.Supervisor (defaultBackoff, supervised)`. Replace `defaultMain` with:
 ```haskell
 defaultMain :: IO ()
 defaultMain = withSocketsDo $ do
  token <- getEnv "HA_TOKEN"
  bus <- newBus 0
  let workers =
        [ ("reader", readerAction "last-resort-redux" 8123 token bus)
        , ("writer", writerAction bus)
        ] ++ [ (name, runController bus c) | c@(Controller name _) <- controllers ]
  as <- mapM (\(name, act) -> async (supervised name defaultBackoff act)) workers
  (_, v) <- waitAny as
  absurd v
 ```
 - [ ] **Step 2: Make handshake failures fatal in `src/HomeAssistant/Runtime/Connection.hs`**
 Add imports: `import HomeAssistant.Runtime.Supervisor (Fatal)` and `throw` from `Control.Exception.Annotated`. Change `expectType` and `receiveJSON`:
 ```haskell
 expectType :: T.Text -> Value -> IO ()
 expectType expected msg =
  case msg ^? key "type" . _String of
    Just t | t == expected -> pure ()
    _ -> throw (Fatal $ "expected " <> expected <> ", got: " <> T.pack (show msg))
 ```
 ```haskell
 receiveJSON :: WS.Connection -> IO Value
 receiveJSON conn = do
  msg <- WS.receiveData conn
  case eitherDecode msg of
    Left err -> throw (Fatal $ "Invalid JSON from Home Assistant: " <> T.pack err)
    Right x  -> pure x
 ```
 The `fail`-based behavior (crash the process) is preserved for slice 1's semantics but now carries a `Fatal` marker the supervisor escalates. Do **not** add checkpoints around the handshake — see the `supervised` contract.
 - [ ] **Step 3: Build and test**
 Run: `nix develop -c cabal build && nix develop -c cabal test`
 Expected: zero warnings, zero test failures.
 - [ ] **Step 4: Manual smoke check (optional, needs real HA)**
 Run: `HA_TOKEN=... nix develop -c cabal run home-assistant-controller` (only if a Home Assistant instance is reachable; otherwise skip — unit tests cover the wiring logic).
 - [ ] **Step 5: Commit**
 ```bash
 git add src
 git commit -m "Supervise workers and make auth failures fatal"
 ```
 ---
 ## Verification (all tasks)
 - `nix develop -c cabal build` — zero warnings under `-Wall`.
 - `nix develop -c cabal test` — all specs green.
 - `git status` clean after each commit.
 ## Non-goals (from spec)
 - Request/response correlation for service calls; dynamic controller registration; structured logging; env-based host/port config; state pre-seeding via `get_states`; multiple websocket connections.
 ## Gaps accepted by spec
 - Reader's connect/auth/subscribe loop has no integration test (thin IO glue over `WS.runClient`; localhost fake-server scaffolding judged not worth the complexity).
 - `Fatal` detection relies on the no-checkpoints-around-handshake invariant (documented in `supervised`'s contract and Task 5).
@@ -1,732 +0,0 @@
 # Module Split & Warning Cleanup Implementation Plan
 > **For agentic workers:** REQUIRED SUB-SKILL: Use superpowers:subagent-driven-development (recommended) or superpowers:executing-plans to implement this plan task-by-task. Steps use checkbox (`- [ ]`) syntax for tracking.
 **Goal:** Split the monolithic `src/MyLib.hs` into three vertically-separated modules and fix all compiler warnings, committing between changes.
 **Architecture:** Three modules: `AFRP` (generic Mealy/Event FRP machinery), `HomeAssistant.Controller` (HA domain: effects, entity parsers, controllers), `HomeAssistant.Runtime` (IO interpreter, websocket client, `defaultMain`). Two commits: mechanical split, then warning fixes.
 **Tech Stack:** Haskell, GHC 9.10.3, cabal, GHC2024 default language
 ## Global Constraints
 - Build tool: `cabal build`
 - GHC 9.10.3, `default-language: GHC2024` (provides `RankNTypes`, `TypeApplications`, `GADTSyntax` — do not re-declare these)
 - Warning baseline: cabal `common warnings` uses `-Wall`; verify with `cabal build --ghc-options="-Wall -Wincomplete-uni-patterns -Wincomplete-record-updates"`
 - No test framework (test suite is a placeholder; testing is out of scope per spec)
 - Commit between every change (user instruction)
 - The only behavioral change: dormant `wsCallService` call is activated inside real `hassEval`, but `app` wires to `dryRunHassEval` to preserve current print-only behavior
 ---
 ## File Structure
 | File | Responsibility | Created/Modified |
 |---|---|---|
 | `src/AFRP.hs` | Generic Mealy/Event FRP machinery — zero HA knowledge | Created in Task 1 |
 | `src/HomeAssistant/Controller.hs` | HA domain: `HASSEff`, `Service`, entity parsers, controllers | Created in Task 1, edited in Task 2 |
 | `src/HomeAssistant/Runtime.hs` | IO interpreter, websocket client, `defaultMain` | Created in Task 1, edited in Task 2 |
 | `src/MyLib.hs` | (deleted) | Deleted in Task 1 |
 | `app/Main.hs` | Entry point; import updated | Modified in Task 1 |
 | `home-assistant-controller.cabal` | `exposed-modules` updated | Modified in Task 1 |
 ---
 ## Task 1: Split MyLib into AFRP, Controller, Runtime
 **Files:**
 - Create: `src/AFRP.hs`
 - Create: `src/HomeAssistant/Controller.hs`
 - Create: `src/HomeAssistant/Runtime.hs`
 - Delete: `src/MyLib.hs`
 - Modify: `app/Main.hs`
 - Modify: `home-assistant-controller.cabal`
 **Interfaces:**
 - `AFRP` produces: `Mealy(..)`, `eff`, `Event(..)`, `hold`, `events`, `switch`, `preMapAccum`, `preMapAccumUTCTime`, `mapAccum`, `mapAccumUTCTime`, `changes`, `whenA`, `filterA`, `thenA`, `(>>|)`, `toEvent`
 - `HomeAssistant.Controller` consumes from `AFRP`: `Mealy`, `eff`, `Event(..)`, `hold`, `events`, `changes`, `mapAccum`, `filterA`, `(>>|)`, `toEvent`
 - `HomeAssistant.Controller` produces: `Service(..)`, `HASSEff(..)`, `HASS`, `callService`, entity helpers, domain types/values, `lightController`
 - `HomeAssistant.Runtime` consumes from `AFRP`: `Mealy(..)`, `Event(..)`; from `HomeAssistant.Controller`: `HASSEff(..)`, `lightController`, `Service(..)`
 - `HomeAssistant.Runtime` produces: `defaultMain`, `app`, `step`, `CallIdGen`, `mkCallIdGen`, `hassEval`, `receiveJSON`, `wsCallService`
 After this task: build succeeds, 6 warnings remain (numericDirection, isEntity, state x2, toBool, conn).
 - [ ] **Step 1: Create `src/AFRP.hs`**
 ```haskell
 {-# LANGUAGE LambdaCase #-}
 module AFRP
  ( Mealy(..)
  , eff
  , Event(..)
  , hold
  , events
  , switch
  , preMapAccum
  , preMapAccumUTCTime
  , mapAccum
  , mapAccumUTCTime
  , changes
  , whenA
  , filterA
  , thenA
  , (>>|)
  , toEvent
  ) where
 import Control.Category (Category(..), (>>>))
 import Prelude hiding ((.), id)
 import Control.Arrow (Arrow(..), ArrowChoice(..), ArrowLoop(..), returnA)
 import Data.Time (UTCTime)
 import Control.Monad.Fix (MonadFix (mfix))
 import Data.Either (fromLeft)
 import Data.Bool (bool)
 newtype Mealy eff a b = Mealy
  { runMealy :: forall m. MonadFix m => (forall x. eff x -> m x) -> UTCTime -> a -> m (b, Mealy eff a b) }
 eff :: (a -> eff b) -> Mealy eff a b
 eff f = Mealy $ \nt _ x ->
  nt (f x) >>= \b -> pure (b, eff f)
 instance Category (Mealy eff) where
  id = Mealy (\_ _ x -> pure (x, id))
  (Mealy f) . (Mealy g) = Mealy $ \nt t a -> do
    (b, g') <- g nt t a
    (c, f') <- f nt t b
    pure (c, f' . g')
 instance Arrow (Mealy eff) where
  arr f = Mealy $ \_ _ b -> pure (f b, arr f)
  first (Mealy f) = Mealy $ \nt t (b,d) -> do
    (c, f') <- f nt t b
    pure ((c, d), first f')
 instance ArrowChoice (Mealy eff) where
  left (Mealy f) = Mealy $ \nt t -> \case
    Left b -> do
      (c, f') <- f nt t b
      pure (Left c, left f')
    Right d -> pure (Right d, left (Mealy f))
 instance ArrowLoop (Mealy eff) where
  loop (Mealy f) = Mealy $ \nt t b -> do
    ((c,_), f') <- mfix $ \((_,d), _) -> f nt t (b,d)
    pure (c, loop f')
 instance Functor (Mealy eff a) where
  fmap f (Mealy g) = Mealy $ \nt t a -> do
    (b, g') <- g nt t a
    pure (f b, fmap f g')
 instance Applicative (Mealy eff a) where
  pure b = Mealy $ \_ _ _ -> pure (b, pure b)
  Mealy f <*> Mealy x = Mealy $ \nt t a -> do
    (f', fNext) <- f nt t a
    (x', xNext) <- x nt t a
    pure (f' x', fNext <*> xNext)
 data Event a
  = Tick
  | Event a
  deriving (Show, Functor, Foldable, Traversable)
 hold :: a -> Mealy eff (Event a) a
 hold a = Mealy $ \_ _ -> \case
  Tick -> pure (a, hold a)
  Event a' -> pure (a', hold a')
 events :: Mealy eff (Event a) (Either () a)
 events = arr $ \case
  Tick -> Left ()
  Event a -> Right a
 switch :: Mealy eff a (b, Event c) -> (c -> Mealy eff a b) -> Mealy eff a b
 switch (Mealy f) s = Mealy $ \nt t a -> do
  ((b, ev), f') <- f nt t a
  case ev of
          Tick -> pure (b, switch f' s)
          Event x -> runMealy (s x) nt t a
 preMapAccum :: (x -> a -> x) -> x -> (x -> b) -> Mealy eff a b
 preMapAccum f x extract = go x
  where
    go b = Mealy $ \_ _ a ->
      let next = f b a
      in pure (extract b, go next)
 preMapAccumUTCTime :: (UTCTime -> x -> a -> x) -> x -> (x -> b) -> Mealy eff a b
 preMapAccumUTCTime f x extract = go x
  where
    go b = Mealy $ \_ t a ->
      let next = f t b a
      in pure (extract b, go next)
 mapAccum :: (x -> a -> x) -> x -> (x -> b) -> Mealy eff a b
 mapAccum f x extract = go x
  where
    go b = Mealy $ \_ _ a ->
      let next = f b a
      in pure (extract next, go next)
 mapAccumUTCTime :: (UTCTime -> x -> a -> x) -> x -> (x -> b) -> Mealy eff a b
 mapAccumUTCTime f x extract = go x
  where
    go b = Mealy $ \_ t a ->
      let next = f t b a
      in pure (extract next, go next)
 changes :: Eq a => Mealy eff a (Event a)
 changes = mapAccum go Nothing (maybe Tick snd)
  where
    go :: Eq a => Maybe (a, Event a) -> a -> Maybe (a, Event a)
    -- The first observed value is not a change I think
    go Nothing x = Just (x, Tick)
    go (Just (y, _)) x | x == y = Just (x, Tick)
                       | otherwise = Just (x, Event x)
 whenA :: (a -> Bool) -> Mealy eff a () -> Mealy eff a ()
 whenA predicate auto = arr (\a -> if predicate a then Left a else Right ()) >>> left auto >>> arr (fromLeft ())
 filterA :: (a -> Bool) -> Mealy eff a (Either () a)
 filterA f = arr $ \a -> bool (Left ()) (Right a) (f a)
 thenA :: (ArrowChoice cat, Arrow cat) => cat a (Either b1 c) -> cat c (Either b1 b2) -> cat a (Either b1 b2)
 thenA f g = f >>> arr Left ||| g
 (>>|) :: (ArrowChoice cat, Arrow cat) => cat a (Either b1 c) -> cat c (Either b1 b2) -> cat a (Either b1 b2)
 (>>|) = thenA
 infixl 1 >>|
 toEvent :: Mealy eff (Either () a) (Event a)
 toEvent = arr (either (const Tick) Event)
 ```
 - [ ] **Step 2: Create the `src/HomeAssistant/` directory**
 Run: `mkdir -p src/HomeAssistant`
 - [ ] **Step 3: Create `src/HomeAssistant/Controller.hs`**
 Note: This is the Task 1 version — it still contains `numericDirection`, dead `where` clauses, and non-exhaustive `toBool`. Those are fixed in Task 2.
 ```haskell
 {-# LANGUAGE Arrows #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE GADTs #-}
 module HomeAssistant.Controller
  ( Service(..)
  , HASSEff(..)
  , HASS
  , callService
  , entityChangeEvent
  , entityChangeEvent'
  , entityRead
  , entityRead'
  , entityBool
  , entityBool'
  , Ruuvi(..)
  , ruuvi
  , ruuviTemperatures
  , ruuviPressures
  , DoorState(..)
  , door
  , light
  , lightController
  ) where
 import AFRP (Mealy, eff, Event(..), hold, events, changes, mapAccum, filterA, (>>|), toEvent)
 import Control.Arrow (Arrow(..), ArrowChoice(..), returnA)
 import Control.Category ((>>>))
 import Data.Aeson (Value)
 import qualified Data.Text as T
 import Control.Lens (has, only, (^?), to)
 import Data.Aeson.Lens (key, _String)
 import qualified Data.Text.Lens as TL
 import Data.Bool (bool)
 data Service = Service
  { serviceDomain :: T.Text
  , serviceName :: T.Text
  , serviceData :: Maybe Value
  , serviceTarget :: T.Text
  }
  deriving Show
 data HASSEff a where
  CallService :: Service -> HASSEff ()
  Pure :: a -> HASSEff a
 type HASS a b = Mealy HASSEff a b
 callService :: Service -> HASS a ()
 callService service = eff (\_ -> CallService service)
 ruuviTemperatures :: Mealy eff (Event Value) Double
 ruuviTemperatures = entityRead @Double "sensor.ruuvitag_b168_temperature" >>> hold 0
 ruuviPressures :: Mealy eff (Event Value) Double
 ruuviPressures = entityRead "sensor.ruuvitag_b168_pressure" >>> hold 0
 data Ruuvi = Ruuvi { ruuviTemperature :: Double, ruuviPressure :: Double }
           deriving (Show, Eq)
 ruuvi :: Mealy eff (Event Value) (Event Ruuvi)
 ruuvi = (Ruuvi <$> ruuviTemperatures <*> ruuviPressures) >>> changes
 data Direction = Increase | Decrease | Steady
  deriving (Show, Eq)
 numericDirection = mapAccum go (Nothing, Nothing) extract
  where
    go (_, old) new = (old, new)
    extract :: (Maybe Double, Maybe Double) -> Direction
    extract (old, new) = maybe Steady (\x -> if x >  0 then Increase else Decrease) $ (-) <$> old <*> new
 data DoorState = Open | Closed
  deriving (Show, Eq)
 door :: HASS (Event Value) (Event DoorState)
 door = entityBool "binary_sensor.makuuhuone_ovi_contact"
  >>> arr (fmap (bool Closed Open))
  >>> hold Open
  >>> changes
 -- Turn off lights when door is closed
 light :: Bool -> Service
 light b = Service
  { serviceDomain="light"
  , serviceName= bool "turn_off" "turn_on" b
  , serviceData=Nothing
  , serviceTarget="light.bedroom_masse"
  }
 lightController :: HASS (Event Value) (Event DoorState)
 lightController = proc ev -> do
  doorState <- door -< ev
  case doorState of
       Event Open -> callService (light False) -< ()
       Event Closed -> callService (light True) -< ()
       _ -> returnA -< ()
  returnA -< doorState
 entityChangeEvent :: T.Text -> Mealy eff (Event Value) (Event Value)
 entityChangeEvent entityId = entityChangeEvent' entityId >>> toEvent
  where
    isEntity :: Value -> Bool
    isEntity = has (key "event" . key "data" . key "entity_id" . _String . only entityId)
 entityChangeEvent' :: T.Text -> Mealy eff (Event Value) (Either () Value)
 entityChangeEvent' entityId = events >>| filterA isEntity
  where
    isEntity :: Value -> Bool
    isEntity = has (key "event" . key "data" . key "entity_id" . _String . only entityId)
 entityRead' :: (Read a) => T.Text -> Mealy eff (Event Value) (Either () a)
 entityRead' entityId = entityChangeEvent' entityId >>| (arr state >>> arr (maybe (Left ()) Right))
  where
    state v = v ^? key "event" . key "data" . key "new_state" . key "state" . _String . TL.unpacked . to read
 entityBool' :: T.Text -> Mealy eff (Event Value) (Either () Bool)
 entityBool' entityId = entityChangeEvent' entityId >>| (arr state >>> arr (maybe (Left ()) Right))
  where
    state v = v ^? key "event" . key "data" . key "new_state" . key "state" . _String . TL.unpacked . to toBool
    toBool = \case
      "on" -> True
      "off" -> False
 entityRead :: (Read a) => T.Text -> Mealy eff (Event Value) (Event a)
 entityRead entityId = entityRead' entityId >>> toEvent
  where
    state v = v ^? key "event" . key "data" . key "new_state" . key "state" . _String . TL.unpacked . to read
 entityBool :: T.Text -> Mealy eff (Event Value) (Event Bool)
 entityBool entityId = entityBool' entityId >>> toEvent
  where
    state v = v ^? key "event" . key "data" . key "new_state" . key "state" . _String . TL.unpacked . to read
 ```
 - [ ] **Step 4: Create `src/HomeAssistant/Runtime.hs`**
 Note: This is the Task 1 version — `hassEval` still has the commented-out `wsCallService` call and `conn` is unused. `dryRunHassEval` does not exist yet. Both are addressed in Task 2.
 ```haskell
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE GADTs #-}
 module HomeAssistant.Runtime
  ( defaultMain
  , app
  , step
  , CallIdGen
  , mkCallIdGen
  , hassEval
  , receiveJSON
  , wsCallService
  ) where
 import AFRP (Mealy(..), Event(..))
 import HomeAssistant.Controller (HASSEff(..), lightController, Service(..))
 import Data.Aeson ((.=), Value (Null), encode, eitherDecode, object)
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.Text as T
 import qualified Network.WebSockets as WS
 import Network.Socket (withSocketsDo)
 import System.Environment (getEnv)
 import Data.Time (UTCTime, getCurrentTime)
 import Data.IORef (newIORef, atomicModifyIORef')
 step :: (forall x. eff x -> IO x) -> Mealy eff a b -> a -> IO (b, Mealy eff a b)
 step nt (Mealy f) a = do
  now <- getCurrentTime
  f nt now a
 defaultMain :: IO ()
 defaultMain = withSocketsDo $ do
    token <- getEnv "HA_TOKEN"
    gen <- mkCallIdGen 0
    WS.runClient "last-resort-redux" 8123 "/api/websocket" (app gen token)
 app :: CallIdGen -> String -> WS.ClientApp ()
 app gen token conn = do
    -- HA speaks first: {"type":"auth_required", ...}
    authRequired <- receiveJSON conn
    print authRequired
    WS.sendTextData conn $ encode $ object
        [ "type"         .= ("auth" :: T.Text)
        , "access_token" .= token
        ]
    -- Expect {"type":"auth_ok", ...}
    authResult <- receiveJSON conn
    print authResult
    getStateId <- generateCallId gen
    WS.sendTextData conn $ encode $ object
      [ "id" .= getStateId
      , "type" .= ("get_states" :: T.Text)
      ]
    msg <- WS.receiveData conn :: IO BL.ByteString
    BL.writeFile "/tmp/states.json" msg
    subscribeId <- generateCallId gen
    -- Subscription 1: all entity state changes
    WS.sendTextData conn $ encode $ object
        [ "id"         .= subscribeId
        , "type"       .= ("subscribe_events" :: T.Text)
        , "event_type" .= ("state_changed" :: T.Text)
        ]
    go lightController
  where
    go f = do
      msg <- WS.receiveData conn :: IO BL.ByteString
      let decoded = Event $ either (const Null) id $ eitherDecode @Value msg
      (x, f') <- step (hassEval gen conn) f decoded
      mapM_ print x
      go f'
 receiveJSON :: WS.Connection -> IO Value
 receiveJSON conn = do
    msg <- WS.receiveData conn
    case eitherDecode msg of
        Left err -> fail $ "Invalid JSON from Home Assistant: " ++ err
        Right x  -> pure x
 wsCallService
  :: WS.Connection
  -> Int
  -> T.Text
  -> T.Text
  -> T.Text
  -> IO ()
 wsCallService conn requestId domain service entityId =
  WS.sendTextData conn $ encode $ object
    [ "id"      .= requestId
    , "type"    .= ("call_service" :: T.Text)
    , "domain"  .= domain
    , "service" .= service
    , "target"  .= object
        [ "entity_id" .= entityId
        ]
    ]
 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))
 hassEval :: CallIdGen -> WS.Connection -> HASSEff a -> IO a
 hassEval gen conn = \case
  CallService x -> do
    callId <- generateCallId gen
    print (callId, x)
    -- wsCallService conn callId (serviceDomain x) (serviceName x) (serviceTarget x)
  Pure a -> pure a
 ```
 - [ ] **Step 5: Delete `src/MyLib.hs`**
 Run: `git rm src/MyLib.hs`
 - [ ] **Step 6: Update `app/Main.hs`**
 Replace the entire file content with:
 ```haskell
 module Main (main) where
 import qualified HomeAssistant.Runtime (defaultMain)
 main :: IO ()
 main = do
  putStrLn "Hello, Haskell!"
  HomeAssistant.Runtime.defaultMain
 ```
 - [ ] **Step 7: Update `home-assistant-controller.cabal`**
 In the `library` section, replace:
 ```
    exposed-modules:  MyLib
 ```
 with:
 ```
    exposed-modules:  AFRP
                    , HomeAssistant.Controller
                    , HomeAssistant.Runtime
 ```
 - [ ] **Step 8: Build to verify it compiles**
 Run: `cabal build`
 Expected: Build succeeds. Warnings appear for: `numericDirection`, `isEntity`, `state` (x2), `toBool` (non-exhaustive), `conn` (unused match). The `entityChangeEvent`, `entityRead'`, `entityRead`, and `wsCallService` warnings are resolved by the export lists.
 If the build fails, read the error, fix the issue, and rebuild before proceeding.
 - [ ] **Step 9: Commit**
 ```bash
 git add src/AFRP.hs src/HomeAssistant/Controller.hs src/HomeAssistant/Runtime.hs app/Main.hs home-assistant-controller.cabal
 git commit -m "Split MyLib into AFRP, Controller, Runtime"
 ```
 ---
 ## Task 2: Fix warnings
 **Files:**
 - Modify: `src/HomeAssistant/Controller.hs`
 - Modify: `src/HomeAssistant/Runtime.hs`
 **Interfaces:**
 - `HomeAssistant.Runtime` new export: `dryRunHassEval :: CallIdGen -> HASSEff a -> IO a`
 - `HomeAssistant.Runtime` changed export list: add `dryRunHassEval`
 After this task: `cabal build --ghc-options="-Wall -Wincomplete-uni-patterns -Wincomplete-record-updates"` produces zero warnings.
 - [ ] **Step 1: Delete `Direction` and `numericDirection` from `Controller.hs`**
 Remove these lines from `src/HomeAssistant/Controller.hs`:
 ```haskell
 data Direction = Increase | Decrease | Steady
  deriving (Show, Eq)
 numericDirection = mapAccum go (Nothing, Nothing) extract
  where
    go (_, old) new = (old, new)
    extract :: (Maybe Double, Maybe Double) -> Direction
    extract (old, new) = maybe Steady (\x -> if x >  0 then Increase else Decrease) $ (-) <$> old <*> new
 ```
 - [ ] **Step 2: Remove `mapAccum` from the AFRP import in `Controller.hs`**
 In `src/HomeAssistant/Controller.hs`, change:
 ```haskell
 import AFRP (Mealy, eff, Event(..), hold, events, changes, mapAccum, filterA, (>>|), toEvent)
 ```
 to:
 ```haskell
 import AFRP (Mealy, eff, Event(..), hold, events, changes, filterA, (>>|), toEvent)
 ```
 - [ ] **Step 3: Delete dead `isEntity` from `entityChangeEvent` in `Controller.hs`**
 Change:
 ```haskell
 entityChangeEvent :: T.Text -> Mealy eff (Event Value) (Event Value)
 entityChangeEvent entityId = entityChangeEvent' entityId >>> toEvent
  where
    isEntity :: Value -> Bool
    isEntity = has (key "event" . key "data" . key "entity_id" . _String . only entityId)
 ```
 to:
 ```haskell
 entityChangeEvent :: T.Text -> Mealy eff (Event Value) (Event Value)
 entityChangeEvent entityId = entityChangeEvent' entityId >>> toEvent
 ```
 - [ ] **Step 4: Delete dead `state` from `entityRead` in `Controller.hs`**
 Change:
 ```haskell
 entityRead :: (Read a) => T.Text -> Mealy eff (Event Value) (Event a)
 entityRead entityId = entityRead' entityId >>> toEvent
  where
    state v = v ^? key "event" . key "data" . key "new_state" . key "state" . _String . TL.unpacked . to read
 ```
 to:
 ```haskell
 entityRead :: (Read a) => T.Text -> Mealy eff (Event Value) (Event a)
 entityRead entityId = entityRead' entityId >>> toEvent
 ```
 - [ ] **Step 5: Delete dead `state` from `entityBool` in `Controller.hs`**
 Change:
 ```haskell
 entityBool :: T.Text -> Mealy eff (Event Value) (Event Bool)
 entityBool entityId = entityBool' entityId >>> toEvent
  where
    state v = v ^? key "event" . key "data" . key "new_state" . key "state" . _String . TL.unpacked . to read
 ```
 to:
 ```haskell
 entityBool :: T.Text -> Mealy eff (Event Value) (Event Bool)
 entityBool entityId = entityBool' entityId >>> toEvent
 ```
 - [ ] **Step 6: Add catch-all to `toBool` in `entityBool'` in `Controller.hs`**
 Change:
 ```haskell
    toBool = \case
      "on" -> True
      "off" -> False
 ```
 to:
 ```haskell
    toBool = \case
      "on" -> True
      "off" -> False
      _ -> False
 ```
 - [ ] **Step 7: Add `dryRunHassEval` and fix `hassEval` in `Runtime.hs`**
 In `src/HomeAssistant/Runtime.hs`, change:
 ```haskell
 hassEval :: CallIdGen -> WS.Connection -> HASSEff a -> IO a
 hassEval gen conn = \case
  CallService x -> do
    callId <- generateCallId gen
    print (callId, x)
    -- wsCallService conn callId (serviceDomain x) (serviceName x) (serviceTarget x)
  Pure a -> pure a
 ```
 to:
 ```haskell
 hassEval :: CallIdGen -> WS.Connection -> HASSEff a -> IO a
 hassEval gen conn = \case
  CallService x -> do
    callId <- generateCallId gen
    wsCallService conn callId (serviceDomain x) (serviceName x) (serviceTarget x)
  Pure a -> pure a
 dryRunHassEval :: CallIdGen -> HASSEff a -> IO a
 dryRunHassEval gen = \case
  CallService x -> do
    callId <- generateCallId gen
    print (callId, x)
  Pure a -> pure a
 ```
 - [ ] **Step 8: Add `dryRunHassEval` to the export list in `Runtime.hs`**
 In `src/HomeAssistant/Runtime.hs`, change:
 ```haskell
 module HomeAssistant.Runtime
  ( defaultMain
  , app
  , step
  , CallIdGen
  , mkCallIdGen
  , hassEval
  , receiveJSON
  , wsCallService
  ) where
 ```
 to:
 ```haskell
 module HomeAssistant.Runtime
  ( defaultMain
  , app
  , step
  , CallIdGen
  , mkCallIdGen
  , hassEval
  , dryRunHassEval
  , receiveJSON
  , wsCallService
  ) where
 ```
 - [ ] **Step 9: Wire `app` to use `dryRunHassEval` in `Runtime.hs`**
 In `src/HomeAssistant/Runtime.hs`, inside the `go` function in `app`, change:
 ```haskell
      (x, f') <- step (hassEval gen conn) f decoded
 ```
 to:
 ```haskell
      (x, f') <- step (dryRunHassEval gen) f decoded
 ```
 - [ ] **Step 10: Build with full warning flags to verify zero warnings**
 Run: `cabal build --ghc-options="-Wall -Wincomplete-uni-patterns -Wincomplete-record-updates"`
 Expected: Build succeeds with zero warnings. If any warnings remain, read them, fix, and rebuild.
 - [ ] **Step 11: Commit**
 ```bash
 git add src/HomeAssistant/Controller.hs src/HomeAssistant/Runtime.hs
 git commit -m "Fix warnings"
 ```
@@ -1,750 +0,0 @@
 # katip logging Implementation Plan
 > **For agentic workers:** REQUIRED SUB-SKILL: Use superpowers:subagent-driven-development (recommended) or superpowers:executing-plans to implement this plan task-by-task. Steps use checkbox (`- [ ]`) syntax for tracking.
 **Goal:** Replace all `print`/`putStrLn` logging under `src/` with katip structured logging, threading a `LogEnv` through the existing `Bus`-based runtime.
 **Architecture:** Approach A — `Bus` gains a `busLogEnv :: LogEnv` field; `defaultMain` builds the `LogEnv` (one stdout scribe, bracketed `closeScribes`) and passes it to `newBus`. The `HASSEff` interpreters (`dryRunHassEval`, `channelHassEval`) gain the controller name as a 2nd arg and log via `runKatipT`. `supervised` gains a leading `LogEnv`. The AFRP layer and controller definitions are untouched.
 **Tech Stack:** Haskell (GHC2024), cabal, nix devShell, katip 0.8.8.4 (in nixpkgs), hspec/hedgehog.
 ## Global Constraints
 - Build always via the nix devShell: `nix develop -c cabal build`.
 - Tests always via the nix devShell: `nix develop -c cabal test`.
 - After any edit to `home-assistant-controller.cabal`, regenerate `default.nix` with `nix run nixpkgs#cabal2nix -- ./. > default.nix` — never hand-edit `default.nix` (AGENTS.md).
 - `secrets.yaml` is sops-encrypted — never read, print, or commit its contents.
 - Code style: vertical modules, minimal comments describing contracts not implementation (AGENTS.md). No comments unless asked.
 - `app/Main.hs` is outside `src/` and is NOT modified.
 - AFRP layer (`AFRP.hs`) and controller definitions (`Controller.hs`, `Controller/Bedroom.hs`) remain logging-free.
 - `-Wall` is on (cabal `common warnings`); all code must compile without warnings (no unused bindings).
 ---
 ## File Structure
 | File | Responsibility | Change |
 |------|---------------|--------|
 | `home-assistant-controller.cabal` | build config | add `katip` to library + test `build-depends`; add `Support` to test `other-modules` |
 | `default.nix` | generated cabal derivation | regenerated by cabal2nix (twice) |
 | `src/HomeAssistant/Runtime/Bus.hs` | `Bus`, `newBus`, `channelHassEval` | add `busLogEnv`; `newBus :: LogEnv -> Int -> IO Bus`; `channelHassEval :: Bus -> Text -> ...` with katip |
 | `src/HomeAssistant/Runtime.hs` | `defaultMain`, `runController`, `dryRunHassEval` | build `LogEnv` + bracket; thread controller `name`; `dryRunHassEval :: Bus -> Text -> ...` with katip |
 | `src/HomeAssistant/Runtime/Supervisor.hs` | `supervised` | `supervised :: LogEnv -> Text -> Backoff -> IO Void -> IO Void` with katip |
 | `src/HomeAssistant/Runtime/Connection.hs` | reader/writer workers | two `putStrLn` → `logMsg` |
 | `test/Support.hs` | test helpers (new) | `silentLogEnv :: IO LogEnv` |
 | `test/BusSpec.hs` | bus tests | pass `silentLogEnv`, add name arg |
 | `test/RuntimeSpec.hs` | runtime tests | pass `silentLogEnv` |
 | `test/SupervisorSpec.hs` | supervisor tests | pass `silentLogEnv`, add `LogEnv` arg (3 sites) |
 No new modules under `src/`. No changes to `AFRP.hs`, `Controller.hs`, `Controller/Bedroom.hs`, `ConnectionSpec.hs`, `BackoffProp.hs`, `app/Main.hs`.
 ---
 ### Task 1: Add katip dependency
 **Files:**
 - Modify: `home-assistant-controller.cabal` (library `build-depends` ~line 77-89, test-suite `build-depends` ~line 149-160)
 - Regenerate: `default.nix`
 **Interfaces:**
 - Consumes: nothing
 - Produces: `katip` available to library and test-suite; `default.nix` lists `katip` in `libraryHaskellDepends` and `testHaskellDepends`
 - [ ] **Step 1: Add katip to library build-depends**
 In `home-assistant-controller.cabal`, in the `library` stanza's `build-depends` (after `uuid`), add `, katip`. The library block becomes:
 ```
    build-depends:    base ^>=4.20.2.0
                    , websockets
                    , aeson
                    , lens-aeson
                    , lens
                    , text
                    , network
                    , bytestring
                    , time
                    , stm
                    , async
                    , annotated-exception
                    , uuid
                    , katip
 ```
 - [ ] **Step 2: Add katip to test-suite build-depends**
 In the `test-suite home-assistant-controller-test` stanza's `build-depends` (after `time`), add `, katip`:
 ```
    build-depends:
        base ^>=4.20.2.0,
        home-assistant-controller,
        hspec,
        stm,
        aeson,
        text,
        async,
        hedgehog,
        hspec-hedgehog,
        annotated-exception,
        time,
        katip
 ```
 - [ ] **Step 3: Regenerate default.nix**
 Run:
 ```bash
 nix run nixpkgs#cabal2nix -- ./. > default.nix
 ```
 Expected: `default.nix` now lists `katip` in `libraryHaskellDepends` and `testHaskellDepends`. Verify with:
 ```bash
 grep katip default.nix
 ```
 Expected output: two lines mentioning `katip`.
 - [ ] **Step 4: Build to verify the dependency resolves**
 Run:
 ```bash
 nix develop -c cabal build
 ```
 Expected: builds successfully (no code uses katip yet, so no compile errors). If nix needs to build katip first this may take a while on the first run.
 - [ ] **Step 5: Commit**
 ```bash
 git add home-assistant-controller.cabal default.nix
 git commit -m "Add katip dependency"
 ```
 ---
 ### Task 2: Add busLogEnv to Bus; newBus signature; silentLogEnv helper; update callers
 This task adds the `LogEnv` field to `Bus`, changes `newBus` to take `LogEnv`, adds a silent test helper, and updates every `newBus` caller so the build compiles. No logging behavior changes yet (the interpreters still `print`; they switch in Task 3).
 **Files:**
 - Modify: `src/HomeAssistant/Runtime/Bus.hs` (full file)
 - Modify: `src/HomeAssistant/Runtime.hs` (`defaultMain` ~line 62-72)
 - Modify: `home-assistant-controller.cabal` (test `other-modules` ~line 130)
 - Regenerate: `default.nix`
 - Create: `test/Support.hs`
 - Modify: `test/BusSpec.hs` (~line 19)
 - Modify: `test/RuntimeSpec.hs` (~line 17)
 **Interfaces:**
 - Consumes: `katip` (`LogEnv`, `initLogEnv`) from Task 1
 - Produces:
  - `Bus` has field `busLogEnv :: LogEnv`
  - `newBus :: LogEnv -> Int -> IO Bus`
  - `Support.silentLogEnv :: IO LogEnv`
 - [ ] **Step 1: Add busLogEnv field and update newBus in Bus.hs**
 In `src/HomeAssistant/Runtime/Bus.hs`, add imports and the field. The full updated file:
 ```haskell
 {-# 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 Katip (LogEnv)
 import Network.WebSockets (Connection)
 -- | Shared runtime state: inbound is a broadcast channel (controllers
 -- 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
  , busOutbound :: TChan Service
  , busConn     :: TVar (Maybe Connection)
  , busGen      :: CallIdGen
  , busLogEnv   :: LogEnv
  }
 newBus :: LogEnv -> Int -> IO Bus
 newBus le start = Bus
  <$> newBroadcastTChanIO
  <*> newTChanIO
  <*> newTVarIO Nothing
  <*> mkCallIdGen start
  <*> pure le
 channelHassEval :: Bus -> HASSEff a -> IO a
 channelHassEval bus = \case
  CallService svc -> atomically $ writeTChan (busOutbound bus) svc
  Debug x -> print x
  Trace req x -> print (req, x)
 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))
 ```
 Note: `channelHassEval` still uses `print` here — it is converted in Task 3. Keeping it temporarily so this task compiles. `Data.Text (Text)` is NOT imported yet (it would be unused here, triggering `-Wall`); Task 3 adds it when the signature gains the `Text` name parameter.
 - [ ] **Step 2: Update defaultMain to build a LogEnv and pass to newBus**
 In `src/HomeAssistant/Runtime.hs`, update imports and `defaultMain`. Add these imports near the top (with the other imports):
 ```haskell
 import Control.Exception (bracket)
 import Katip
  ( ColorStrategy (ColorIfTerminal)
  , Severity (DebugS)
  , Verbosity (V2)
  , closeScribes
  , defaultScribeSettings
  , initLogEnv
  , mkHandleScribe
  , permitItem
  , registerScribe
  )
 import System.IO (stdout)
 ```
 Then replace `defaultMain` with:
 ```haskell
 defaultMain :: IO ()
 defaultMain = withSocketsDo $ do
  scribe <- mkHandleScribe ColorIfTerminal stdout (permitItem DebugS) V2
  le <- registerScribe "stdout" scribe defaultScribeSettings
        =<< initLogEnv "home-assistant-controller" "production"
  bracket (pure le) closeScribes $ \le' -> do
    token <- getEnv "HA_TOKEN"
    bus <- newBus le' 0
    let workers =
          [ ("reader", readerAction "last-resort-redux" 8123 token bus)
          , ("writer", writerAction bus)
          ] ++ [ (name, runController bus c) | c@(Controller name _) <- controllers ]
    as <- mapM (\(name, act) -> async (supervised name defaultBackoff act)) workers
    (_, v) <- waitAny as
    absurd v
 ```
 Note: `supervised` still has its 3-arg signature here — it is updated in Task 4. The `Controller name _` pattern (was `_name`) is required now so the workers list can use `name`; this is safe since `Controller`'s first field is already `T.Text`. `mkHandleScribe`, `ColorIfTerminal`, `permitItem`, and `V2` are all re-exported by the main `Katip` module, so no separate `Katip.Scribes.Handle` import is needed.
 - [ ] **Step 3: Create test/Support.hs with silentLogEnv**
 Create `test/Support.hs`:
 ```haskell
 module Support
  ( silentLogEnv
  ) where
 import Katip (LogEnv, initLogEnv)
 -- | A LogEnv with no scribes: all log calls are no-ops. For tests that
 -- must construct a Bus or call supervised without spewing output.
 silentLogEnv :: IO LogEnv
 silentLogEnv = initLogEnv "home-assistant-controller" "test"
 ```
 - [ ] **Step 4: Add Support to test-suite other-modules in cabal**
 In `home-assistant-controller.cabal`, in the test-suite's `other-modules` (currently lists `BusSpec`, `ConnectionSpec`, `RuntimeSpec`, `SupervisorSpec`, `BackoffProp`), add `, Support`:
 ```
    other-modules:    BusSpec
                    , ConnectionSpec
                    , RuntimeSpec
                    , SupervisorSpec
                    , BackoffProp
                    , Support
 ```
 - [ ] **Step 5: Regenerate default.nix**
 Run:
 ```bash
 nix run nixpkgs#cabal2nix -- ./. > default.nix
 ```
 Expected: `default.nix` regenerated; `katip` still present, `Support` is not listed (test modules aren't in the derivation) — this is fine.
 - [ ] **Step 6: Update BusSpec to use silentLogEnv**
 In `test/BusSpec.hs`, add the import and update the two `newBus 0` calls. Add to imports:
 ```haskell
 import Support (silentLogEnv)
 ```
 Replace each `bus <- newBus 0` with:
 ```haskell
    le <- silentLogEnv
    bus <- newBus le 0
 ```
 There are two occurrences (lines ~19 and ~30). The `channelHassEval bus (CallService svc)` call on ~line 32 is unchanged in this task (Task 3 adds the name arg).
 - [ ] **Step 7: Update RuntimeSpec to use silentLogEnv**
 In `test/RuntimeSpec.hs`, add the import:
 ```haskell
 import Support (silentLogEnv)
 ```
 Replace `bus <- newBus 0` (line ~17) with:
 ```haskell
    le <- silentLogEnv
    bus <- newBus le 0
 ```
 - [ ] **Step 8: Build and run tests to verify green**
 Run:
 ```bash
 nix develop -c cabal build && nix develop -c cabal test
 ```
 Expected: builds with no warnings (the `print` in `channelHassEval` is still used, so no unused-binding warning); all tests pass.
 - [ ] **Step 9: Commit**
 ```bash
 git add src/HomeAssistant/Runtime/Bus.hs src/HomeAssistant/Runtime.hs test/Support.hs test/BusSpec.hs test/RuntimeSpec.hs home-assistant-controller.cabal default.nix
 git commit -m "Add busLogEnv to Bus, silentLogEnv test helper"
 ```
 ---
 ### Task 3: Convert HASSEff interpreters to katip; thread controller name
 Both interpreters gain the controller name (`Text`) as the 2nd arg and log via `runKatipT` + `logMsg`/`logF`. `runController` threads the `Controller` name into the active interpreter call. `Debug`/`Trace` use the controller name as the namespace; `Trace` logs `requestTraceId` as a structured field.
 **Files:**
 - Modify: `src/HomeAssistant/Runtime/Bus.hs` (`channelHassEval`)
 - Modify: `src/HomeAssistant/Runtime.hs` (`dryRunHassEval`, `runController`, imports)
 - Modify: `test/BusSpec.hs` (`channelHassEval` call)
 **Interfaces:**
 - Consumes: `busLogEnv :: LogEnv` from Task 2
 - Produces:
  - `channelHassEval :: Bus -> Text -> HASSEff a -> IO a`
  - `dryRunHassEval :: Bus -> Text -> HASSEff a -> IO a`
  - `runController` passes the controller name to the interpreter
 - [ ] **Step 1: Convert channelHassEval to katip in Bus.hs**
 In `src/HomeAssistant/Runtime/Bus.hs`, update imports and `channelHassEval`. First add `OverloadedStrings` to the pragmas at the top of the file (needed so the `"traceId"` literal in `sl` is `Text`):
 ```haskell
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 ```
 Replace the `import Katip (LogEnv)` line with:
 ```haskell
 import AFRP (Request (requestTraceId))
 import Data.Text (Text)
 import Data.UUID (toText)
 import Katip
  ( LogEnv
  , Namespace (Namespace)
  , Severity (DebugS)
  , logF
  , logMsg
  , runKatipT
  , showLS
  , sl
  )
 ```
 Replace the `channelHassEval` definition with:
 ```haskell
 channelHassEval :: Bus -> Text -> HASSEff a -> IO a
 channelHassEval bus name = \case
  CallService svc -> atomically $ writeTChan (busOutbound bus) svc
  Debug x -> runKatipT (busLogEnv bus) $
    logMsg (Namespace [name]) DebugS (showLS x)
  Trace req x -> runKatipT (busLogEnv bus) $
    logF (sl "traceId" (toText (requestTraceId req))) (Namespace [name]) DebugS (showLS x)
 ```
 `Trace req x` binds `req :: Request` (from `HASSEff`'s `Trace` constructor, imported via `HASSEff (..)`); `requestTraceId` is the record field brought into scope by `import AFRP (Request (requestTraceId))`. `toText :: UUID -> Text` (aeson's `ToJSON Text` makes `sl` happy). `UUID`'s `ToJSON` would also work directly, but `toText` is used consistently with `Runtime.hs` per the spec.
 - [ ] **Step 2: Convert dryRunHassEval to katip in Runtime.hs**
 In `src/HomeAssistant/Runtime.hs`, update imports. Extend the `Data.UUID` import to include `toText`:
 ```haskell
 import Data.UUID (UUID, toText)
 ```
 Add to the `Katip` import list (from Task 2) the logging functions. The full `Katip` import for `Runtime.hs` becomes:
 ```haskell
 import Katip
  ( ColorStrategy (ColorIfTerminal)
  , Namespace (Namespace)
  , Severity (DebugS)
  , Verbosity (V2)
  , closeScribes
  , defaultScribeSettings
  , initLogEnv
  , logF
  , logMsg
  , mkHandleScribe
  , permitItem
  , registerScribe
  , runKatipT
  , showLS
  , sl
  )
 ```
 Replace `dryRunHassEval` with:
 ```haskell
 dryRunHassEval :: Bus -> T.Text -> HASSEff a -> IO a
 dryRunHassEval bus name = \case
  CallService svc -> do
    callId <- generateCallId (busGen bus)
    runKatipT (busLogEnv bus) $
      logF (sl "callId" callId) (Namespace [name]) DebugS (showLS svc)
  Debug x -> runKatipT (busLogEnv bus) $
    logMsg (Namespace [name]) DebugS (showLS x)
  Trace req x -> runKatipT (busLogEnv bus) $
    logF (sl "traceId" (toText (requestTraceId req))) (Namespace [name]) DebugS (showLS x)
 ```
 Note: the `callId` is logged as a structured field (keeping `generateCallId` meaningful under `-Wall` — a small refinement over the spec's `logMsg ... showLS svc`, which would have left `callId` unused). `requestTraceId` is accessed via the `Request` record; `Runtime.hs` already imports `AFRP (Event (..), Mealy (..), Request (..))` — confirm `Request (..)` brings `requestTraceId` into scope. The current import is `import AFRP (Event (..), Mealy (..), Request (..))`, so `requestTraceId` is in scope. Good.
 - [ ] **Step 3: Thread controller name in runController**
 In `src/HomeAssistant/Runtime.hs`, update `runController` to use the name and pass it to the interpreter. Replace `runController` with:
 ```haskell
 runController :: Bus -> Controller -> IO Void
 runController bus (Controller name machine) = do
  inbound <- atomically (dupTChan (busInbound bus))
  go inbound machine
  where
    go inbound f = do
      msg <- atomically (readTChan inbound)
      uuid <- UUID.V4.nextRandom
      -- (_, f') <- step (channelHassEval bus name) uuid f (Event msg)
      (_, f') <- step (dryRunHassEval bus name) uuid f (Event msg)
      go inbound f'
 ```
 The commented `channelHassEval` line is updated to the new signature too, so enabling it later requires no further edits.
 - [ ] **Step 4: Update BusSpec channelHassEval call**
 In `test/BusSpec.hs`, the test "channelHassEval writes CallService to the outbound channel" calls `channelHassEval bus (CallService svc)`. Update it to pass a name:
 ```haskell
    channelHassEval bus "test" (CallService svc)
 ```
 - [ ] **Step 5: Build and run tests to verify green**
 Run:
 ```bash
 nix develop -c cabal build && nix develop -c cabal test
 ```
 Expected: builds with no warnings; all tests pass. The `print` calls in `channelHassEval`/`dryRunHassEval` are now gone — confirm with:
 ```bash
 rg -n "print" src/HomeAssistant/Runtime/Bus.hs src/HomeAssistant/Runtime.hs
 ```
 Expected: no output (no `print` remains in those two files).
 - [ ] **Step 6: Commit**
 ```bash
 git add src/HomeAssistant/Runtime/Bus.hs src/HomeAssistant/Runtime.hs test/BusSpec.hs
 git commit -m "Convert HASSEff interpreters to katip, thread controller name"
 ```
 ---
 ### Task 4: Convert supervised to take LogEnv and use katip
 `supervised` gains a leading `LogEnv` argument and replaces its two `putStrLn` calls with `logMsg`. The crash message is `WarningS`, the restart message is `InfoS`, both under namespace `runtime.supervisor.<name>`. `defaultMain` and `SupervisorSpec` are updated.
 **Files:**
 - Modify: `src/HomeAssistant/Runtime/Supervisor.hs` (imports, `supervised`)
 - Modify: `src/HomeAssistant/Runtime.hs` (`defaultMain` supervised call)
 - Modify: `test/SupervisorSpec.hs` (3 `supervised` call sites + import)
 **Interfaces:**
 - Consumes: `LogEnv` from katip (Task 1), `busLogEnv` (Task 2) for the `defaultMain` call
 - Produces: `supervised :: LogEnv -> Text -> Backoff -> IO Void -> IO Void`
 - [ ] **Step 1: Update supervised in Supervisor.hs**
 In `src/HomeAssistant/Runtime/Supervisor.hs`, add `OverloadedStrings` to the pragmas at the top (needed so the message string literals are `LogStr`):
 ```haskell
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 ```
 Add imports. Add after the existing imports:
 ```haskell
 import Katip
  ( LogEnv
  , Namespace (Namespace)
  , Severity (InfoS, WarningS)
  , logMsg
  , ls
  , runKatipT
  , showLS
  )
 ```
 Also **remove** the now-unused `import qualified Data.Text as T` line (the only `T.` usages were `T.unpack`/`T.pack` in the removed `putStrLn` calls; with `-Wall` the unused qualified import would warn). Keep `import Data.Text (Text)` — it is still used by `Fatal :: Text` and the `supervised` signature.
 Update the export list (the type signature changes but `supervised` stays exported). Update `supervised`'s type and body. Replace the `supervised` definition with:
 ```haskell
 supervised :: LogEnv -> Text -> Backoff -> IO Void -> IO Void
 supervised le name backoff action = go 1
  where
    go attempt = do
      start <- getCurrentTime
      outcome <- (action >> pure (Nothing :: Maybe (Either Fatal SomeException))) `catches`
        [ Handler $ \(f :: Fatal) -> pure (Just (Left f))
        , Handler $ \(e :: SomeException) -> pure (Just (Right e))
        ]
      end <- getCurrentTime
      case outcome of
        Nothing -> error "unreachable: supervised action returned"
        Just (Left f) -> throw f
        Just (Right e) -> do
          runKatipT le $
            logMsg (Namespace ["runtime", "supervisor", name]) WarningS
              ("attempt " <> showLS attempt <> " crashed: " <> ls (displayException e))
          let delay = backoffDelay backoff attempt
          runKatipT le $
            logMsg (Namespace ["runtime", "supervisor", name]) InfoS
              ("restarting in " <> showLS delay)
          threadDelay (round (realToFrac delay * 1000000 :: Double))
          go (nextAttempt backoff (diffUTCTime end start) attempt)
 ```
 Note: `logMsg`'s message is a `LogStr`; `(<>)` concatenates `LogStr` (it has a `Semigroup` instance). `showLS` uses `show`, so it is right for `attempt` (`Int`) and `delay` (`NominalDiffTime`) but **wrong for `displayException e`** (a `String`) — `showLS` would double-quote/escape it. Use `ls` (which converts via `StringConv` to `Text`) for raw `String` values. `displayException` is already imported from `Control.Exception.Annotated`. `Data.Text (Text)` stays for `Fatal`/the signature; the qualified `T` import is dropped (see above).
 - [ ] **Step 2: Update defaultMain supervised call in Runtime.hs**
 In `src/HomeAssistant/Runtime.hs`, in `defaultMain`, the supervised call is currently `async (supervised name defaultBackoff act)`. Update it to pass the `LogEnv`:
 ```haskell
    as <- mapM (\(name, act) -> async (supervised le' name defaultBackoff act)) workers
 ```
 (`le'` is the bracketed `LogEnv` from Task 2.)
 - [ ] **Step 3: Update SupervisorSpec to pass silentLogEnv**
 In `test/SupervisorSpec.hs`, add imports:
 ```haskell
 import Support (silentLogEnv)
 ```
 There are three `async (supervised "test" tinyBackoff action)` calls (lines ~28, ~41, ~56). Each must become:
 ```haskell
    le <- silentLogEnv
    sup <- async (supervised le "test" tinyBackoff action)
 ```
 Insert the `le <- silentLogEnv` line before each `async` call. The three sites are in the `it` blocks: "restarts a crashing action until it stays up", "rethrows Fatal instead of restarting", and "does not restart on async exceptions".
 For "rethrows Fatal instead of restarting" the surrounding block becomes:
 ```haskell
  it "rethrows Fatal instead of restarting" $ do
    counter <- newIORef (0 :: Int)
    let action = do
          _ <- atomicModifyIORef' counter (\c -> (c + 1, c + 1))
          throw (Fatal "auth_invalid")
    le <- silentLogEnv
    sup <- async (supervised le "test" tinyBackoff action)
    res <- waitCatch sup
 ```
 Apply the same `le <- silentLogEnv` insertion to the other two sites.
 - [ ] **Step 4: Build and run tests to verify green**
 Run:
 ```bash
 nix develop -c cabal build && nix develop -c cabal test
 ```
 Expected: builds with no warnings; all tests pass. Confirm no `putStrLn` remains in Supervisor.hs:
 ```bash
 rg -n "putStrLn" src/HomeAssistant/Runtime/Supervisor.hs
 ```
 Expected: no output.
 - [ ] **Step 5: Commit**
 ```bash
 git add src/HomeAssistant/Runtime/Supervisor.hs src/HomeAssistant/Runtime.hs test/SupervisorSpec.hs
 git commit -m "Convert supervised to katip logging"
 ```
 ---
 ### Task 5: Convert Connection.hs reader/writer putStrLn to katip
 The two `putStrLn` sites in `Connection.hs` (reader "connected" and "skipping undecodable message") become `logMsg` calls under namespace `runtime.reader`. "connected" is `InfoS`; "skipping undecodable" is `WarningS`.
 **Files:**
 - Modify: `src/HomeAssistant/Runtime/Connection.hs` (imports, two log sites)
 **Interfaces:**
 - Consumes: `busLogEnv :: LogEnv` from Task 2
 - Produces: no signature changes (reader/writer already take `Bus`)
 - [ ] **Step 1: Add katip imports to Connection.hs**
 In `src/HomeAssistant/Runtime/Connection.hs`, add after the existing imports:
 ```haskell
 import Katip
  ( Namespace (Namespace)
  , Severity (InfoS, WarningS)
  , logMsg
  , ls
  , runKatipT
  )
 ```
 (`showLS` is not needed here — both messages use string literals / `ls` for the raw `String` `err`.)
 - [ ] **Step 2: Replace the "connected" putStrLn**
 In `readerAction`, replace:
 ```haskell
    putStrLn "[reader] connected"
 ```
 with:
 ```haskell
    runKatipT (busLogEnv bus) $
      logMsg (Namespace ["runtime", "reader"]) InfoS "connected"
 ```
 `"connected"` is a `LogStr` via `IsString`. The `onException` line that follows is unchanged.
 - [ ] **Step 3: Replace the "skipping undecodable" putStrLn**
 In `receiveLoop`, replace:
 ```haskell
    Left err -> putStrLn $ "[reader] skipping undecodable message: " <> err
 ```
 with:
 ```haskell
    Left err -> runKatipT (busLogEnv bus) $
      logMsg (Namespace ["runtime", "reader"]) WarningS
        ("skipping undecodable message: " <> ls err)
 ```
 `err` is a `String` from `eitherDecode`; `ls err` converts it to a `LogStr` without `show`'s quoting (use `ls`, not `showLS`, for raw `String`s). (`<>` on `LogStr`.)
 - [ ] **Step 4: Build and run tests to verify green**
 Run:
 ```bash
 nix develop -c cabal build && nix develop -c cabal test
 ```
 Expected: builds with no warnings; all tests pass. Confirm no `putStrLn` remains in Connection.hs:
 ```bash
 rg -n "putStrLn" src/HomeAssistant/Runtime/Connection.hs
 ```
 Expected: no output.
 - [ ] **Step 5: Commit**
 ```bash
 git add src/HomeAssistant/Runtime/Connection.hs
 git commit -m "Convert reader/writer logging to katip"
 ```
 ---
 ### Task 6: Final verification — no manual printing remains under src/
 Confirm the whole logging swap is complete: the build and tests are green, and no `print`/`putStrLn`/`putStr` remains under `src/`.
 **Files:**
 - None modified (verification only)
 - [ ] **Step 1: Confirm no manual printing remains under src/**
 Run:
 ```bash
 rg -n "print|putStrLn|putStr|hPutStr" src/
 ```
 Expected: no output. If any match remains, it is a missed site — fix it before committing (revisit the relevant task).
 - [ ] **Step 2: Full clean build and test**
 Run:
 ```bash
 nix develop -c cabal build && nix develop -c cabal test
 ```
 Expected: builds with no warnings (`-Wall`); all tests pass (BusSpec, ConnectionSpec, RuntimeSpec, SupervisorSpec, BackoffProp).
 - [ ] **Step 3: Confirm default.nix is in sync with the cabal file**
 Run:
 ```bash
 nix run nixpkgs#cabal2nix -- ./. > default.nix
 git diff --exit-code default.nix
 ```
 Expected: `git diff --exit-code` exits 0 (no changes — `default.nix` was already regenerated in Tasks 1 and 2). If it does change, the cabal file was edited without regenerating; stage and amend the relevant commit.
 - [ ] **Step 4: Smoke-check the executable wiring (optional, manual)**
 If a Home Assistant instance and `HA_TOKEN` are available, run the executable and confirm katip-formatted lines appear on stdout (e.g. `[home-assistant-controller.runtime.reader][Info][...] connected`). This is a manual check, not automated.
 - [ ] **Step 5: Final commit if any fixes were needed**
 If Steps 1-3 required fixes, commit them:
 ```bash
 git add -A
 git commit -m "Finish katip logging swap"
 ```
 Otherwise no commit is needed — the work is already committed across Tasks 1-5.
@@ -1,258 +0,0 @@
 # Concurrent runtime: multiple controllers, channels, supervision, reconnect
 Date: 2026-08-20
 Status: Approved (pending spec review)
 ## Goal
 Make the HASS runtime production-quality:
 - Support multiple controllers.
 - A single websocket read loop; no per-controller connections.
 - The read loop broadcasts messages to controllers over channels (`TChan`).
 - Each controller runs on its own thread (`async`).
 - Controllers know nothing of the websocket connection: service calls go
  through an outbound channel; a writer thread does the actual sends.
 - Crashed worker threads are restarted with backoff (`annotated-exception`
  for context).
 - The websocket reconnects on network failure.
 Implemented as two slices, each independently buildable and committed:
 1. **Concurrency architecture**: bus, reader/writer threads, controller
   threads, channel interpreter, wiring. Any worker crash exits the
   process (today's behavior).
 2. **Robustness**: supervisor with backoff, `annotated-exception`, fatal
   vs retryable failures, reconnect-as-restart.
 ## Current state
 `HomeAssistant.Runtime.app` runs everything on one thread inside
 `WS.runClient`: auth handshake, a `get_states` debug dump, one
 `subscribe_events`, then a loop that steps a single `lightController`
 via `dryRunHassEval`. The `get_states` dump is dead debug code and is
 removed (state pre-seeding is a separate future concern).
 ## Architecture
 ```
                HA websocket
                 ▲          │
        sends    │          ▼ receives
   ┌─────────────┴──┐  ┌──────────────┐
   │ writer thread  │  │ reader thread │
   └───────▲────────┘  └───────┬──────┘
           │                   │ decode → Value
           │ TChan Service     │ broadcast (single write)
           │                   ▼
   ┌───────┴───────────────────────────┐
   │ busInbound (broadcast TChan)      │
   └──┬──────────────┬──────────────┬──┘
      ▼ dupTChan     ▼              ▼
  controller 1   controller 2   controller N   (1 thread each)
 ```
 ### Bus
 ```haskell
 data Bus = Bus
  { busInbound  :: TChan Value          -- newBroadcastTChanIO; reader writes only
  , busOutbound :: TChan Service        -- controllers → writer; fire-and-forget
  , busConn     :: TVar (Maybe WS.Connection)
  , busGen      :: CallIdGen            -- existing IORef-based, thread-safe
  }
 ```
 - `busInbound` comes from `newBroadcastTChanIO`: a write-only broadcast
  channel. A plain never-read `TChan` would pin its entire history; the
  broadcast variant does not. Controllers receive via
  `dupTChanIO busInbound`; the reader writes each message once.
 - `busConn` is a plain current-value cell (no `MVar` blocking semantics).
  `Maybe` + STM `retry` lets the writer block until a connection exists
  and lets `defaultMain` spawn all workers up front: the initial connect
  is just the reader's first attempt, so first-connect failures and
  reconnect failures take the same backoff path.
 - The controller list is static. Each entry is an existential:
  ```haskell
  data Controller = forall b. Controller T.Text (HASS (Event Value) b)
  ```
  No `Show` constraint: machine outputs are discarded; observability will
  come from a logging effect later. The name tags restart logs.
 ### Send-safety without locks
 No two threads ever send on the same live connection:
 - The reader performs all setup sends (auth, subscribe) **before**
  swapping the connection into `busConn`; afterwards it only receives.
 - The writer only sends on connections read from `busConn`.
 On reconnect the reader builds a new connection, handshakes, then
 atomically swaps `busConn`. A writer mid-send on the dead connection
 throws, its supervisor restarts it, and it picks up the new connection.
 ### Outbound backpressure
 Fire-and-forget: services queue in `busOutbound` during outages and are
 sent after reconnect. The queue is naturally bounded in practice: no
 inbound events means controllers produce no calls.
 ## Module layout
 | Module | Concern |
 |---|---|
 | `HomeAssistant.Runtime.Supervisor` | Generic restart-with-backoff combinator, `Backoff`, `Fatal`; no HA knowledge |
 | `HomeAssistant.Runtime.Bus` | `Bus`, `newBus`, channel interpreter for `HASSEff` |
 | `HomeAssistant.Runtime.Connection` | `readerAction`, `writerAction`; connect/auth/subscribe, receive-decode-broadcast loop, send loop |
 | `HomeAssistant.Runtime` | Glue: `defaultMain`, `controllers`, `Controller`, `runController`, `step`, `dryRunHassEval` |
 Exports removed from `HomeAssistant.Runtime`: `app`, `hassEval`,
 `wsCallService`, `receiveJSON` (internal or superseded). Kept:
 `defaultMain`, `step`, `dryRunHassEval`, `CallIdGen`, `mkCallIdGen`.
 `app/Main.hs` unchanged.
 ## Connection lifecycle
 **Reader action** (restartable unit; restart = reconnect):
 ```
 connect → expect auth_required → send token → expect auth_ok
        → send subscribe_events state_changed (id from busGen)
        → swap busConn
        → forever: receive → decode → broadcast to busInbound
 ```
 - `auth_invalid` (and undecodable handshake messages) is **fatal**: a bad
  token cannot be fixed by retrying. The reader throws `Fatal`; the
  supervisor rethrows it (with annotations) and the process exits.
 - Undecodable messages in the receive loop are **not** fatal: log a
  warning and skip. Reconnecting cannot fix a decode problem, so
  crash-restarting would just be a hot loop.
 - Controller Mealy state survives reconnects (explicit decision). State
  may be stale until each watched entity's next `state_changed` event.
  Re-seeding via `get_states` is a separate future concern.
 **Writer action**:
 ```
 forever: readTChan busOutbound
       → readTVar busConn (retry until Just)
       → encode with fresh id from busGen → send
 ```
 Encoding fixes a latent bug: today's `wsCallService` drops
 `serviceData`; the writer encodes it as `"service_data"` when present.
 ## Supervision
 ```haskell
 supervised :: Text -> Backoff -> IO a -> IO Void   -- never returns normally
 ```
 - Catches synchronous exceptions; rethrows `SomeAsyncException`
  (no restarting on cancellation).
 - On `Fatal`: rethrow with annotations; process exits.
 - Otherwise: log (component name, attempt, annotated exception), sleep
  per backoff, restart the action.
 - Backoff: exponential from base, capped; resets after a quiet period.
  ```haskell
  data Backoff = Backoff
    { backoffBase :: NominalDiffTime   -- first restart delay, e.g. 100ms
    , backoffCap  :: NominalDiffTime   -- max delay, e.g. 30s
    , backoffQuiet :: NominalDiffTime  -- uptime that resets delay, e.g. 30s
    }
  ```
  Delay after the n-th consecutive crash: `min cap (base * 2^(n-1))`.
 - `annotated-exception` adds context at catch sites (component, phase
  such as "authenticating" / "receiving") so logs read like
  `[reader] attempt 3: ConnectionClosed while receiving`.
 ### Wiring
 - Slice 1: `defaultMain` = `newBus` → `mapConcurrently_` over reader,
  writer, and controller actions. First worker crash cancels the rest
  and exits the process.
 - Slice 2: each action wrapped in `supervised`; main waits forever.
  The worker `IO` actions are identical in both slices; only the
  spawning changes.
 ## Controller runner
 ```haskell
 runController :: Bus -> Controller -> IO Void
 -- dupTChanIO busInbound
 -- loop: readTChan → step (channelHassEval bus) → discard output
 ```
 On a supervised restart the action re-dups: a fresh port sees only
 messages written after the dup, consistent with the machine also
 restarting from its initial state. Messages broadcast during a restart
 window are lost (accepted, documented).
 ## Interpreter
 ```haskell
 channelHassEval :: Bus -> HASSEff a -> IO a
 channelHassEval bus (CallService svc) = atomically (writeTChan (busOutbound bus) svc)
 channelHassEval _   (Pure a)          = pure a
 ```
 `dryRunHassEval` stays exported for experiments/tests.
 ## Logging
 Tagged plain lines (`[reader] …`) via `putStrLn`. No framework.
 ## Dependencies
 Added: `stm`, `async` (slice 1); `annotated-exception` (slice 2).
 After editing the cabal file, regenerate `default.nix` via
 `nix run nixpkgs#cabal2nix -- ./. > default.nix` (AGENTS.md).
 ## Testing
 hspec for unit tests, hedgehog for property tests (AGENTS.md):
 - hspec:
  - Broadcast semantics: two `dupTChan` ports see all writes, in order.
  - `channelHassEval` writes `Service` to the outbound chan.
  - `runController` end-to-end on a real `Bus` with a test controller:
    feed values into `busInbound`, assert services land in `busOutbound`.
  - Writer encoding: golden JSON for `call_service` incl. `service_data`.
  - Supervisor (tiny backoff values): crash-twice-then-succeed restarts;
    `Fatal` rethrown, not restarted; async exceptions not restarted.
 - hedgehog:
  - Backoff property: delays double from base, clamp at cap, reset after
    quiet period.
 ## Slices
 1. **Concurrency architecture**: `Bus` (already reconnect-ready:
   `TVar (Maybe Connection)`), `channelHassEval`, `readerAction`,
   `writerAction`, `runController`, module split, cabal deps, wiring via
   `mapConcurrently_`, tests for bus/runner/encoding. Decode
   log-and-skip included.
 2. **Robustness**: `Supervisor` module, `annotated-exception` dep,
   backoff, `Fatal` auth failures, rewire `defaultMain` to supervised
   workers, supervisor tests and backoff property.
 In slice 1 an `auth_invalid` response exits the process like any other
 crash; the fatal/retryable distinction only exists once the supervisor
 does (slice 2).
 Each slice: builds clean, tests green, committed separately.
 ## Non-goals
 - Request/response correlation for service calls (approach B, deferred;
  outbound message type can grow later).
 - Dynamic controller registration (static list).
 - Structured logging / logging effect (future).
 - Host/port/token configuration via env (beyond current `HA_TOKEN`).
 - State pre-seeding via `get_states` (user's future concern).
 - Multiple websocket connections.
@@ -1,130 +0,0 @@
 # Module split & warning cleanup for `MyLib.hs`
 Date: 2026-08-20
 Status: Approved (pending spec review)
 ## Goal
 Split `src/MyLib.hs` (352 lines, monolithic) into vertically-separated modules and fix all compiler warnings, committing between every change.
 Two concerns were named upfront:
 1. AFRP (Mealy) internals — generic FRP machinery.
 2. Home Assistant business logic.
 A third concern emerged during exploration:
 3. IO runtime — websocket client, effect interpreter, `defaultMain`.
 ## Module layout
 Three vertical modules with hierarchical naming. `MyLib` is removed; `app/Main.hs` and the cabal `exposed-modules` are updated.
 | Module | Concern | Depends on |
 |---|---|---|
 | `AFRP` | Generic Mealy/Event machinery — no HA knowledge | base, time |
 | `HomeAssistant.Controller` | HA domain: effect type, entity parsers, controllers | `AFRP`, aeson, lens |
 | `HomeAssistant.Runtime` | IO interpreter, websocket client, `defaultMain` | both, websockets |
 ### Naming rationale
 `AFRP` lives at the top level (not `HomeAssistant.AFRP`) because the code is generic FRP machinery with zero HA references; nesting it under `HomeAssistant.*` would misrepresent it. It stays in-project per the user's decision, so a short top-level name is fine.
 ### Future direction (deferred)
 When real controllers exist, split `HomeAssistant.Controller` further into sub-modules:
 - `HomeAssistant.Controller.Effect` — `HASSEff`, `Service`, `HASS`, `callService`
 - `HomeAssistant.Controller.Entity` — entity parsers
 - `HomeAssistant.Controller` (or `.Controllers`) — actual controllers (`lightController`, etc.)
 Deferred now because there's only one proof-of-concept controller.
 ## Module contents
 ### `AFRP` (from MyLib.hs lines 29–91, 99–173)
 Exports:
 - `Mealy(..)`, `eff`
 - `Event(..)`, `hold`, `events`, `switch`
 - accumulators: `preMapAccum`, `preMapAccumUTCTime`, `mapAccum`, `mapAccumUTCTime`
 - `changes`, `whenA`, `filterA`, `thenA`, `(>>|)`, `toEvent`
 - instances come along with `Mealy(..)`
 ### `HomeAssistant.Controller` (from lines 32–42, 50–53, 175–256)
 Exports:
 - `Service(..)`, `HASSEff(..)`, `HASS`, `callService`
 - entity helpers: `entityChangeEvent`, `entityChangeEvent'`, `entityRead`, `entityRead'`, `entityBool`, `entityBool'`
 - domain types/values: `Ruuvi(..)`, `ruuvi`, `ruuviTemperatures`, `ruuviPressures`, `DoorState(..)`, `door`, `light`, `lightController`
 ### `HomeAssistant.Runtime` (from lines 259–268, 270–352)
 Exports:
 - `defaultMain`, `app`, `step`
 - `CallIdGen`, `mkCallIdGen`, `hassEval`, `dryRunHassEval`, `receiveJSON`, `wsCallService`
 ## Warning fixes
 Per-warning, applied during the split-then-fix commit sequence:
 | Warning (line) | Fix |
 |---|---|
 | `numericDirection` (190) + `Direction`/`Increase`/`Decrease`/`Steady` (187) — unused, no sig | **Delete.** True experiment; used nowhere. |
 | `entityChangeEvent` (224), `entityRead'` (236), `entityRead` (249) — unused top-binds | **Export** from `HomeAssistant.Controller`. Useful Either/Event-returning entity helpers the others build on; the split's export lists make them used. |
 | `isEntity` (227) — unused local in `entityChangeEvent` | **Delete.** `entityChangeEvent` delegates to `entityChangeEvent' >>> toEvent`; its `isEntity` is a dead duplicate. |
 | `state` (251) in `entityRead`, `state` (256) in `entityBool` — unused locals | **Delete.** Both functions delegate to their `'`-primed versions; the `where` clauses are dead duplicates. |
 | `toBool` (244) — non-exhaustive (`"on"`/`"off"` only) | **Add catch-all `_ -> False`.** Conservative: treat unknown HA state as off rather than crashing. |
 | `wsCallService` (327) + `conn` (346) — unused, paired | See option C below. |
 ### `wsCallService` / `conn` — option C (chosen)
 The commented-out `wsCallService conn ...` call on line 350 made `conn` unused. Rather than uncomment (behavior change) or paper over with `_conn` (dishonest), expose both behaviors as named, exported functions:
 ```haskell
 hassEval :: CallIdGen -> WS.Connection -> HASSEff a -> IO a
 hassEval gen conn = \case
  CallService x -> do
    callId <- generateCallId gen
    wsCallService conn callId (serviceDomain x) (serviceName x) (serviceTarget x)
  Pure a -> pure a
 dryRunHassEval :: CallIdGen -> HASSEff a -> IO a
 dryRunHassEval gen = \case
  CallService x -> do
    callId <- generateCallId gen
    print (callId, x)
  Pure a -> pure a
 ```
 Both `conn` and `wsCallService` become used by the real `hassEval`; the current print-only behavior lives in `dryRunHassEval`. `app` wires up **`dryRunHassEval`** to preserve current runtime behavior — flipping to real `hassEval` later is a one-word change.
 ## Commit sequence
 Two commits, each building cleanly:
 1. **`Split MyLib into AFRP, Controller, Runtime`**
   - Mechanical move of code into `src/AFRP.hs`, `src/HomeAssistant/Controller.hs`, `src/HomeAssistant/Runtime.hs`.
   - Proper export lists (which naturally exports the "useful but unused" entity helpers, resolving those three unused-binding warnings).
   - Delete `src/MyLib.hs`.
   - Update `app/Main.hs` import (`MyLib` -> `HomeAssistant.Runtime`).
   - Update cabal `exposed-modules`.
   - Build still warns on remaining items.
 2. **`Fix warnings`**
   - Delete `numericDirection`/`Direction` and dead `where` clauses (`isEntity` in `entityChangeEvent`, `state` in `entityRead`/`entityBool`).
   - Add `_ -> False` catch-all to `toBool`.
   - Implement real `hassEval` (uncommented `wsCallService`) + add `dryRunHassEval`; export both from `HomeAssistant.Runtime`.
   - Wire `app` to `dryRunHassEval` to preserve current behavior.
   - Build clean (no warnings).
 ## Verification
 After each commit:
 - `cabal build` succeeds.
 - After commit 2: `cabal build --ghc-options="-Wall -Wincomplete-uni-patterns -Wincomplete-record-updates"` produces zero warnings.
 - `app/Main.hs` still compiles and imports `defaultMain` from its new home.
 ## Non-goals
 - Splitting `HomeAssistant.Controller` into Effect/Entity/Controller sub-modules (deferred until real controllers exist).
 - Adding tests (test suite is a placeholder; out of scope).
 - Changing `app` to call real `hassEval` (stays on `dryRunHassEval` to preserve behavior).
 - Any behavioral changes beyond warning fixes and the dormant `wsCallService` activation (which is itself inert until `app` switches to `hassEval`).
@@ -1,278 +0,0 @@
 # Replace manual printing with katip logging
 Date: 2026-08-21
 Status: Approved (pending spec review)
 ## Goal
 Replace all `print`/`putStrLn` logging under `src/` with [katip], a
 structured logging framework. The AFRP layer and controller definitions
 stay logging-free; only the `HASSEff` interpreters and runtime workers
 log.
 [katip]: https://hackage.haskell.org/package/katip
 ## Current state
 Nine logging sites under `src/`, all unstructured stdout:
 | Site | Current code |
 |------|-------------|
 | `Runtime.hs:78` | `print (callId, x)` — dry-run `CallService` |
 | `Runtime.hs:79` | `print x` — `Debug` |
 | `Runtime.hs:80` | `print (req, x)` — `Trace` |
 | `Bus.hs:45` | `print x` — `Debug` (channelHassEval) |
 | `Bus.hs:46` | `print (req, x)` — `Trace` (channelHassEval) |
 | `Supervisor.hs:76` | `putStrLn ... "crashed: ..."` |
 | `Supervisor.hs:78` | `putStrLn ... "restarting in ..."` |
 | `Connection.hs:41` | `putStrLn "[reader] connected"` |
 | `Connection.hs:77` | `putStrLn "[reader] skipping undecodable message: ..."` |
 `app/Main.hs`'s `putStrLn "Hello, Haskell!"` is outside `src/` and left
 alone. `AFRP.hs`, `Controller.hs`, and `Controller/Bedroom.hs` contain
 no logging and remain untouched.
 ## Approach
 Approach A: `LogEnv` stored in `Bus`, explicit `runKatipT` per site.
 - `Bus` gains `busLogEnv :: LogEnv`; `defaultMain` builds the env and
  passes it to `newBus`.
 - Every existing worker already takes `Bus`, so it reads `busLogEnv`
  and logs with `runKatipT le $ logMsg ns sev msg` — no worker
  signature changes.
 - `dryRunHassEval` and `channelHassEval` gain the controller name
  (`Text`) so debug/trace logs get a per-controller namespace.
 - `supervised` is the one function without a `Bus`; it gains a leading
  `LogEnv` param.
 - Tests get a silent `LogEnv` (no scribes) via a helper so they don't
  spew.
 Rejected alternatives: B (`KatipContextT IO` worker monad — large
 churn, async context loss undermines the main benefit, fights the
 existing `IO`+`Bus` design); C (a new `App` `ReaderT` monad —
 over-scoped for a logging swap).
 ## Scribe setup
 One scribe in `defaultMain`:
 ```haskell
 scribe <- mkHandleScribe ColorIfTerminal stdout (permitItem DebugS) V2
 ```
 - `ColorIfTerminal`: color codes only when stdout is a TTY.
 - `permitItem DebugS`: lets all severities through. The dev run shows
  everything; a production deployment can swap `DebugS` for `InfoS` (or
  register a second, more restrictive scribe) without code changes
  elsewhere.
 - `V2` verbosity: renders structured payload fields (e.g. `traceId`)
  inline in bracket format, e.g. `[traceId:<uuid>] <message>`.
 - `bracket ... closeScribes`: the current `waitAny`+`absurd` exits
  abruptly; wrapping the body in `bracket` ensures scribe queues flush
  and finalizers run on exit.
 App namespace (set once): `initLogEnv "home-assistant-controller"
 "production"`. Every log's full namespace is `home-assistant-controller
 . <component>`.
 ## Severity & namespace mapping
 | Site | Namespace | Severity |
 |------|-----------|----------|
 | dryRun `CallService` | `<controllerName>` | DebugS |
 | `Debug` (both interpreters) | `<controllerName>` | DebugS |
 | `Trace req x` (both interpreters) | `<controllerName>` | DebugS |
 | Supervisor crash | `runtime.supervisor.<name>` | WarningS |
 | Supervisor restart | `runtime.supervisor.<name>` | InfoS |
 | reader connected | `runtime.reader` | InfoS |
 | reader undecodable | `runtime.reader` | WarningS |
 Rationale: crashes that get restarted are recoverable → WarningS; the
 restart notice is normal operation → InfoS. "reader connected" is an
 operational milestone → InfoS; skipping a bad message is
 abnormal-but-handled → WarningS. All interpreter output
 (CallService dry-run, Debug, Trace) is developer instrumentation →
 DebugS, so a production scribe (`permitItem InfoS`) filters it out
 while a dev scribe keeps it.
 ## Structured traceId
 `Trace req x` carries `requestTraceId :: UUID`. Logged via `logF` with
 a `SimpleLogPayload` so the traceId is a structured field rather than
 text concatenated into the message. `Data.UUID.toText` renders the UUID
 as a hyphenated `Text` (which is `ToJSON`, as `sl` requires):
 ```haskell
 Trace req x -> runKatipT le $
  logF (sl "traceId" (toText (requestTraceId req))) ns DebugS (showLS x)
 ```
 Renders in bracket format as
 `[home-assistant-controller.<name>][Debug][...][traceId:<uuid>] <x>`.
 The `toText` import comes from `Data.UUID` (already a dependency).
 ## Signature changes
 ### `Bus` (Bus.hs)
 ```haskell
 data Bus = Bus
  { busInbound  :: TChan Value
  , busOutbound :: TChan Service
  , busConn     :: TVar (Maybe Connection)
  , busGen      :: CallIdGen
  , busLogEnv   :: LogEnv          -- new
  }
 newBus :: LogEnv -> Int -> IO Bus   -- LogEnv first
 ```
 `LogEnv` is the more "environmental" arg; `Int` is the call-id seed.
 ### `HASSEff` interpreters (Runtime.hs, Bus.hs)
 Both gain the controller name as the 2nd arg and read `LogEnv` from
 `Bus`/`busLogEnv`:
 ```haskell
 dryRunHassEval :: Bus -> Text -> HASSEff a -> IO a
 channelHassEval :: Bus -> Text -> HASSEff a -> IO a
 ```
 - `dryRunHassEval` changes from `CallIdGen -> ...` to `Bus -> Text ->
  ...` (it needs both `busGen` for call ids and `busLogEnv` for
  logging). Matches `channelHassEval`'s shape for symmetry.
 - `Debug`: `print x` → `runKatipT (busLogEnv bus) $ logMsg ns DebugS
  (showLS x)`.
 - `Trace`: `print (req, x)` → the structured `logF` call in
  [Structured traceId](#structured-traceid).
 - `CallService`:
  - `dryRunHassEval`: keeps `generateCallId (busGen bus)` (call id for
    dry-run output) and replaces `print (callId, x)` with a DebugS log
    of the `Service`:
    `runKatipT (busLogEnv bus) $ logMsg ns DebugS (showLS svc)`.
  - `channelHassEval`: unchanged — writes `Service` to `busOutbound`
    and emits no log (the writer does the actual send; logging here
    would be new behavior, not a replacement).
 ### `supervised` (Supervisor.hs)
 ```haskell
 supervised :: LogEnv -> Text -> Backoff -> IO Void -> IO Void
 ```
 Logs via `runKatipT le $ logMsg ("runtime.supervisor." <> name) sev
 msg`. `defaultMain` passes `busLogEnv bus`.
 ### `defaultMain` (Runtime.hs)
 Builds `LogEnv` at the top, passes to `newBus`, wraps body in
 `bracket ... closeScribes`:
 ```haskell
 defaultMain = withSocketsDo $ do
  scribe <- mkHandleScribe ColorIfTerminal stdout (permitItem DebugS) V2
  le <- registerScribe "stdout" scribe defaultScribeSettings
        =<< initLogEnv "home-assistant-controller" "production"
  bracket (pure le) closeScribes $ \le' -> do
    token <- getEnv "HA_TOKEN"
    bus <- newBus le' 0
    let workers = ...
    as <- mapM (\(name, act) -> async (supervised le' name defaultBackoff act)) workers
    (_, v) <- waitAny as
    absurd v
 ```
 ### `runController` (Runtime.hs)
 `Controller _name` becomes `Controller name`; the name threads into the
 interpreter:
 ```haskell
 runController :: Bus -> Controller -> IO Void
 runController bus (Controller name machine) = do
  inbound <- atomically (dupTChan (busInbound bus))
  go inbound machine
  where
    go inbound f = do
      msg <- atomically (readTChan inbound)
      uuid <- UUID.V4.nextRandom
      (_, f') <- step (dryRunHassEval bus name) uuid f (Event msg)
      go inbound f'
 ```
 ### `Connection.hs` workers
 `readerAction`/`writerAction` signatures unchanged — they already take
 `Bus`. The two `putStrLn` sites read `busLogEnv bus` and log via
 `runKatipT (busLogEnv bus) $ logMsg "runtime.reader" sev msg`.
 ### No changes to
 `AFRP.hs`, `Controller.hs`, `Controller/Bedroom.hs`,
 `Connection.hs`'s pure `encodeService`, or any controller definition —
 they remain logging-free.
 ## Tests
 A silent `LogEnv` helper (in `test/Main.hs` or a new `test/Support.hs`)
 lets tests construct a `Bus`/call `supervised` without spewing:
 ```haskell
 silentLogEnv :: IO LogEnv
 silentLogEnv = initLogEnv "home-assistant-controller" "test"
 ```
 No scribe registered → all `logMsg` calls are no-ops (katip drops
 silently).
 Mechanical call-site updates:
 - `BusSpec`: `newBus 0` → `silentLogEnv >>= \le -> newBus le 0`;
  `channelHassEval bus (CallService svc)` →
  `channelHassEval bus "test" (CallService svc)`.
 - `RuntimeSpec`: `newBus 0` → with `silentLogEnv`; `runController bus
  (Controller "test" lightController)` unchanged.
 - `SupervisorSpec`: `supervised "test" tinyBackoff action` →
  `silentLogEnv >>= \le -> supervised le "test" tinyBackoff action`
  (3 call sites).
 - `ConnectionSpec`/`BackoffProp`: no change (test pure code).
 No new tests required — the logging swap is behavior-preserving for
 existing assertions. A capturing-scribe test asserting debug logs
 *would* fire is out of scope (noted as a future option).
 ## Cabal & nix
 - Add `katip` to library `build-depends` and to test-suite
  `build-depends` (the test helper imports `Katip`).
 - After editing the `.cabal`, regenerate the derivation per AGENTS.md:
  ```
  nix run nixpkgs#cabal2nix -- ./. > default.nix
  ```
 - `flake.nix`: no change. nixpkgs has `katip` 0.8.8.4 (verified), and
  `callPackage ./.` picks up new deps from `default.nix` automatically.
 - `default.nix`: regenerated by the cabal2nix command — never hand-edit.
 ## Imports added
 | Module | Import |
 |--------|--------|
 | `Bus.hs` | `import Katip` |
 | `Runtime.hs` | `import Katip` |
 | `Supervisor.hs` | `import Katip` (+ `qualified Data.Text as T` if not present) |
 | `Connection.hs` | `import Katip` |
 | test helper | `import Katip` |
 ## Non-goals
 - Logging inside the AFRP layer or controller definitions.
 - A custom capturing-scribe test.
 - Log-level configuration via env or CLI (the scribe `permitItem` is a
  code constant for now).
 - JSON output / file scribe / multiple scribes (deferred; the single
  stdout text scribe is the drop-in replacement for current `print`).
 - Changing `app/Main.hs` (outside `src/`).
@@ -87,6 +87,7 @@ library
                    , async
                    , annotated-exception
                    , uuid
                    , katip
    -- Directories containing source files.
    hs-source-dirs:   src
@@ -157,4 +158,6 @@ test-suite home-assistant-controller-test
        hedgehog,
        hspec-hedgehog,
        annotated-exception,
-        time
+        time,
        uuid,
        katip
@@ -39,9 +39,9 @@ data Request = Request
 newtype Mealy eff a b = Mealy
  { runMealy :: forall m. MonadFix m => (forall x. eff x -> m x) -> Request -> a -> m (b, Mealy eff a b) }
-eff :: (a -> eff b) -> Mealy eff a b
+eff :: (Request -> a -> eff b) -> Mealy eff a b
-eff f = Mealy $ \nt _ x ->
+eff f = Mealy $ \nt req x ->
-  nt (f x) >>= \b -> pure (b, eff f)
+  nt (f req x) >>= \b -> pure (b, eff f)
 instance Category (Mealy eff) where
  id = Mealy (\_ _ x -> pure (x, id))
@@ -52,18 +52,18 @@ data Service = Service
  deriving (Show, Eq)
 data HASSEff a where
-  CallService :: Service -> HASSEff ()
+  CallService :: Request -> Service -> HASSEff ()
  Debug :: Show a => a -> HASSEff ()
  Trace :: Show a => Request -> a -> HASSEff ()
 type HASS a b = Mealy HASSEff a b
 callService :: Service -> HASS a ()
-callService service = eff (\_ -> CallService service)
+callService service = eff (\req _ -> CallService req service)
 debug :: Show a => HASS a a
 debug = proc x -> do
-  eff Debug -< x
+  eff (const Debug) -< x
  returnA -< x
 traceEvent :: Show a => HASS (Event a) (Event a)
@@ -114,10 +114,10 @@ drawer = entityBool "binary_sensor.bedroom_nightstand_drawer_sensor_masse_contac
 bedroomDrawerController :: HASS (Event Value) ()
 bedroomDrawerController = proc x -> do
-  st <- drawer -< x
+  st <- drawer >>> traceEvent -< x
  case st of
       Event Open -> callService (switch [entity] True) -< ()
       Event Closed -> callService (switch [entity] False) -< ()
       _ -> returnA -< ()
  where
-    entity = EntityId "bedroom_drawer_light_masse"
+    entity = EntityId "switch.bedroom_drawer_light_masse"
@@ -27,12 +27,15 @@ import HomeAssistant.Runtime.Supervisor (defaultBackoff, supervised)
 import Network.Socket (withSocketsDo)
 import System.Environment (getEnv)
 import HomeAssistant.Controller.Bedroom (bedroomPresenceController, bedroomButtonController, bedroomDrawerController)
-import Data.UUID (UUID)
+import Data.UUID (UUID, toText)
 import qualified Data.UUID.V4 as UUID.V4
 import Katip (runKatipT, logF, sl, Severity (..), ls, Namespace (Namespace), runKatipContextT)
 import Control.Monad.IO.Class (liftIO, MonadIO)
 import Control.Monad.Fix (MonadFix)
-step :: (forall x. eff x -> IO x) -> UUID -> Mealy eff a b -> a -> IO (b, Mealy eff a b)
+step :: (MonadFix m, MonadIO m) => (forall x. eff x -> m x) -> UUID -> Mealy eff a b -> a -> m (b, Mealy eff a b)
 step nt trace (Mealy f) a = do
-  now <- getCurrentTime
+  now <- liftIO getCurrentTime
  f nt (Request now trace) a
 data Controller = forall b. Controller T.Text (HASS (Event Value) b) Bool
@@ -40,7 +43,7 @@ data Controller = forall b. Controller T.Text (HASS (Event Value) b) Bool
 controllers :: [Controller]
 controllers =
  [ Controller "bedroom-presence" bedroomPresenceController False
-  , Controller "bedroom-button" bedroomButtonController False
+  , Controller "bedroom-button" bedroomButtonController False -- This works but leaving for vacation
  , Controller "bedroom-drawer" bedroomDrawerController True
  ]
@@ -48,20 +51,20 @@ controllers =
 -- bus. A restart re-dups the inbound channel and starts from the machine's
 -- initial state; messages broadcast during the restart window are lost.
 runController :: Bus -> Controller -> IO Void
-runController bus (Controller _name machine _enabled) = do
+runController bus (Controller name machine _enabled) = do
  inbound <- atomically (dupTChan (busInbound bus))
  go inbound machine
  where
    go inbound f = do
      msg <- atomically (readTChan inbound)
      uuid <- UUID.V4.nextRandom
-      (_, f') <- step (channelHassEval bus) uuid f (Event msg)
+      let ns = Namespace [name]
      (_, f') <- step (runKatipContextT (busLogEnv bus) () ns . channelHassEval bus) uuid f (Event msg)
      go inbound f'
 defaultMain :: IO ()
-defaultMain = withSocketsDo $ do
+defaultMain = withSocketsDo $ withBus $ \bus -> do
  token <- getEnv "HA_TOKEN"
  bus <- newBus 0
  let workers =
        [ ("reader", readerAction "last-resort-redux" 8123 token bus)
        , ("writer", writerAction bus)
@@ -70,10 +73,12 @@ defaultMain = withSocketsDo $ do
  (_, v) <- waitAny as
  absurd v
-dryRunHassEval :: CallIdGen -> HASSEff a -> IO a
+dryRunHassEval :: Namespace -> Bus -> HASSEff a -> IO a
-dryRunHassEval gen = \case
+dryRunHassEval ns bus = \case
-  CallService x -> do
+  CallService req x -> runKatipT (busLogEnv bus) $ do
-    callId <- generateCallId gen
+    callId <- liftIO $ generateCallId (busGen bus)
-    print (callId, x)
+    logF (sl "traceId" (toText (requestTraceId req))) ns DebugS (ls $ show (callId, x))
-  Debug x -> print x
+  Debug x -> runKatipT (busLogEnv bus) $ do
-  Trace req x -> print (req, x)
+    logF () ns DebugS (ls $ show x)
  Trace req x -> runKatipT (busLogEnv bus) $ do
    logF (sl "traceId" (toText (requestTraceId req))) ns InfoS (ls $ show x)
@@ -1,10 +1,11 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 module HomeAssistant.Runtime.Bus
  ( Bus(..)
  , CallIdGen(..)
  , mkCallIdGen
-  , newBus
+  , withBus
  , channelHassEval
  ) where
@@ -21,29 +22,46 @@ import Data.Aeson (Value)
 import Data.IORef (atomicModifyIORef', newIORef)
 import HomeAssistant.Controller (HASSEff (..), Service)
 import Network.WebSockets (Connection)
 import Katip (LogEnv, closeScribes, mkHandleScribe, ColorStrategy (..), permitItem, Severity (..), Verbosity (V2), registerScribe, defaultScribeSettings, initLogEnv, ls, sl, logFM, katipAddContext, KatipContext)
 import Control.Exception (bracket)
 import System.IO (stdout)
 import Data.UUID (toText)
 import AFRP (Request(..))
 import Control.Monad.IO.Class (MonadIO, liftIO)
 -- | Shared runtime state: inbound is a broadcast channel (controllers
 -- 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
-  , busOutbound :: TChan Service
+  , busOutbound :: TChan (Request, Service)
  , busConn     :: TVar (Maybe Connection)
  , busGen      :: CallIdGen
  , busLogEnv   :: LogEnv
  }
-newBus :: Int -> IO Bus
+withBus :: (Bus -> IO a) -> IO a
-newBus start = Bus
+withBus callback = do
-  <$> newBroadcastTChanIO
+  handleScribe <- mkHandleScribe ColorIfTerminal stdout (permitItem DebugS) V2
-  <*> newTChanIO
+  let makeLogEnv = registerScribe "stdout" handleScribe defaultScribeSettings =<< initLogEnv "hass-controller" "production"
-  <*> newTVarIO Nothing
+  -- closeScribes will stop accepting new logs, flush existing ones and clean up resources
-  <*> mkCallIdGen start
+  bracket makeLogEnv closeScribes $ \le -> do
    bus <- Bus
          <$> newBroadcastTChanIO
          <*> newTChanIO
          <*> newTVarIO Nothing
          <*> mkCallIdGen 0
          <*> pure le
    callback bus
-channelHassEval :: Bus -> HASSEff a -> IO a
+channelHassEval :: (MonadIO m, KatipContext m) => Bus -> HASSEff a -> m a
 channelHassEval bus = \case
-  CallService svc -> atomically $ writeTChan (busOutbound bus) svc
+  CallService req svc -> katipAddContext (sl "traceId" (toText (requestTraceId req))) $ do
-  Debug x -> print x
+    logFM DebugS (ls $ show svc)
-  Trace req x -> print (req, x)
+    liftIO $ atomically $ writeTChan (busOutbound bus) (req, svc)
  Debug x -> logFM DebugS (ls $ show x)
  Trace req x -> katipAddContext (sl "traceId" (toText (requestTraceId req))) $
    logFM InfoS (ls $ show x)
 newtype CallIdGen = CallIdGen { generateCallId :: IO Int }
@@ -28,6 +28,9 @@ import HomeAssistant.Controller (Service (..), Target (..))
 import HomeAssistant.Runtime.Bus
 import HomeAssistant.Runtime.Supervisor (Fatal (..))
 import qualified Network.WebSockets as WS
 import Katip (runKatipContextT, sl, logFM, Severity (..), ls)
 import Data.UUID (toText)
 import AFRP (Request(..))
 -- | Connect, authenticate, subscribe, then receive and broadcast forever.
 -- Restarting this action reconnects. All setup sends happen before the
@@ -86,10 +89,13 @@ receiveJSON conn = do
 writerAction :: Bus -> IO Void
 writerAction bus = forever $ do
-  svc <- atomically $ readTChan (busOutbound bus)
+  (request, svc) <- atomically $ readTChan (busOutbound bus)
  conn <- atomically $ readTVar (busConn bus) >>= maybe retry pure
  callId <- generateCallId (busGen bus)
-  WS.sendTextData conn $ encode $ encodeService callId svc
+  let textData = encode $ encodeService callId svc
  runKatipContextT (busLogEnv bus) (sl "traceId" (toText (requestTraceId request))) "connection" $
    logFM DebugS (ls textData)
  WS.sendTextData conn textData
 encodeService :: Int -> Service -> Value
 encodeService callId Service{..} = object $
@@ -2,6 +2,7 @@
 module BusSpec (spec) where
 import AFRP (Request (..))
 import Control.Concurrent.STM
  ( atomically
  , dupTChan
@@ -9,14 +10,16 @@ import Control.Concurrent.STM
  , writeTChan
  )
 import Data.Aeson (Value (..))
 import Data.Time (UTCTime (..))
 import Data.UUID (nil)
 import HomeAssistant.Controller (HASSEff (..), Service (..), Target(..))
 import HomeAssistant.Runtime.Bus
 import Katip (Namespace (Namespace), runKatipContextT)
 import Test.Hspec
 spec :: Spec
 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" $ withBus $ \bus -> do
    bus <- newBus 0
    p1 <- atomically $ dupTChan (busInbound bus)
    p2 <- atomically $ dupTChan (busInbound bus)
    atomically $ writeTChan (busInbound bus) (Number 1)
@@ -26,10 +29,11 @@ spec = describe "Bus" $ do
    r1 `shouldBe` (Number 1, Number 2)
    r2 `shouldBe` (Number 1, Number 2)
-  it "channelHassEval writes CallService to the outbound channel" $ do
+  it "channelHassEval writes CallService to the outbound channel" $ withBus $ \bus -> do
-    bus <- newBus 0
+    let req = Request (UTCTime (toEnum 0) 0) nil
-    let svc = Service "light" "turn_on" Nothing [EntityId "light.bedroom_masse"]
+        svc = Service "light" "turn_on" Nothing [EntityId "light.bedroom_masse"]
-    channelHassEval bus (CallService svc)
+    runKatipContextT (busLogEnv bus) () (Namespace ["test"]) $
      channelHassEval bus (CallService req svc)
    atomically (readTChan (busOutbound bus)) `shouldReturn` svc
@@ -13,8 +13,7 @@ import Test.Hspec
 spec :: Spec
 spec = describe "runController" $ do
-  it "feeds inbound events through the machine and forwards service calls" $ do
+  it "feeds inbound events through the machine and forwards service calls" $ withBus $ \bus -> do
    bus <- newBus 0
    _ <- async (runController bus (Controller "test" lightController True))
    putStrLn "Before the delay"
    threadDelay 100000 -- let the controller dup its inbound channel