279 lines
9.6 KiB
Markdown
279 lines
9.6 KiB
Markdown
# 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/`).
|