Add implementation plan: katip logging
This commit is contained in:
@@ -0,0 +1,750 @@
|
||||
# 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.
|
||||
Reference in New Issue
Block a user