Add design spec: replace manual printing with katip logging
This commit is contained in:
@@ -0,0 +1,278 @@
|
||||
# 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/`).
|
||||
Reference in New Issue
Block a user